/[suikacvs]/messaging/manakai/lib/Message/Util/PerlCode.dis
Suika

Contents of /messaging/manakai/lib/Message/Util/PerlCode.dis

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.64 - (hide annotations) (download)
Sun Apr 16 10:05:24 2006 UTC (19 years, 3 months ago) by wakaba
Branch: MAIN
CVS Tags: manakai-release-0-3-2, manakai-release-0-3-1
Changes since 1.63: +53 -6 lines
++ manakai/lib/Message/Util/ChangeLog	16 Apr 2006 10:04:29 -0000
	* PerlCode.t (CDATADOMString2): New reflecting datatype.
	(prototype): Returns |null| if it is not specified.

2006-04-16  Wakaba  <wakaba@suika.fam.cx>

++ manakai/lib/Message/DOM/ChangeLog	16 Apr 2006 10:03:47 -0000
	* XMLParser.dis (close): Invoke |close| method
	rather than |close| function.

2006-04-16  Wakaba  <wakaba@suika.fam.cx>

1 wakaba 1.1 Module:
2     @QName:
3     Util:PerlCode
4     @FullName:
5     @@lang: en
6     @@@:
7     Perl Code Constructor
8     @Namespace:
9     http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/PerlCode#
10    
11     @Description:
12     @@lang:en
13     @@@:
14     This module provides an object-oriented interface to construct
15     Perl code.
16    
17 wakaba 1.30 @DISCore:author: DISCore|Wakaba
18 wakaba 1.1 @License:
19     @@@:
20     license:Perl+MPL
21     @@Original:
22     @@@FullName:
23     manakai <CODE::lib/manakai/genlib.pl>
24     @@@Year:2004
25 wakaba 1.30 @@@DISCore:author: DISCore|Wakaba
26 wakaba 1.1 @Date:
27 wakaba 1.64 $Date: 2006/04/05 14:49:31 $
28 wakaba 1.1
29     @Require:
30     @@Module:
31 wakaba 1.35 @@@QName: MDOM|DOMCore
32     @@@WithFor: ManakaiDOM|ManakaiDOMLatest
33 wakaba 1.56 @@Module:
34     @@@QName: DISlib|DISMarkup
35     @@@WithFor: ManakaiDOM|all
36 wakaba 1.35 @DefaultFor: ManakaiDOM|ManakaiDOMLatest
37 wakaba 1.1
38     Namespace:
39 wakaba 1.59 @c:
40     http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#
41 wakaba 1.61 @cfg:
42     http://suika.fam.cx/www/2006/dom-config/
43 wakaba 1.1 @DIS:
44     http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#
45     @dis:
46     http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--
47 wakaba 1.56 @DISlib:
48     http://suika.fam.cx/~wakaba/archive/2004/dis/
49 wakaba 1.33 @f:
50     http://suika.fam.cx/~wakaba/archive/2004/dom/feature#
51     @idl:
52     http://suika.fam.cx/~wakaba/archive/2004/dis/IDL#
53 wakaba 1.25 @kwd:
54     http://suika.fam.cx/~wakaba/archive/2005/rfc2119/
55 wakaba 1.1 @lang:
56     http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#
57     @license:
58     http://suika.fam.cx/~wakaba/archive/2004/8/18/license#
59     @ManakaiDOM:
60     http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#
61 wakaba 1.5 @MDOM:
62     http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#ManakaiDOM.
63 wakaba 1.1 @MDOMX:
64     http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#
65     @pc:
66     http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/PerlCode#
67 wakaba 1.44 @pc2:
68     http://suika.fam.cx/~wakaba/archive/2005/12/pc/
69 wakaba 1.1 @rdf:
70     http://www.w3.org/1999/02/22-rdf-syntax-ns#
71 wakaba 1.35 @s:
72     http://suika.fam.cx/~wakaba/archive/2004/dis/Markup#
73 wakaba 1.59 @tc:
74     http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/
75 wakaba 1.60 @td:
76     http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/Document/
77     @te:
78     http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/Element/
79 wakaba 1.42 @test:
80     http://suika.fam.cx/~wakaba/archive/2004/dis/Test#
81 wakaba 1.1 @Util:
82     http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/
83    
84 wakaba 1.35 ## -- Module sets
85    
86     ResourceDef:
87     @QName: Util|
88     @For: ManakaiDOM|DOM
89     @rdf:type: dis|ModuleGroup
90     @FullName:
91     @@lang:en
92     @@@:
93     Manakai support modules
94     @DISPerl:packageName:
95     Message::Util::
96     @DISPerl:interfacePackageName:
97     @@@:
98     Message::Util::IF::
99     @@For: ManakaiDOM|ManakaiDOM !ManakaiDOM|ManakaiDOMLatest
100     @DISPerl:interfacePackageName:
101     @@@:
102     Message::Util::IFLatest::
103     @@For: ManakaiDOM|ManakaiDOMLatest
104     @ImplNote:
105     @@lang:en
106     @@@:
107     Resources <Q::Util|> for <Q::ManakaiDOM|all> and for <Q::ManakaiDOM|Perl>
108     is defined in module <Module::Util|ManakaiNode>.
109    
110 wakaba 1.1 ## -- Features
111    
112     ElementTypeBinding:
113     @Name: FeatureDef
114     @ElementType:
115     dis:ResourceDef
116     @ShadowContent:
117 wakaba 1.59 @@DISCore:resourceType: f|Feature
118 wakaba 1.27 @@For: =ManakaiDOM|all
119 wakaba 1.1
120     ElementTypeBinding:
121     @Name: FeatureVerDef
122     @ElementType:
123     dis:ResourceDef
124     @ShadowContent:
125 wakaba 1.59 @@DISCore:resourceType: f|Feature
126 wakaba 1.1
127     ElementTypeBinding:
128     @Name: featureQName
129     @ElementType:
130 wakaba 1.59 f:name
131 wakaba 1.1 @ShadowContent:
132 wakaba 1.29 @@ContentType: DISCore|QName
133 wakaba 1.1
134     FeatureDef:
135     @QName: CoreFeature
136     @featureQName:
137     Util:PerlCode
138     @FeatureVerDef:
139     @@QName: CoreFeature10
140     @@Version: 1.0
141     @@ISA: CoreFeature
142     @@FullName:
143     @@@lang:en
144     @@@@:
145     Perl Code Constructor, version 1.0
146     @@Description:
147     @@@lang:en
148     @@@@:
149     Perl Code Constructor, version 1.0.
150    
151 wakaba 1.25 ElementTypeBinding:
152     @Name: IFClsDef
153     @ElementType:
154     dis:ResourceDef
155     @ShadowContent:
156     @@rdf:type:
157     @@@@: dis|MultipleResource
158     @@@ForCheck: !ManakaiDOM|ForIF !ManakaiDOM|ForClass
159     @@resourceFor: ManakaiDOM|ForIF
160 wakaba 1.62 @@resourceFor:
161     @@@@: ManakaiDOM|ForClass
162     @@@For: ManakaiDOM|ManakaiDOMLatest
163 wakaba 1.36 @@For: ManakaiDOM|ManakaiDOM
164 wakaba 1.35
165     @@rdf:type:
166     @@@@: DISLang|Interface
167     @@@ForCheck: ManakaiDOM|ForIF
168    
169     @@rdf:type:
170     @@@@: DISLang|Class
171     @@@ForCheck: ManakaiDOM|ForClass
172     @@Implement:
173     @@@@: ||ManakaiDOM|ManakaiDOM||ManakaiDOM|ForIF
174     @@@ContentType: DISCore|TFPQNames
175     @@@ForCheck: ManakaiDOM|ForClass ManakaiDOM|ManakaiDOM
176     @@Implement:
177     @@@@: ||ManakaiDOM|ManakaiDOMLatest||ManakaiDOM|ForIF
178     @@@ContentType: DISCore|TFPQNames
179     @@@ForCheck: ManakaiDOM|ForClass ManakaiDOM|ManakaiDOMLatest
180    
181     @@f:implements: pc|CoreFeature10
182    
183     ElementTypeBinding:
184     @Name: IFClsETDef
185     @ElementType:
186     dis:ResourceDef
187     @ShadowContent:
188     @@rdf:type:
189     @@@@: dis|MultipleResource
190     @@@ForCheck: !ManakaiDOM|ForIF !ManakaiDOM|ForClass !s|ForML
191     @@resourceFor: ManakaiDOM|ForIF
192 wakaba 1.36 @@resourceFor: ManakaiDOM|ForClass
193 wakaba 1.35 @@resourceFor: s|ForML
194 wakaba 1.36 @@For: ManakaiDOM|ManakaiDOM
195 wakaba 1.25
196     @@rdf:type:
197 wakaba 1.35 @@@@: DISLang|Interface
198     @@@ForCheck: ManakaiDOM|ForIF
199 wakaba 1.25
200     @@rdf:type:
201 wakaba 1.35 @@@@: DISLang|Class
202 wakaba 1.25 @@@ForCheck: ManakaiDOM|ForClass
203     @@Implement:
204 wakaba 1.35 @@@@: ||ManakaiDOM|ManakaiDOM||ManakaiDOM|ForIF
205     @@@ContentType: DISCore|TFPQNames
206     @@@ForCheck: ManakaiDOM|ForClass ManakaiDOM|ManakaiDOM
207     @@Implement:
208     @@@@: ||ManakaiDOM|ManakaiDOMLatest||ManakaiDOM|ForIF
209 wakaba 1.25 @@@ContentType: DISCore|TFPQNames
210 wakaba 1.35 @@@ForCheck: ManakaiDOM|ForClass ManakaiDOM|ManakaiDOMLatest
211 wakaba 1.36
212 wakaba 1.35 @@s:elementType:
213     @@@@: ||+||s|ForML
214     @@@ContentType: DISCore|TFPQNames
215     @@@DISCore:stopISARecursive:1
216    
217     @@rdf:type:
218     @@@@: s|ElementType
219     @@@ForCheck: s|ForML
220 wakaba 1.25
221 wakaba 1.35 @@f:implements: pc|CoreFeature10
222 wakaba 1.25
223     ElementTypeBinding:
224     @Name: IFQName
225     @ElementType:
226     dis:QName
227     @ShadowContent:
228     @@ForCheck: ManakaiDOM|ForIF
229    
230     ElementTypeBinding:
231 wakaba 1.35 @Name: CQName
232     @ElementType:
233     dis:QName
234     @ShadowContent:
235 wakaba 1.36 @@ForCheck: ManakaiDOM|ForClass
236 wakaba 1.25
237     ElementTypeBinding:
238     @Name: IFISA
239     @ElementType:
240     dis:ISA
241     @ShadowContent:
242     @@ForCheck: ManakaiDOM|ForIF
243    
244     ElementTypeBinding:
245 wakaba 1.35 @Name: CISA
246     @ElementType:
247     dis:ISA
248     @ShadowContent:
249 wakaba 1.36 @@ForCheck: ManakaiDOM|ForClass
250 wakaba 1.25
251 wakaba 1.1 ## -- Classes
252    
253 wakaba 1.25 IFClsDef:
254     @IFQName: PerlCode
255 wakaba 1.35 @CQName: ManakaiPCCode
256 wakaba 1.25
257 wakaba 1.60 @CISA: te|ManakaiDOMElement
258 wakaba 1.59
259     @s:elementType: AnyPCElement||ManakaiDOM|all
260     @s:elementType: AnyPC2Element||ManakaiDOM|all
261 wakaba 1.25
262 wakaba 1.1 @enDesc:
263     A class on which another Perl code classes are constructed based.
264    
265 wakaba 1.59 @Test:
266     @@QName: Document.createElementNS.PerlCode.pc1.test
267     @@PerlDef:
268     my $doc;
269     __CODE{createPCDocumentForTest:: $doc => $doc}__;
270    
271     my $el1 = $doc-><M::Document.createElementNS>
272     (<Q::pc:>, 'pc:NoSuchElementType');
273    
274     $test->id ('pc.Element');
275     $test->assert_isa ($el1, <IFName::Element>);
276    
277     $test->id ('pc.PerlCode');
278     $test->assert_isa ($el1, <IFName::PerlCode>);
279     @Test:
280     @@QName: Document.createElementNS.PerlCode.pc2.test
281     @@PerlDef:
282     my $doc;
283     __CODE{createPCDocumentForTest:: $doc => $doc}__;
284    
285     my $el2 = $doc-><M::Document.createElementNS>
286     (<Q::pc2:>, 'pc2:NoSuchElementType');
287    
288     $test->id ('pc2.Element');
289     $test->assert_isa ($el2, <IFName::Element>);
290    
291     $test->id ('pc2.PerlCode');
292     $test->assert_isa ($el2, <IFName::PerlCode>);
293    
294 wakaba 1.1 @Attr:
295 wakaba 1.6 @@Name: fileNode
296     @@enDesc:
297     The root <QUOTE::file> node of the tree to which this node belongs.
298 wakaba 1.25 @@Type: PerlCode
299 wakaba 1.6 @@Get:
300     @@@enDesc:
301     The <QUOTE::file> node of the tree.
302     @@@nullCase:
303     @@@@enDesc:
304     This node does not belong to any file tree.
305     @@@PerlDef:
306 wakaba 1.35 __DEEP{
307     $r = $self-><AG::Node.ownerDocument>
308     -><AG::Document.documentElement>;
309     if ($r) {
310     unless (defined $r-><AG::Node.namespaceURI> and
311     $r-><AG::Node.namespaceURI> eq <Q::pc:> and
312     $r-><AG::Node.localName> eq 'file') {
313     $r = null;
314     }
315     }
316     }__;
317 wakaba 1.6
318     @Method:
319     @@Name: replaceVariable
320     @@enDesc:
321     Replaces a variable.
322     \
323     {NOTE:: For objects of type <Class::ManakaiPerlFile>,
324 wakaba 1.11 <Class::ManakaiPerlPackageScope>,
325     <Class::ManakaiPerlSub> and
326     <Class::ManakaiPerlVariable>, the result is undefined.
327 wakaba 1.6 \
328     }
329     @@Param:
330     @@@Name: originalVariable
331     @@@Type:
332     lang:Perl::ManakaiDOM:all
333     @@@enDesc:
334     Original variable specification, including prefix.
335     \
336     {NOTE:: Qualified name variable and hash key is not supported.
337     \
338     }
339     @@Param:
340     @@@Name: newValue
341 wakaba 1.11 @@@Type:
342     DOMMain:any::ManakaiDOM:all
343 wakaba 1.6 @@@enDesc:
344     New value to replace.
345 wakaba 1.11 @@@InCase:
346 wakaba 1.25 @@@@Type: PerlCode
347 wakaba 1.11 @@@@enDesc:
348     New Perl code fragment to replace by.
349     @@@InCase:
350     @@@@Type:
351     lang:Perl::ManakaiDOM:all
352     @@@@enDesc:
353     Inline Perl code fragment string to replace by.
354 wakaba 1.6 @@Return:
355     @@@PerlDef:
356 wakaba 1.35 my $ln = $self-><AG::Node.localName>;
357     if ($ln eq 'unparsed' or
358     $ln eq 'inlineUnparsed') {
359     my $new_var = ref $newValue ? $newValue->stringify : ''.$newValue;
360     my $val = $self-><AG::Node.textContent>;
361     $val =~ s/\Q$originalVariable\E\b/$new_var/g;
362     $self-><AS::Node.textContent> ($val);
363     } elsif ($ln eq 'stringLiteral' or $ln eq 'atom' or
364     $ln eq 'tokens') {
365     #
366     } elsif ($self-><M::Node.hasChildNodes>) {
367     __DEEP{
368     my @child_nodes = @{$self-><AG::Node.childNodes>};
369     for my $child_node (@child_nodes) {
370 wakaba 1.61 my $nsuri = $child_node-><AG::Node.namespaceURI>;
371     if (defined $nsuri and
372     ($nsuri eq <Q::pc:> or $nsuri eq <Q::pc2:>)) {
373 wakaba 1.35 if ($child_node-><AG::Node.localName> eq 'variable') {
374     if (substr ($originalVariable, 0, 1) eq
375     $child_node-><AG::PerlVariable.variableType> and
376     not defined $child_node-><AG::PerlVariable.packageName> and
377     substr ($originalVariable, 1) eq
378     $child_node-><AG::PerlVariable.pcLocalName> and
379     not defined $child_node-><AG::PerlVariable.hashKey>) {
380     if (ref $newValue) {
381     $self-><M::Node.replaceChild> ($child_node => $newValue);
382     } else { ## ISSUE: Is this correct?
383     $child_node-><M::PerlCodeInlines.appendCode> ($newValue);
384     }
385     }
386     } else { ## Non-variable child
387     $child_node-><M::PerlCode.replaceVariable>
388     ($originalVariable => $newValue);
389     }
390     } else {
391     #
392     }
393     }
394     }__;
395     } # has child
396    
397     @ResourceDef:
398 wakaba 1.36 @@ForCheck: ManakaiDOM|ForClass
399 wakaba 1.35 @@QName: addNameListAttr
400     @@rdf:type: DISPerl|BlockCode
401     @@PerlDef:
402 wakaba 1.50 my $__v = $node-><M::Element.getAttributeNS> (<Q::pc:>, $attrName);
403 wakaba 1.35 my %__mn = map {$_ => true}
404 wakaba 1.50 split /\s+/, defined $__v ? $__v : '';
405 wakaba 1.35 $__mn{$newName} = true;
406     $node-><M::Element.setAttributeNS>
407     (<Q::pc:>, 'pc:'.$attrName => join ' ', keys %__mn);
408    
409 wakaba 1.13
410     @Method:
411     @@Name: addUsePerlModuleName
412     @@enDesc:
413     Adds a Perl module into the list of Perl modules
414     <Perl::use>d by this code fragment.
415     @@Param:
416     @@@Name: moduleName
417 wakaba 1.35 @@@Type: DOMString
418 wakaba 1.13 @@@enDesc:
419     The name of the module package that should be <Perl::use>d.
420     @@Return:
421     @@@PerlDef:
422 wakaba 1.35 __DEEP{
423     __CODE{addNameListAttr::
424     $node => {$self},
425     $attrName => 'useModuleName',
426     $newName => {$moduleName},
427     }__;
428     }__;
429 wakaba 1.13
430     @Method:
431 wakaba 1.22 @@Name: addUseCharClassName
432     @@enDesc:
433     Adds a Perl module into the list of Perl character classes
434     <Perl::use>d by this code fragment.
435     @@Param:
436     @@@Name: moduleName
437 wakaba 1.35 @@@Type: DOMString
438 wakaba 1.22 @@@enDesc:
439     The name of the module package that should be <Perl::use>d.
440     @@Param:
441     @@@Name: charClassName
442 wakaba 1.35 @@@Type: DOMString
443 wakaba 1.22 @@@enDesc:
444     The name of the character class.
445     @@Return:
446     @@@PerlDef:
447 wakaba 1.35 __DEEP{
448     __CODE{addNameListAttr::
449     $node => {$self},
450     $attrName => 'useCharClassName',
451     $newName => {$moduleName.'.'.$charClassName},
452     }__;
453     }__;
454 wakaba 1.22
455     @Method:
456 wakaba 1.19 @@Name: addRequirePerlModuleName
457     @@enDesc:
458     Adds a Perl module into the list of Perl modules
459     <Perl::require>d by this code fragment.
460     @@Param:
461     @@@Name: moduleName
462 wakaba 1.35 @@@Type: DOMString
463 wakaba 1.19 @@@enDesc:
464     The name of the module package that should be <Perl::require>d.
465     @@Return:
466     @@@PerlDef:
467 wakaba 1.35 __DEEP{
468     __CODE{addNameListAttr::
469     $node => {$self},
470     $attrName => 'requireModuleName',
471     $newName => {$moduleName},
472     }__;
473     }__;
474 wakaba 1.19
475     @Method:
476 wakaba 1.33 @@Name: addExceptionInterfacePackageName
477     @@enDesc:
478     Adds a Perl exception interface into the list of Perl packages.
479     @@Param:
480     @@@Name: moduleName
481 wakaba 1.35 @@@Type: DOMString
482 wakaba 1.33 @@@enDesc:
483     The name of the interface package.
484     @@Return:
485     @@@PerlDef:
486 wakaba 1.35 __DEEP{
487     __CODE{addNameListAttr::
488     $node => {$self},
489     $attrName => 'exceptionInterfaceName',
490     $newName => {$moduleName},
491     }__;
492     }__;
493    
494     @ResourceDef:
495 wakaba 1.36 @@ForCheck: ManakaiDOM|ForClass
496 wakaba 1.35 @@QName: getNameListAttrR
497     @@rdf:type: DISPerl|BlockCode
498     @@PerlDef:
499     my @__nodes = ($node);
500     my %__result;
501     while (@__nodes) {
502     my $__cnode = shift @__nodes;
503 wakaba 1.52 if ($__cnode-><AG::Node.nodeType> == <C::Node.ELEMENT_NODE>) {
504     my $__v = $__cnode-><M::Element.getAttributeNS>
505     (<Q::pc:>, $attrName);
506     for (split /\s+/, defined $__v ? $__v : '') {
507     $__result{$_} = true;
508     }
509     push @__nodes, @{$__cnode-><AG::Node.childNodes>};
510     }
511     }
512     $result = [sort {$a cmp $b} keys %__result];
513     @ResourceDef:
514     @@ForCheck: ManakaiDOM|ForClass
515     @@QName: getNameListAttrRM
516     @@rdf:type: DISPerl|BlockCode
517     @@enDesc:
518     Except <Q::pc:require> subtree.
519     @@PerlDef:
520     my @__nodes = ();
521     my %__result;
522     {
523     my $__cnode = $node;
524     if ($__cnode-><AG::Node.nodeType> == <C::Node.ELEMENT_NODE>) {
525     my $__v = $__cnode-><M::Element.getAttributeNS>
526     (<Q::pc:>, $attrName);
527     for (split /\s+/, defined $__v ? $__v : '') {
528     $__result{$_} = true;
529     }
530     push @__nodes, @{$__cnode-><AG::Node.childNodes>};
531     }
532     }
533     N: while (@__nodes) {
534     my $__cnode = shift @__nodes;
535     if ($__cnode-><AG::Node.nodeType> == <C::Node.ELEMENT_NODE>) {
536     if (defined $__cnode-><AG::Node.namespaceURI> and
537     $__cnode-><AG::Node.namespaceURI> eq <Q::pc:> and
538     $__cnode-><AG::Node.localName> eq 'package') {
539     next N;
540     }
541 wakaba 1.50 my $__v = $__cnode-><M::Element.getAttributeNS>
542     (<Q::pc:>, $attrName);
543     for (split /\s+/, defined $__v ? $__v : '') {
544 wakaba 1.35 $__result{$_} = true;
545     }
546     push @__nodes, @{$__cnode-><AG::Node.childNodes>};
547     }
548     }
549     $result = [sort {$a cmp $b} keys %__result];
550     @ResourceDef:
551 wakaba 1.36 @@ForCheck: ManakaiDOM|ForClass
552 wakaba 1.35 @@QName: getNameListAttr
553     @@rdf:type: DISPerl|BlockCode
554     @@PerlDef:
555 wakaba 1.50 my %__result;
556     my $__v = $node-><M::Element.getAttributeNS> (<Q::pc:>, $attrName);
557     for (split /\s+/, defined $__v ? $__v : '') {
558 wakaba 1.35 $__result{$_} = true;
559     }
560     $result = [sort {$a cmp $b} keys %__result];
561 wakaba 1.33
562     @Method:
563 wakaba 1.15 @@Name: getUsePerlModuleNameList
564     @@enDesc:
565     Returns a list of Perl modules names that is <Perl::use>d
566 wakaba 1.52 by this code fragment, including all descendant nodes
567     except <Q::pc:package> nodes and their descendant nodes.
568 wakaba 1.15 @@Return:
569 wakaba 1.35 @@@Type: DISPerl|ARRAY||ManakaiDOM|all
570 wakaba 1.15 @@@enDesc:
571     A list of module names. Note that the list is <EM::dead>;
572     any modification to it does not affect to the code fragment
573     and vice versa.
574     @@@PerlDef:
575 wakaba 1.35 __DEEP{
576 wakaba 1.52 __CODE{getNameListAttrRM::
577 wakaba 1.35 $node => {$self},
578     $attrName => 'useModuleName',
579     $result => {$r},
580     }__;
581     }__;
582 wakaba 1.15
583     @Method:
584 wakaba 1.22 @@Name: getUseCharClassNameList
585     @@enDesc:
586     Returns a list of Perl character class names that is <Perl::use>d
587 wakaba 1.52 by this code fragment, including all descendant nodes
588     except <Q::pc:package> nodes and their descendant nodes.
589 wakaba 1.22 @@Return:
590 wakaba 1.35 @@@Type: DISPerl|HASH||ManakaiDOM|all
591 wakaba 1.22 @@@enDesc:
592     A list of module names. Note that the list is <EM::dead>;
593     any modification to it does not affect to the code fragment
594     and vice versa.
595     @@@PerlDef:
596 wakaba 1.35 my $mc;
597     __DEEP{
598 wakaba 1.52 __CODE{getNameListAttrRM::
599 wakaba 1.35 $node => {$self},
600     $attrName => 'useCharClassName',
601     $result => {$mc},
602     }__;
603     }__;
604     for (@$mc) {
605     my ($m, $c) = split /\./, $_, 2;
606     $r->{$m}->{$c} = true;
607     }
608 wakaba 1.22
609     @Method:
610 wakaba 1.19 @@Name: getRequirePerlModuleNameList
611     @@enDesc:
612     Returns a list of Perl modules names that is <Perl::require>d
613     by this code fragment, including all descendant nodes.
614     @@Return:
615 wakaba 1.35 @@@Type: DISPerl|ARRAY||ManakaiDOM|all
616 wakaba 1.19 @@@enDesc:
617     A list of module names. Note that the list is <EM::dead>;
618     any modification to it does not affect to the code fragment
619     and vice versa.
620     @@@PerlDef:
621 wakaba 1.35 __DEEP{
622     __CODE{getNameListAttrR::
623     $node => {$self},
624     $attrName => 'requireModuleName',
625     $result => {$r},
626     }__;
627     }__;
628 wakaba 1.19
629     @Method:
630 wakaba 1.33 @@Name: getExceptionInterfacePackageNameList
631     @@enDesc:
632     Returns a list of Perl exception interface package names
633     by this code fragment, including all descendant nodes.
634     @@Return:
635 wakaba 1.35 @@@Type: DISPerl|ARRAY||ManakaiDOM|all
636 wakaba 1.33 @@@enDesc:
637     A list of package names. Note that the list is <EM::dead>;
638     any modification to it does not affect to the code fragment
639     and vice versa.
640     @@@PerlDef:
641 wakaba 1.35 __DEEP{
642     __CODE{getNameListAttrR::
643     $node => {$self},
644     $attrName => 'exceptionInterfaceName',
645     $result => {$r},
646     }__;
647     }__;
648 wakaba 1.33
649     @Method:
650 wakaba 1.13 @@Name: disAddRequireURI
651     @@enDesc:
652     Adds a <QUOTE::dis> resource into the list of <Perl::require>d
653     resources of this code fragment.
654     @@Param:
655     @@@Name: uriArg
656 wakaba 1.35 @@@Type: DOMString
657 wakaba 1.13 @@@enDesc:
658     The URI reference of the resource to add.
659     @@Return:
660     @@@PerlDef:
661 wakaba 1.35 __DEEP{
662     __CODE{addNameListAttr::
663     $node => {$self},
664     $attrName => 'requireResourceURI',
665     $newName => {$uriArg},
666     }__;
667     }__;
668 wakaba 1.15
669     @Method:
670     @@Name: disGetRequireURIList
671     @@enDesc:
672     Returns a list of <QUOTE::dis> resource URI references that is
673     <Perl::require>d by this code fragment, including all descendant nodes.
674     @@Return:
675 wakaba 1.35 @@@Type: DISPerl|ARRAY||ManakaiDOM|all
676 wakaba 1.15 @@@enDesc:
677     A list of resource URI references. Note that the list is <EM::dead>;
678     any modification to it does not affect to the code fragment
679     and vice versa.
680     @@@PerlDef:
681 wakaba 1.35 __DEEP{
682     __CODE{getNameListAttrR::
683     $node => {$self},
684     $attrName => 'requireResourceURI',
685     $result => {$r},
686     }__;
687     }__;
688    
689     @Method:
690 wakaba 1.36 @@ForCheck: ManakaiDOM|ForClass
691 wakaba 1.35 @@Operator: DISPerl|CloneMethod
692     @@Return:
693     @@@Type: PerlCode
694     @@@PerlDef:
695     __DEEP{
696     $r = $self-><M::Node.cloneNode> (true);
697     }__;
698 wakaba 1.25 ##PerlCode
699 wakaba 1.1
700 wakaba 1.59 ResourceDef:
701     @QName: AnyPCElement
702     @DISCore:resourceType: s|AnyElementInNS
703     @AppName:
704     @@@: pc|*
705     @@ContentType: DISCore|QName
706     @ForCheck: =ManakaiDOM|all
707    
708     ResourceDef:
709     @QName: AnyPC2Element
710     @DISCore:resourceType: s|AnyElementInNS
711     @AppName:
712     @@@: pc2|*
713     @@ContentType: DISCore|QName
714     @ForCheck: =ManakaiDOM|all
715    
716 wakaba 1.35 ElementTypeBinding:
717     @Name: ETQName
718     @ElementType:
719     dis:AppName
720     @ShadowContent:
721     @@ForCheck: s|ForML
722     @@ContentType: DISCore|QName
723    
724     IFClsETDef:
725 wakaba 1.25 @IFQName: PerlFile
726 wakaba 1.35 @CQName: ManakaiPCFile
727     @ETQName: pc|file
728 wakaba 1.41 @QName:
729     @@@: pc|file
730     @@ForCheck: s|ForML
731 wakaba 1.25
732     @IFISA: PerlCode
733    
734     @IFISA: PerlCodeStatements
735 wakaba 1.35 @CISA: ManakaiPCCodeStatements
736 wakaba 1.25
737 wakaba 1.1 @enDesc:
738     Perl source code files.
739    
740     @Method:
741     @@Name: appendNewPackage
742     @@enDesc:
743     Appends a new package scope block.
744     @@Param:
745     @@@Name: packageName
746 wakaba 1.35 @@@Type: DOMString
747 wakaba 1.1 @@@enDesc:
748     The fully-qualified name of the package to create.
749     @@Return:
750 wakaba 1.25 @@@Type: PerlPackage
751 wakaba 1.1 @@@enDesc:
752     The newly created package scope object.
753     @@@PerlDef:
754 wakaba 1.35 __DEEP{
755     $r = $self-><AG::Node.ownerDocument>-><M::Document.createElementNS>
756     (<Q::pc:>, 'package');
757     $r-><AS::PerlPackage.packageName> ($packageName);
758     $self-><M::Node.appendChild> ($r);
759     }__;
760 wakaba 1.1
761     @Method:
762     @@Name: getLastPackage
763     @@enDesc:
764     Gets the last package scope block of a name.
765     @@Param:
766     @@@Name: packageName
767 wakaba 1.36 @@@@Type: DOMString
768 wakaba 1.1 @@@@enDesc:
769     The fully-qualified name of the package to get.
770     @@NamedParam:
771     @@@Name: makeNewPackage
772 wakaba 1.36 @@@Type: idl|boolean||ManakaiDOM|all
773 wakaba 1.1 @@@enDesc:
774     Whether a new package scope object should be created if
775     no package of <P::packageName> found.
776     @@@TrueCase:
777     @@@@enDesc:
778     Makes a new object if not found.
779     @@@FalseCase:
780     @@@@enDesc:
781     Don't make a new object.
782     @@Return:
783 wakaba 1.25 @@@Type: PerlPackage
784 wakaba 1.1 @@@enDesc:
785     The last package scope object whose name is equal to
786     <P::packageName>.
787     @@@nullCase:
788     @@@@enDesc:
789     There is no <P::packageName> package object and
790     the <P::makeNewPackage> parameter is set to <DOM::false>.
791     @@@PerlDef:
792 wakaba 1.35 __DEEP{
793     for my $child (@{$self-><AG::Node.childNodes>}) {
794     if ($child-><AG::Node.nodeType> == <C::Node.ELEMENT_NODE> and
795     defined $child-><AG::Node.namespaceURI> and
796     $child-><AG::Node.namespaceURI> eq <Q::pc:> and
797     $child-><AG::Node.localName> eq 'package') {
798 wakaba 1.50 my $v = $child-><M::Element.getAttributeNS>
799     (<Q::pc:>, 'packageName');
800     if (defined $v and $v eq $packageName) {
801 wakaba 1.35 $r = $child;
802     }
803     }
804     }
805     if (not $r and $makeNewPackage) {
806     $r = $self-><M::PerlFile.appendNewPackage> ($packageName);
807     }
808     }__;
809 wakaba 1.1
810 wakaba 1.35 @ATTR:
811 wakaba 1.1 @@Name: sourceFile
812 wakaba 1.35 @@ATTRQName: pc|sourceFile
813 wakaba 1.1 @@enDesc:
814     The file name of the source file from which this
815     Perl code is primary generated.
816 wakaba 1.35 @@ReflectCDATA:
817 wakaba 1.1 @@Get:
818     @@Set:
819    
820 wakaba 1.35 @ATTR:
821 wakaba 1.1 @@Name: sourceModule
822 wakaba 1.35 @@ATTRQName: pc|sourceModule
823 wakaba 1.1 @@enDesc:
824     The name URI reference of the source module that this package defines.
825 wakaba 1.35 @@ReflectCDATA:
826 wakaba 1.1 @@Get:
827     @@Set:
828    
829 wakaba 1.35 @ATTR:
830 wakaba 1.1 @@Name: sourceFor
831 wakaba 1.35 @@ATTRQName: pc|sourceFor
832 wakaba 1.1 @@enDesc:
833     The URI reference of the source module <QUOTE::for> for which this
834     package is.
835 wakaba 1.35 @@ReflectCDATA:
836 wakaba 1.1 @@Get:
837     @@Set:
838    
839     @ToStringMethod:
840     @@Return:
841 wakaba 1.35 @@@Type: DOMString
842 wakaba 1.1 @@@enDesc:
843     The Perl code generated.
844     @@@PerlDef:
845 wakaba 1.35 __DEEP{
846     ## -- Header
847     $r = qq<#!/usr/bin/perl \n>;
848 wakaba 1.36 $r .= <ClassM::ManakaiPCImplementation.perlComment>
849 wakaba 1.35 (q<This file is automatically generated>);
850 wakaba 1.36 $r .= <ClassM::ManakaiPCImplementation.perlComment>
851     (q< at >.<ClassM::ManakaiPCImplementation
852 wakaba 1.35 .rfc3339DateTime> (time).q<,>);
853 wakaba 1.36 $r .= <ClassM::ManakaiPCImplementation.perlComment>
854 wakaba 1.35 (q< from file ">.$self-><AG::PerlFile.sourceFile>.q<",>);
855 wakaba 1.36 $r .= <ClassM::ManakaiPCImplementation.perlComment>
856 wakaba 1.35 (q[ module <].$self-><AG::PerlFile.sourceModule>.q[>,]);
857 wakaba 1.36 $r .= <ClassM::ManakaiPCImplementation.perlComment>
858 wakaba 1.35 (q[ for <].$self-><AG::PerlFile.sourceFor>.q[>.]);
859 wakaba 1.36 $r .= <ClassM::ManakaiPCImplementation.perlComment>
860 wakaba 1.35 (q<Don't edit by hand!>);
861     $r .= qq<use strict;\n>;
862     $self-><AS::PerlFile.currentPackage> ('main');
863    
864 wakaba 1.52 ## -- |require| Perl Modules
865 wakaba 1.35 my $req = $self-><M::PerlCode.getRequirePerlModuleNameList>;
866     for my $pack (sort {$a cmp $b} @$req) {
867     $r .= qq<require $pack;\n>;
868     }
869    
870 wakaba 1.52 ## -- |use| Perl Modules
871     for my $pack (sort {$a cmp $b} @{$self-><M::PerlCode
872     .getUsePerlModuleNameList>}) {
873     $r .= 'use ' . $pack . ";\n";
874     }
875    
876     ## -- |use| Character Classes
877     my $cls = $self-><M::PerlCode.getUseCharClassNameList>;
878     for my $pack (sort {$a cmp $b} keys %$cls) {
879     $r .= 'use ' . $pack . ' ' .
880     <ClassM::ManakaiPCImplementation.perlList>
881     ([sort {$a cmp $b} grep {$cls->{$pack}->{$_}}
882     keys %{$cls->{$pack}}]) . ";\n";
883     }
884    
885 wakaba 1.35 ## -- Packages and global objects
886     my $pack = {};
887     for my $child (@{$self-><AG::Node.childNodes>}) {
888     $r .= $child->stringify;
889     if ($child-><AG::Node.nodeType> == <C::Node.ELEMENT_NODE> and
890     defined $child-><AG::Node.namespaceURI> and
891     $child-><AG::Node.namespaceURI> eq <Q::pc:> and
892     $child-><AG::Node.localName> eq 'package') {
893     for my $ipack (@{$child-><M::PerlPackage
894     .getImplementPackageNameList>}) {
895     $pack->{$ipack} ||= true; # not defined
896     }
897     $pack->{$child-><AG::PerlPackage.packageName>} = []; # defined
898     }
899     }
900    
901     ## -- Exception interface packages
902     for (sort {$a cmp $b} @{$self-><M::PerlCode
903     .getExceptionInterfacePackageNameList>}) {
904     next if ref $pack->{$_};
905     $pack->{$_} = [];
906     $r .= sprintf q<push @%s::ISA, 'Message::Util::Error' >.
907     q<unless @%s::ISA;%s>, $_, $_, "\n";
908     }
909    
910     ## -- Enables interface packages
911     my @packs = map {'$' . $_ . '::'}
912     sort {$a cmp $b}
913     grep {not ref $pack->{$_} and $pack->{$_}}
914     keys %$pack;
915     $r .= q<for (>. join (', ', @packs) . qq<){}\n> if @packs;
916    
917     ## -- Footer
918 wakaba 1.36 $r .= <ClassM::ManakaiPCImplementation.perlComment>
919 wakaba 1.35 (q[License: <].$self-><AG::PerlFile.licenseURI>.qq[>\n]);
920     $r .= qq<1;\n>;
921     }__;
922 wakaba 1.1
923 wakaba 1.59 @ATTR:
924 wakaba 1.1 @@Name: currentPackage
925 wakaba 1.59 @@ATTRQName: pc|currentPackage
926 wakaba 1.1 @@enDesc:
927     The current Perl package (used in stringify method).
928 wakaba 1.59 @@ReflectCDATA:
929 wakaba 1.1 @@Get:
930     @@Set:
931    
932 wakaba 1.35 @ATTR:
933 wakaba 1.2 @@Name: licenseURI
934 wakaba 1.36 @@ATTRQName: pc|license
935 wakaba 1.2 @@enDesc:
936     The license term URI reference for this code.
937 wakaba 1.35 @@ReflectCDATA:
938 wakaba 1.2 @@Get:
939     @@Set:
940 wakaba 1.1 ##PerlFile
941    
942 wakaba 1.35 ElementTypeBinding:
943     @Name: ReflectCDATA
944     @ElementType:
945     dis:Type
946     @ShadowContent:
947     @@@: DOMString
948     @ShadowSibling:
949     @@actualType: CDATADOMString
950    
951 wakaba 1.64 ElementTypeBinding:
952     @Name: ReflectCDATA2
953     @ElementType:
954     dis:Type
955     @ShadowContent:
956     @@@: DOMString
957     @ShadowSibling:
958     @@actualType: CDATADOMString2
959    
960 wakaba 1.35 ResourceDef:
961     @QName: DOMString
962     @For: ManakaiDOM|Perl
963     @AliasFor: DOMMain|DOMString||ManakaiDOM|ManakaiDOMLatest
964    
965     ReflectTypeDef:
966     @QName: CDATADOMString
967     @enDesc:
968 wakaba 1.64 <TYPE::DOMString> for DOM attributes reflecting
969 wakaba 1.35 <SGML::CDATA> element attributes.
970 wakaba 1.59 @subsetOf: DOMString
971 wakaba 1.35 @ResourceDef:
972 wakaba 1.64 @@DISCore:resourceType: DOMMain|ReflectGet
973 wakaba 1.35 @@enDesc:
974     The DOM attribute returns the current value of the element attribute
975     in a transparent, case-sensitive manner.
976     \
977     If the element attribute is absent, the default value, if any,
978     or an empty string is returned.
979     @@PerlCDef:
980 wakaba 1.59 __DEEP{
981     $r = $self-><M::Element.getAttributeNS> ($NS_URI, $LOCAL_NAME);
982     $r = '' unless defined $r;
983 wakaba 1.35 }__;
984 wakaba 1.37
985 wakaba 1.35 @ResourceDef:
986     @@QName: CDATADOMStringSet
987 wakaba 1.64 @@DISCore:resourceType: DOMMain|ReflectSet
988     @@enDesc:
989     The corresponding element attribute is set to the given value,
990     in a transparent, case-sensitive manner.
991     @@ImplNote:
992     @@@lang:en
993     @@@@:
994     What will happen if the <DOM::null> value is given?
995     @@PerlCDef:
996     __DEEP{
997     if (defined $given) {
998     $self-><M::Element.setAttributeNS>
999     ($NS_URI, $QNAME, $given);
1000     } else {
1001     $self-><M::Element.removeAttributeNS> ($NS_URI, $LOCAL_NAME);
1002     }
1003     }__;
1004    
1005     ReflectTypeDef:
1006     @QName: CDATADOMString2
1007     @enDesc:
1008     <TYPE::DOMString> for DOM attributes reflecting
1009     <SGML::CDATA> element attributes.
1010     @subsetOf: DOMString
1011     @ResourceDef:
1012     @@DISCore:resourceType: DOMMain|ReflectGet
1013     @@enDesc:
1014     The DOM attribute returns the current value of the element attribute
1015     in a transparent, case-sensitive manner.
1016     \
1017     If the element attribute is absent, the default value, if any,
1018     or <DOM::null> is returned.
1019     @@PerlCDef:
1020     __DEEP{
1021     $r = $self-><M::Element.getAttributeNS> ($NS_URI, $LOCAL_NAME);
1022     }__;
1023    
1024     @ResourceDef:
1025     @@DISCore:resourceType: DOMMain|ReflectSet
1026 wakaba 1.35 @@enDesc:
1027     The corresponding element attribute is set to the given value,
1028     in a transparent, case-sensitive manner.
1029     @@ImplNote:
1030     @@@lang:en
1031     @@@@:
1032     What will happen if the <DOM::null> value is given?
1033     @@PerlCDef:
1034 wakaba 1.59 __DEEP{
1035     if (defined $given) {
1036     $self-><M::Element.setAttributeNS>
1037     ($NS_URI, $QNAME, $given);
1038     } else {
1039     $self-><M::Element.removeAttributeNS> ($NS_URI, $LOCAL_NAME);
1040     }
1041     }__;
1042 wakaba 1.35
1043     ElementTypeBinding:
1044     @Name: ReflectTypeDef
1045     @ElementType:
1046     dis:ResourceDef
1047     @ShadowContent:
1048     @@rdf:type: DISLang|DataType
1049     @@ForCheck: !ManakaiDOM|IDL
1050     @@For: ManakaiDOM|DOM
1051    
1052     ElementTypeBinding:
1053     @Name: ATTR
1054     @ElementType:
1055     dis:ResourceDef
1056     @ShadowContent:
1057     @@rdf:type:
1058     @@@@: s|Attribute
1059     @@@ForCheck: s|ForML
1060     @@rdf:type:
1061     @@@@: DISLang|Attribute
1062     @@@ForCheck: ManakaiDOM|ForClass
1063     @@rdf:type:
1064     @@@@: DISLang|Attribute
1065     @@@ForCheck: ManakaiDOM|ForIF
1066     @@DocAttr:
1067     @@@@: ||+||s|ForML
1068     @@@ContentType: DISCore|TFPQNames
1069     @@@ForCheck: ManakaiDOM|ForClass
1070     @@DocAttr:
1071     @@@@: ||+||s|ForML
1072     @@@ContentType: DISCore|TFPQNames
1073     @@@ForCheck: ManakaiDOM|ForIF
1074     @@ForCheck: !=ManakaiDOM|ManakaiDOM
1075    
1076     ElementTypeBinding:
1077     @Name: ATTRQName
1078     @ElementType:
1079     dis:AppName
1080     @ShadowContent:
1081     @@ForCheck: s|ForML
1082     @@ContentType: DISCore|QName
1083    
1084     IFClsETDef:
1085 wakaba 1.25 @IFQName: PerlPackage
1086 wakaba 1.35 @CQName: ManakaiPCPackage
1087     @ETQName: pc|package
1088 wakaba 1.25
1089     @IFISA: PerlCode
1090    
1091     @IFISA: PerlCodeStatements
1092 wakaba 1.35 @CISA: ManakaiPCCodeStatements
1093 wakaba 1.16
1094     @enDesc:
1095     A Perl lexical lines for which a <Perl::package> declaration
1096     in effect.
1097 wakaba 1.1
1098 wakaba 1.35 @ATTR:
1099 wakaba 1.1 @@Name: packageName
1100 wakaba 1.35 @@ATTRQName: pc|packageName
1101     @@ReflectCDATA:
1102 wakaba 1.1 @@enDesc:
1103     The fully-qualified package name.
1104     @@Get:
1105 wakaba 1.35 @@Set:
1106 wakaba 1.1
1107     @Method:
1108     @@Name: getSub
1109     @@enDesc:
1110     Gets a subroutine.
1111     @@Param:
1112     @@@Name: subName
1113 wakaba 1.36 @@@Type: DOMString
1114 wakaba 1.1 @@@enDesc:
1115     The name of subroutine to get.
1116     @@NamedParam:
1117     @@@Name: makeNewNode
1118 wakaba 1.36 @@@Type: idl|boolean||ManakaiDOM|all
1119 wakaba 1.1 @@@enDesc:
1120     Whether a new subroutine object should be created,
1121     if it is not exist, or not.
1122     @@Return:
1123 wakaba 1.25 @@@Type: PerlSub
1124 wakaba 1.1 @@@enDesc:
1125     The subroutine object.
1126 wakaba 1.4 @@@nullCase:
1127     @@@@enDesc:
1128     Either the specified subroutine is not found and
1129     the <P::makeNewNode> parameter is set to <DOM::false> or
1130     the subroutine is defined as an alias.
1131 wakaba 1.1 @@@PerlDef:
1132 wakaba 1.35 __DEEP{
1133     F: {
1134     for my $child (@{$self-><AG::Node.childNodes>}) {
1135     if ($child-><AG::Node.nodeType> == <C::Node.ELEMENT_NODE> and
1136     defined $child-><AG::Node.namespaceURI> and
1137     $child-><AG::Node.namespaceURI> eq <Q::pc:> and
1138     $child-><AG::Node.localName> eq 'sub') {
1139     if ($child-><M::PerlSub.hasPerlName> ($subName)) {
1140     $r = $child;
1141     last F;
1142     }
1143     }
1144     }
1145     if ($makeNewNode) {
1146     $r = $self-><AG::Node.ownerDocument>
1147     -><M::Document.createElementNS>
1148     (<Q::pc:>, 'sub');
1149     $r-><M::PerlSub.addPerlName> ($subName);
1150     $self-><M::Node.appendChild> ($r);
1151     }
1152     } # F
1153     }__;
1154 wakaba 1.1
1155 wakaba 1.4 @Method:
1156 wakaba 1.13 @@Name: addISAPackage
1157 wakaba 1.1 @@enDesc:
1158     Adds a class package that this class inherits.
1159     @@Param:
1160     @@@Name: packageName
1161 wakaba 1.35 @@@Type: DOMString
1162 wakaba 1.1 @@@enDesc:
1163     The name of package to add.
1164     @@Return:
1165     @@@PerlDef:
1166 wakaba 1.50 __DEEP{
1167     my $v = $self-><M::Element.getAttributeNS> (<Q::pc:>, 'extends');
1168     $self-><M::Element.setAttributeNS>
1169 wakaba 1.35 (<Q::pc:>, 'pc:extends' =>
1170 wakaba 1.50 join ' ', (split /\s+/, defined $v ? $v : ''), $packageName);
1171     }__;
1172 wakaba 1.35
1173     @Method:
1174     @@Name: getISAPackageNameList
1175     @@enDesc:
1176     Returns a list of names of packages extended by the package.
1177     @@Return:
1178     @@@Type: DISPerl|ARRAY||ManakaiDOM|all
1179     @@@enDesc:
1180     An ordered snapshot list of superpackage names.
1181     @@@PerlDef:
1182     __DEEP{
1183 wakaba 1.50 my $v = $self-><M::Element.getAttributeNS> (<Q::pc:>, 'extends');
1184     $r = [split /\s+/, defined $v ? $v : ''];
1185 wakaba 1.35 }__;
1186 wakaba 1.1
1187     @Method:
1188     @@Name: addImplementPackage
1189     @@enDesc:
1190     Adds a interface package that this class implements.
1191     @@Param:
1192     @@@Name: packageName
1193 wakaba 1.35 @@@Type: DOMString
1194 wakaba 1.1 @@@enDesc:
1195     The name of package to add.
1196     @@Return:
1197     @@@PerlDef:
1198 wakaba 1.35 __DEEP{
1199     __CODE{addNameListAttr::
1200     $node => {$self},
1201     $attrName => 'implements',
1202     $newName => {$packageName},
1203     }__;
1204     }__;
1205    
1206     @Method:
1207     @@Name: getImplementPackageNameList
1208     @@enDesc:
1209     Returns a list of names of packages implemented by the package.
1210     @@Return:
1211     @@@Type: DISPerl|ARRAY||ManakaiDOM|all
1212     @@@enDesc:
1213     An unordered snapshot list of interface packages.
1214     @@@PerlDef:
1215     __DEEP{
1216     __CODE{getNameListAttr::
1217     $node => {$self},
1218     $attrName => 'implements',
1219     $result => {$r},
1220     }__;
1221     }__;
1222 wakaba 1.1
1223     @ToStringMethod:
1224     @@Return:
1225 wakaba 1.35 @@@Type: DOMString
1226 wakaba 1.1 @@@enDesc:
1227     Perl code.
1228     @@@PerlDef:
1229 wakaba 1.35 __DEEP{
1230     my $file = $self-><AG::PerlCode.fileNode>;
1231    
1232     ## Package name
1233     my $pn = $self-><AG::PerlPackage.packageName>;
1234     $r .= q<package > . $pn . ";\n";
1235     $file-><AS::PerlFile.currentPackage> ($pn) if $file;
1236    
1237     ## Package version
1238     $r .= 'our $VERSION = '.
1239 wakaba 1.36 <ClassM::ManakaiPCImplementation.versionDateTime> (time).
1240 wakaba 1.35 ";\n";
1241    
1242     ## Inheritance
1243     my @isa = (@{$self-><M::PerlPackage.getISAPackageNameList>},
1244     sort {$a cmp $b} @{$self-><M::PerlPackage
1245     .getImplementPackageNameList>});
1246     if (@isa) {
1247     $r .= 'push our @ISA, ' .
1248 wakaba 1.36 <ClassM::ManakaiPCImplementation.perlList> (\@isa) .
1249 wakaba 1.35 ";\n";
1250     }
1251    
1252 wakaba 1.52 ## |use| Perl Modules
1253 wakaba 1.35 for my $pack (sort {$a cmp $b} @{$self-><M::PerlCode
1254     .getUsePerlModuleNameList>}) {
1255     $r .= 'use ' . $pack . ";\n";
1256     }
1257    
1258 wakaba 1.52 ## |use| Character Classes
1259 wakaba 1.35 my $cls = $self-><M::PerlCode.getUseCharClassNameList>;
1260     for my $pack (sort {$a cmp $b} keys %$cls) {
1261     $r .= 'use ' . $pack . ' ' .
1262 wakaba 1.36 <ClassM::ManakaiPCImplementation.perlList>
1263 wakaba 1.35 ([sort {$a cmp $b} grep {$cls->{$pack}->{$_}}
1264     keys %{$cls->{$pack}}]) . ";\n";
1265     }
1266    
1267     ## Package-scope objects
1268     my $has_bool;
1269     my $op = '';
1270     for my $child (@{$self-><AG::Node.childNodes>}) {
1271     if ($child-><AG::Node.nodeType> == <C::Node.ELEMENT_NODE> and
1272     defined $child-><AG::Node.namespaceURI> and
1273     $child-><AG::Node.namespaceURI> eq <Q::pc:>) {
1274     my $ln = $child-><AG::Node.localName>;
1275     if ($ln eq 'sub') {
1276     my $names = $child-><M::PerlSub.getPerlNameList>;
1277     my $ops = $child-><M::PerlSub.getPerlOperatorList>;
1278     if (@$names) {
1279     $r .= $child->stringify;
1280     if (@$names > 1) {
1281     $r .= sprintf q<*%s = \&%s;%s>,
1282     $_, $names->[0], "\n" for @$names[1..$#$names];
1283     }
1284     for (@$ops) {
1285     $op .= sprintf q['%s' => '%s', %s],
1286     $_ => $names->[0], "\n";
1287     $has_bool = true if $_ eq 'bool';
1288     }
1289     } else {
1290     my $v = $child->stringify;
1291     for (@$ops) {
1292     $op .= sprintf q['%s' => %s, %s], $_ => $v, "\n";
1293     $has_bool = true if $_ eq 'bool';
1294     }
1295     }
1296     } else {
1297     $r .= $child->stringify;
1298     }
1299 wakaba 1.49 } elsif ($child-><AG::Node.nodeType> == <C::Node.ELEMENT_NODE>) {
1300     $r .= $child;
1301     }
1302 wakaba 1.35 } # children
1303    
1304     if (length $op) {
1305     $r .= "use overload \n";
1306     $r .= "bool => sub () {1}, \n" unless $has_bool;
1307     $r .= $op . "fallback => 1;\n";
1308     }
1309    
1310     ## -- Exports
1311     my $xport = $self-><M::PerlPackage.getExportList>;
1312     if (map {values %$_} values %$xport) {
1313     $r .= q[our %EXPORT_TAG = (] .
1314 wakaba 1.36 <ClassM::ManakaiPCImplementation.perlList>
1315 wakaba 1.35 ([map {$_ => [sort {$a cmp $b} keys %{$xport->{$_}}]}
1316     sort {$a cmp $b} grep {length}
1317     keys %$xport]) . qq[);\n];
1318     $r .= q[our @EXPORT_OK = (] .
1319 wakaba 1.36 <ClassM::ManakaiPCImplementation.perlList>
1320 wakaba 1.35 ([map {sort {$a cmp $b} keys %{$xport->{$_}}}
1321     sort {$a cmp $b} keys %$xport]) . qq[);\n];
1322     $r .= q[use Exporter; push our @ISA, 'Exporter';] . qq[\n];
1323     }
1324     }__;
1325    
1326     @Method:
1327     @@Name: getExportList
1328     @@enDesc:
1329     Returns a list of export tag and names.
1330     @@Return:
1331     @@@Type: DISPerl|HASH||ManakaiDOM|all
1332     @@@enDesc:
1333     Snapshot list of lists.
1334     @@@PerlDef:
1335     my $mc;
1336     __DEEP{
1337     __CODE{getNameListAttr::
1338     $node => {$self},
1339     $attrName => 'export',
1340     $result => {$mc},
1341     }__;
1342     }__;
1343     for (@$mc) {
1344     my ($m, $c) = split /\./, $_, 2;
1345     $r->{$m}->{$c} = true;
1346     }
1347 wakaba 1.18
1348     @Method:
1349     @@Name: addExport
1350     @@enDesc:
1351 wakaba 1.26 Adds a name to the list of exported items (<Perl::@EXPORT_OK>).
1352 wakaba 1.18 @@Param:
1353     @@@Name: exportTag
1354 wakaba 1.35 @@@Type: DOMString
1355 wakaba 1.18 @@@enDesc:
1356     The name of the tag (without <CHAR::COLON> prefix).
1357     The <P::exportName> is added both to <Perl::@EXPORT_OK>
1358     and <Perl::$EXPORT_OK{<P::exportTag>}>.
1359     @@@nullCase:
1360     @@@@enDesc:
1361     The <P::exportName> is added only to the <Perl::@EXPORT_OK>.
1362     @@Param:
1363     @@@Name: exportName
1364 wakaba 1.35 @@@Type: DOMString
1365 wakaba 1.18 @@@enDesc:
1366     The name to be exported.
1367     @@Return:
1368     @@@PerlDef:
1369 wakaba 1.35 __DEEP{
1370     __CODE{addNameListAttr::
1371     $node => {$self},
1372     $attrName => 'export',
1373     $newName => {$exportTag.'.'.$exportName},
1374     }__;
1375     }__;
1376 wakaba 1.36 ##PCPackage
1377 wakaba 1.4
1378 wakaba 1.35 IFClsETDef:
1379 wakaba 1.25 @IFQName: PerlCodeStatements
1380 wakaba 1.35 @CQName: ManakaiPCCodeStatements
1381     @ETQName:
1382     @@@: pc|statementContainer
1383     @@ImplNote:
1384     @@@lang:en
1385     @@@@: Dummy.
1386 wakaba 1.25
1387     @IFISA: PerlCodeUnits
1388 wakaba 1.35 @CISA: ManakaiPCCodeUnits
1389 wakaba 1.36
1390 wakaba 1.1 @enDesc:
1391 wakaba 1.6 A base class for node types that contains zero or more
1392     statements and/or blocks.
1393 wakaba 1.1
1394     @Method:
1395     @@Name: appendCode
1396     @@enDesc:
1397     Appends an unparsed Perl code fragment.
1398     @@Param:
1399     @@@Name: codeArg
1400 wakaba 1.35 @@@Type: DOMString
1401 wakaba 1.1 @@@enDesc:
1402     An unparsed Perl code fragment.
1403     @@Return:
1404 wakaba 1.25 @@@Type: PerlUnparsedCode
1405 wakaba 1.1 @@@enDesc:
1406     The newly created Perl code object.
1407     @@@PerlDef:
1408 wakaba 1.35 __DEEP{
1409     $r = $self-><AG::Node.ownerDocument>-><M::Document.createElementNS>
1410     (<Q::pc:>, 'unparsed');
1411     $r-><AS::Node.textContent> ($codeArg);
1412     $self-><M::Node.appendChild> ($r);
1413     }__;
1414 wakaba 1.1
1415 wakaba 1.35 @ATTR:
1416 wakaba 1.8 @@Name: label
1417 wakaba 1.35 @@ATTRQName: pc|label
1418 wakaba 1.8 @@enDesc:
1419     Label for this block.
1420 wakaba 1.35 @@ReflectCDATA:
1421 wakaba 1.8 @@Get:
1422     @@@nullCase:
1423     @@@@enDesc:
1424     No label.
1425     @@Set:
1426     @@@nullCase:
1427     @@@@enDesc:
1428     No label.
1429    
1430     @Method:
1431     @@Name: appendBlock
1432     @@enDesc:
1433     Appends a Perl block code.
1434     @@Return:
1435 wakaba 1.25 @@@Type: PerlBlock
1436 wakaba 1.8 @@@enDesc:
1437     The newly created Perl code object.
1438     @@@PerlDef:
1439 wakaba 1.35 __DEEP{
1440     $r = $self-><AG::Node.ownerDocument>-><M::Document.createElementNS>
1441     (<Q::pc:>, 'block');
1442     $self-><M::Node.appendChild> ($r);
1443     }__;
1444 wakaba 1.8
1445     @Method:
1446     @@Name: appendStatement
1447     @@enDesc:
1448     Appends a Perl statement.
1449     @@Param:
1450     @@@Name: codeArg
1451 wakaba 1.36 @@@Type: DOMString
1452 wakaba 1.8 @@@enDesc:
1453     A Perl statement without terminating <Perl::;>.
1454     @@@nullCase:
1455     @@@@enDesc:
1456     No initial content.
1457     @@Return:
1458 wakaba 1.25 @@@Type: PerlStatement
1459 wakaba 1.8 @@@enDesc:
1460     The newly created Perl code object.
1461     @@@PerlDef:
1462 wakaba 1.35 __DEEP{
1463     $r = $self-><AG::Node.ownerDocument>-><M::Document.createElementNS>
1464     (<Q::pc:>, 'statement');
1465     if (defined $codeArg) {
1466     $r-><M::PerlCodeUnits.appendBare> ($codeArg);
1467     }
1468     $self-><M::Node.appendChild> ($r);
1469     }__;
1470 wakaba 1.12
1471     @Method:
1472 wakaba 1.44 @@Name: appendNewPCBlock
1473     @@enDesc:
1474     Creates a <Q::pc2:block> and appends it to the node.
1475     @@Return:
1476     @@@Type: PCBlock
1477     @@@enDesc:
1478     The newly created block element.
1479     @@@PerlDef:
1480     __DEEP{
1481     $r = $self-><AG::Node.ownerDocument>-><M::PCDocument.createPCBlock>;
1482     $self-><M::Node.appendChild> ($r);
1483     }__;
1484    
1485     @Method:
1486     @@Name: appendNewPCChoose
1487     @@enDesc:
1488     Creates a <Q::pc:choose> and appends it to the node.
1489     @@Return:
1490     @@@Type: PCChoose
1491     @@@enDesc:
1492     The newly created choose element.
1493     @@@PerlDef:
1494     __DEEP{
1495     $r = $self-><AG::Node.ownerDocument>-><M::PCDocument.createPCChoose>;
1496     $self-><M::Node.appendChild> ($r);
1497     }__;
1498    
1499     @Method:
1500 wakaba 1.45 @@Name: appendNewPCWhile
1501     @@enDesc:
1502     Creates a <Q::pc:while> and appends it to the node.
1503     @@Return:
1504     @@@Type: PCWhile
1505     @@@enDesc:
1506     The newly created while element.
1507     @@@PerlDef:
1508     __DEEP{
1509     $r = $self-><AG::Node.ownerDocument>-><M::PCDocument.createPCWhile>;
1510     $self-><M::Node.appendChild> ($r);
1511     }__;
1512    
1513     @Method:
1514 wakaba 1.12 @@Name: appendNewIf
1515     @@enDesc:
1516     Appends a newly created <Class::ManakaiPerlIf> object.
1517     @@Param:
1518     @@@Name: conditionArg
1519 wakaba 1.25 @@@Type: PerlCode
1520 wakaba 1.12 @@@enDesc:
1521     Conditoon code fragment object.
1522     @@Param:
1523     @@@Name: trueArg
1524 wakaba 1.25 @@@Type: PerlCode
1525 wakaba 1.12 @@@enDesc:
1526     A true code fragment object.
1527     @@@nullCase:
1528     @@@@enDesc: No true code.
1529     @@Param:
1530     @@@Name: falseArg
1531 wakaba 1.25 @@@Type: PerlCode
1532 wakaba 1.12 @@@enDesc:
1533     A false code fragment object.
1534     @@@nullCase:
1535     @@@@enDesc: No false code.
1536     @@Return:
1537 wakaba 1.36 @@@Type: PerlIf
1538 wakaba 1.35 @@@enDesc:
1539     The newly created element.
1540 wakaba 1.61 @@@PerlDef:
1541 wakaba 1.35 __DEEP{
1542     $r = $self-><AG::Node.ownerDocument>-><M::Document.createElementNS>
1543     (<Q::pc:>, 'if');
1544     $r-><AS::PerlIf.condition> ($conditionArg);
1545     $r-><AS::PerlIf.trueCode> ($trueArg) if $trueArg;
1546     $r-><AS::PerlIf.falseCode> ($falseArg) if $falseArg;
1547     $self-><M::Node.appendChild> ($r);
1548     }__;
1549     ##PCIf
1550    
1551     IFClsETDef:
1552 wakaba 1.25 @IFQName: PerlSub
1553 wakaba 1.35 @CQName: ManakaiPCSub
1554     @ETQName: pc|sub
1555 wakaba 1.25
1556     @IFISA: PerlCode
1557    
1558     @IFISA: PerlCodeStatements
1559 wakaba 1.35 @CISA: ManakaiPCCodeStatements
1560 wakaba 1.25
1561 wakaba 1.6 @enDesc:
1562 wakaba 1.36 Perl subroutines.
1563 wakaba 1.20
1564 wakaba 1.6 @Attr:
1565 wakaba 1.35 @@Name: pcLocalName
1566 wakaba 1.6 @@enDesc:
1567     The name of this subroutine.
1568 wakaba 1.35 @@Type: DOMString
1569 wakaba 1.6 @@Get:
1570     @@@nullCase:
1571     @@@@enDesc:
1572     This subroutine has no name.
1573 wakaba 1.35 @@@PerlDef:
1574     __DEEP{
1575     $r = $self-><M::PerlSub.getPerlNameList>->[0];
1576     }__;
1577 wakaba 1.6
1578 wakaba 1.35 @Method:
1579     @@Name: addPerlName
1580     @@enDesc:
1581     Adds a subroutine name.
1582     @@Param:
1583     @@@Name: subName
1584     @@@Type: DOMString
1585     @@@enDesc: The name to add.
1586     @@Return:
1587     @@@PerlDef:
1588     __DEEP{
1589     __CODE{addNameListAttr::
1590     $node => {$self},
1591     $attrName => 'localName',
1592     $newName => {$subName},
1593     }__;
1594     }__;
1595    
1596     @Method:
1597     @@Name: getPerlNameList
1598     @@enDesc:
1599     Returns a list of names of the subroutine.
1600     @@Return:
1601     @@@Type: DISPerl|ARRAY||ManakaiDOM|all
1602     @@@enDesc:
1603     An unordered snapshot list of names.
1604     @@@PerlDef:
1605     __DEEP{
1606     __CODE{getNameListAttr::
1607     $node => {$self},
1608     $attrName => 'localName',
1609     $result => {$r},
1610     }__;
1611     }__;
1612    
1613     @Method:
1614     @@Name: hasPerlName
1615     @@enDesc:
1616     Returns whether the subroutine has a name or not.
1617     @@Param:
1618     @@@Name: subName
1619     @@@Type: DOMString
1620     @@@enDesc: The name.
1621     @@Return:
1622     @@@Type: idl|boolean||ManakaiDOM|all
1623     @@@PerlDef:
1624     __DEEP{
1625     my $l;
1626     __CODE{getNameListAttr::
1627     $node => {$self},
1628     $attrName => 'localName',
1629     $result => {$l},
1630     }__;
1631     F: for (@$l) {
1632     if ($_ eq $subName) {
1633     $r = true;
1634     last F;
1635     }
1636     }
1637     }__;
1638    
1639     @Method:
1640 wakaba 1.47 @@Name: clearPerlName
1641     @@enDesc:
1642     Removes all Perl name associated to the <IF::PerlSub>.
1643     @@Return:
1644     @@@PerlDef:
1645     __DEEP{
1646     $self-><M::Element.removeAttributeNS> (<Q::pc:>, 'localName');
1647     }__;
1648    
1649     @Method:
1650 wakaba 1.35 @@Name: addPerlOperator
1651     @@enDesc:
1652     Adds an operator overloaded by the method.
1653     @@Param:
1654     @@@Name: op
1655     @@@Type: DOMString
1656     @@@enDesc: The operator to add.
1657     @@Return:
1658     @@@PerlDef:
1659     __DEEP{
1660     __CODE{addNameListAttr::
1661     $node => {$self},
1662     $attrName => 'operator',
1663     $newName => {$op},
1664     }__;
1665     }__;
1666    
1667     @Method:
1668     @@Name: getPerlOperatorList
1669     @@enDesc:
1670     Returns a list of operators of the subroutine.
1671     @@Return:
1672     @@@Type: DISPerl|ARRAY||ManakaiDOM|all
1673     @@@enDesc:
1674     An unordered snapshot list of operators.
1675     @@@PerlDef:
1676     __DEEP{
1677     __CODE{getNameListAttr::
1678     $node => {$self},
1679     $attrName => 'operator',
1680     $result => {$r},
1681     }__;
1682     }__;
1683    
1684     @Method:
1685     @@Name: hasPerlOperator
1686     @@enDesc:
1687     Returns whether the subroutine has an operator or not.
1688     @@Param:
1689     @@@Name: op
1690     @@@Type: DOMString
1691     @@@enDesc: The operator.
1692     @@Return:
1693     @@@Type: idl|boolean||ManakaiDOM|all
1694     @@@PerlDef:
1695     __DEEP{
1696     my $l;
1697     __CODE{getNameListAttr::
1698     $node => {$self},
1699     $attrName => 'operator',
1700     $result => {$l},
1701     }__;
1702     F: for (@$l) {
1703     if ($_ eq $op) {
1704     $r = true;
1705     last F;
1706     }
1707     }
1708     }__;
1709    
1710     @ATTR:
1711 wakaba 1.6 @@Name: prototype
1712 wakaba 1.35 @@ATTRQName: pc|prototype
1713 wakaba 1.6 @@enDesc:
1714     The prototype of this subroutine.
1715 wakaba 1.64 @@ReflectCDATA2:
1716 wakaba 1.6 @@Get:
1717     @@@nullCase:
1718     @@@@enDesc:
1719     No prototype is set.
1720     @@Set:
1721     @@@nullCase:
1722     @@@@enDesc:
1723     No prototype declaration.
1724 wakaba 1.42
1725     @@Test:
1726 wakaba 1.51 @@@QName: PCSub.prototype.empty.test
1727 wakaba 1.42 @@@enDesc:
1728     Getting value after setting empty value must return an empty string.
1729     @@@PerlDef:
1730 wakaba 1.62 my $doc;
1731     __CODE{createPCDocumentForTest:: $doc => $doc}__;
1732    
1733     my $sub = $doc-><M::PCDocument.createPerlSub> ("sub_name");
1734    
1735     $test->id ('PerlSub');
1736 wakaba 1.42 $test->assert_not_null ($sub);
1737    
1738 wakaba 1.62 $test->id ('default');
1739     $test->assert_null ($sub-><AG::PerlSub.prototype>);
1740    
1741 wakaba 1.42 $sub-><AS::PerlSub.prototype> ('');
1742 wakaba 1.62
1743     $test->id ('attribute');
1744 wakaba 1.42 $test->assert_string (actual_value => $sub-><AG::PerlSub.prototype>,
1745     expected_value => '');
1746 wakaba 1.62
1747     $test->id ('stringify');
1748 wakaba 1.42 $test->assert_true ($sub->stringify =~ /^sub sub_name \(\)/);
1749 wakaba 1.6
1750 wakaba 1.4 @ToStringMethod:
1751     @@Return:
1752 wakaba 1.35 @@@Type: DOMString
1753 wakaba 1.4 @@@enDesc:
1754     Perl code.
1755     @@@PerlDef:
1756 wakaba 1.35 __DEEP{
1757     $r = q<sub>;
1758     my $nm = $self-><M::PerlSub.getPerlNameList>;
1759     $r .= q< > . $nm->[0] if @$nm;
1760 wakaba 1.42 if ($self-><M::Element.hasAttributeNS> (<Q::pc:>, 'prototype')) {
1761     $r .= q< (> . $self-><AG::PerlSub.prototype> . q<)>;
1762     }
1763 wakaba 1.35 $r .= qq< {\n>;
1764     for my $child (@{$self-><AG::Node.childNodes>}) {
1765     $r .= $child->stringify;
1766     }
1767     $r .= qq<}\n>;
1768     }__;
1769 wakaba 1.14
1770     @NumValMethod:
1771     @@Return:
1772 wakaba 1.35 @@@Type: idl|unsignedLong||ManakaiDOM|all
1773 wakaba 1.14 @@@PerlDef:
1774 wakaba 1.35 __DEEP{
1775     $r = 0 + $self-><AG::Node.lastChild>;
1776     }__;
1777 wakaba 1.47 ##PerlSub
1778 wakaba 1.1
1779 wakaba 1.42 ElementTypeBinding:
1780     @Name: Test
1781     @ElementType:
1782     dis:ResourceDef
1783     @ShadowContent:
1784 wakaba 1.59 @@DISCore:resourceType: test|StandaloneTest
1785 wakaba 1.51 @@ForCheck: ManakaiDOM|ForClass
1786 wakaba 1.42
1787 wakaba 1.54 ElementTypeBinding:
1788     @Name: TestC
1789     @ElementType:
1790     dis:ResourceDef
1791     @ShadowContent:
1792     @@rdf:type: test|StandaloneTest
1793    
1794 wakaba 1.35 IFClsETDef:
1795 wakaba 1.25 @IFQName: PerlUnparsedCode
1796 wakaba 1.35 @CQName: ManakaiPCUnparsedCode
1797     @ETQName: pc|unparsed
1798 wakaba 1.25
1799     @IFISA: PerlCode
1800 wakaba 1.35 @CISA: ManakaiPCCode
1801 wakaba 1.25
1802 wakaba 1.1 @enDesc:
1803     Unparsed Perl code fragments.
1804 wakaba 1.5
1805 wakaba 1.6 @ToStringMethod:
1806     @@Return:
1807 wakaba 1.35 @@@Type: DOMString
1808 wakaba 1.6 @@@enDesc:
1809     Perl code.
1810     @@@PerlDef:
1811 wakaba 1.35 __DEEP{
1812 wakaba 1.39 $r = "\x0A" . $self-><AG::Node.textContent> . "\x0A";
1813 wakaba 1.35 }__;
1814 wakaba 1.1 ##PerlUnparsedCode
1815    
1816 wakaba 1.35 IFClsETDef:
1817 wakaba 1.25 @IFQName: PerlInlineUnparsedCode
1818 wakaba 1.35 @CQName: ManakaiPCInlineUnparsedCode
1819     @ETQName: pc|inlineUnparsed
1820 wakaba 1.25
1821     @IFISA: PerlCode
1822 wakaba 1.35 @CISA: ManakaiPCCode
1823 wakaba 1.25
1824 wakaba 1.6 @enDesc:
1825 wakaba 1.36 Unparsed Perl inline code fragments.
1826 wakaba 1.6
1827 wakaba 1.36 @ToStringMethod:
1828 wakaba 1.9 @@Return:
1829 wakaba 1.36 @@@Type: DOMString
1830     @@@enDesc:
1831     Perl code.
1832 wakaba 1.59 @@@PerlDef:
1833     __DEEP{
1834     $r = $self-><AG::Node.textContent>;
1835     }__;
1836 wakaba 1.36 ##PCInlineUnparsedCode
1837 wakaba 1.6
1838 wakaba 1.35 IFClsETDef:
1839 wakaba 1.44 @IFQName: PCNumberLiteral
1840     @CQName: ManakaiPCNumberLiteral
1841     @ETQName: pc|numberLiteral
1842    
1843     @IFISA: PerlCode
1844     @CISA: ManakaiPCCode
1845    
1846     @enDesc:
1847     A <IF::PCNumberLiteral> object represents a Perl number literal.
1848     The <A::Node.textContent> of a <IF::PCNumberLiteral> object
1849     is a Perl source code representation of the number for the object.
1850    
1851     @ToStringMethod:
1852     @@Return:
1853     @@@Type: DOMString
1854     @@@PerlDef:
1855     __DEEP{
1856     $r = $self-><AG::Node.textContent>;
1857     }__;
1858     ##PCNumberLiteral
1859    
1860     IFClsETDef:
1861 wakaba 1.25 @IFQName: PerlStringLiteral
1862 wakaba 1.35 @CQName: ManakaiPCPerlStringLiteral
1863     @ETQName: pc|stringLiteral
1864 wakaba 1.25
1865     @IFISA: PerlCode
1866 wakaba 1.35 @CISA: ManakaiPCCode
1867 wakaba 1.25
1868 wakaba 1.6 @enDesc:
1869 wakaba 1.36 Perl string literal.
1870 wakaba 1.6
1871 wakaba 1.14 @NumValMethod:
1872     @@Return:
1873 wakaba 1.35 @@@Type: idl|unsignedLong||ManakaiDOM|all
1874 wakaba 1.14 @@@enDesc:
1875     Numeric value of the Perl code.
1876     @@@PerlDef:
1877 wakaba 1.35 __DEEP{
1878     $r = 0 + $self-><AG::Node.textContent>;
1879     }__;
1880 wakaba 1.14
1881 wakaba 1.6 @ToStringMethod:
1882     @@Return:
1883 wakaba 1.35 @@@Type: DOMString
1884 wakaba 1.6 @@@enDesc:
1885     Perl code.
1886     @@@PerlDef:
1887 wakaba 1.35 __DEEP{
1888     $r = $self-><AG::Node.textContent>;
1889     $r =~ s/(['\\])/\\$1/g;
1890 wakaba 1.57 my $escaped = ($r =~ s{([^\x0A\x0D\x20-\x7E])}
1891     {sprintf '\x{%X}', ord $1}ge);
1892     if ($escaped or
1893     $self-><AG::Node.ownerDocument>
1894 wakaba 1.54 -><AG::Document.domConfig>
1895 wakaba 1.59 -><M::CFG.getParameter>
1896 wakaba 1.54 (<Q::pc:preserve-line-break>)) {
1897     $r =~ s/\x0D/\\x0D/gs;
1898     $r =~ s/\x0A/\\x0A/gs;
1899     $r =~ s/\@/\\\@/g;
1900     $r =~ s/\$/\\\$/g;
1901     $r =~ s/"/\\"/g;
1902     $r = q<"> . $r . q<">;
1903     } else {
1904     $r = q<'> . $r . q<'>;
1905     }
1906 wakaba 1.35 }__;
1907 wakaba 1.6 ##PerlStringLiteral
1908    
1909 wakaba 1.35 IFClsETDef:
1910 wakaba 1.41 @IFQName: PCList
1911     @CQName: ManakaiPCList
1912     @ETQName: pc|list
1913    
1914     @IFISA: PerlCode
1915 wakaba 1.42 @CISA: ManakaiPCCode
1916 wakaba 1.41
1917     @enDesc:
1918     A <IF::PCList> is a Perl list, i.e. <CHAR::COMMA> separated
1919     list of values.
1920    
1921     @Method:
1922     @@Name: item
1923     @@enDesc:
1924     Returns the <P::index>th item in the list.
1925     @@Param:
1926     @@@Name: index
1927     @@@Type: unsignedLong
1928     @@@enDesc:
1929     The ordinal index of the item.
1930     @@Return:
1931     @@@Type: PerlCodeInlines
1932     @@@enDesc:
1933     The <P::index>th item in the list.
1934     @@@nullCase:
1935     @@@@enDesc:
1936     Either <P::index> is negative or the <P::index> is
1937     greater than the number of the items in the list.
1938     @@@PerlDef:
1939     __DEEP{
1940     $r = $self-><AG::Node.childNodes>-><M::NodeList.item> ($index);
1941     }__;
1942    
1943     @Attr:
1944     @@Name: length
1945     @@enDesc:
1946     The number of items in the list.
1947     @@Type: unsignedLong
1948     @@Get:
1949     @@@PerlDef:
1950     __DEEP{
1951     $r = $self-><AG::Node.childNodes>-><AG::NodeList.length>;
1952     }__;
1953    
1954     @ToStringMethod:
1955     @@Return:
1956     @@@Type: DOMString
1957     @@@enDesc:
1958     Perl code.
1959     @@@PerlDef:
1960     __DEEP{
1961     my @r = map {$_->stringify} @{$self-><AG::Node.childNodes>};
1962     $r = '(' . join (', ', @r) . ')';
1963     }__;
1964     ##PCList
1965    
1966     IFClsETDef:
1967     @IFQName: PCArrayRefLiteral
1968     @CQName: ManakaiPCArrayRefLiteral
1969 wakaba 1.44 @ETQName: pc|arrayRefLiteral
1970 wakaba 1.41
1971     @IFISA: PerlCode
1972 wakaba 1.42 @CISA: ManakaiPCCode
1973 wakaba 1.41
1974     @enDesc:
1975     A <IF::PCArrayRefLiteral> is a Perl array reference literal.
1976    
1977     @Method:
1978     @@Name: item
1979     @@enDesc:
1980     Returns the <P::index>th item in the list.
1981     @@Param:
1982     @@@Name: index
1983     @@@Type: unsignedLong
1984     @@@enDesc:
1985     The ordinal index of the item.
1986     @@Return:
1987     @@@Type: PerlCodeInlines
1988     @@@enDesc:
1989     The <P::index>th item in the list.
1990     @@@nullCase:
1991     @@@@enDesc:
1992     Either <P::index> is negative or the <P::index> is
1993     greater than the number of the items in the list.
1994     @@@PerlDef:
1995     __DEEP{
1996     $r = $self-><AG::Node.childNodes>-><M::NodeList.item> ($index);
1997     }__;
1998    
1999     @Attr:
2000     @@Name: length
2001     @@enDesc:
2002     The number of items in the list.
2003     @@Type: unsignedLong
2004     @@Get:
2005     @@@PerlDef:
2006     __DEEP{
2007     $r = $self-><AG::Node.childNodes>-><AG::NodeList.length>;
2008     }__;
2009    
2010     @ToStringMethod:
2011     @@Return:
2012     @@@Type: DOMString
2013     @@@enDesc:
2014     Perl code.
2015     @@@PerlDef:
2016     __DEEP{
2017     my @r = map {$_->stringify} @{$self-><AG::Node.childNodes>};
2018 wakaba 1.58 $r = '[' . join (",\n", @r) . ']';
2019 wakaba 1.41 }__;
2020     ##PCArrayRefLiteral
2021    
2022     IFClsETDef:
2023     @IFQName: PCHashRefLiteral
2024     @CQName: ManakaiPCHashRefLiteral
2025 wakaba 1.44 @ETQName: pc|hashRefLiteral
2026 wakaba 1.41
2027     @IFISA: PerlCode
2028 wakaba 1.42 @CISA: ManakaiPCCode
2029 wakaba 1.41
2030     @enDesc:
2031     A <IF::PCHashRefLiteral> is a Perl hash reference literal.
2032    
2033     @Method:
2034     @@Name: key
2035     @@enDesc:
2036     Returns the <P::index>th key in the list.
2037    
2038     {NOTE:: Although the order of key-value pairs is
2039     preserved in the object, it is not preserved
2040     in Perl source codes and in Perl language.
2041     }
2042     @@Param:
2043     @@@Name: index
2044     @@@Type: unsignedLong
2045     @@@enDesc:
2046     The ordinal index of the key.
2047     @@Return:
2048     @@@Type: PerlCodeInlines
2049     @@@enDesc:
2050     The <P::index>th key in the list.
2051     @@@nullCase:
2052     @@@@enDesc:
2053     Either <P::index> is negative or the <P::index> is
2054     greater than the number of the keys in the list.
2055     @@@PerlDef:
2056     __DEEP{
2057     $r = $self-><AG::Node.childNodes>-><M::NodeList.item> ($index * 2);
2058     }__;
2059    
2060     @Method:
2061     @@Name: value
2062     @@enDesc:
2063     Returns the <P::index>th value in the list.
2064    
2065     {NOTE:: Although the order of key-value pairs is
2066     preserved in the object, it is not preserved
2067     in Perl source codes and in Perl language.
2068     }
2069     @@Param:
2070     @@@Name: index
2071     @@@Type: unsignedLong
2072     @@@enDesc:
2073     The ordinal index of the value.
2074     @@Return:
2075     @@@Type: PerlCodeInlines
2076     @@@enDesc:
2077     The <P::index>th value in the list.
2078     @@@nullCase:
2079     @@@@enDesc:
2080     Either <P::index> is negative or the <P::index> is
2081     greater than the number of the values in the list.
2082    
2083     {NOTE:: <MATH::<A::PCHashRefLiteral.length> - 1>th
2084     value might not be found.
2085     }
2086     @@@PerlDef:
2087     __DEEP{
2088     $r = $self-><AG::Node.childNodes>-><M::NodeList.item> ($index * 2 + 1);
2089     }__;
2090    
2091     @Attr:
2092     @@Name: length
2093     @@enDesc:
2094     The number of key-value pairs in the list.
2095     @@Type: unsignedLong
2096     @@Get:
2097     @@@PerlDef:
2098     __DEEP{
2099     my $length = $self-><AG::Node.childNodes>-><AG::NodeList.length>;
2100     $r = int ($length / 2) + ($length % 2);
2101     }__;
2102    
2103     @Method:
2104     @@Name: setNamedItem
2105     @@enDesc:
2106     Set a named item.
2107     @@Param:
2108     @@@Name: key
2109     @@@Type: DOMString
2110     @@@enDesc:
2111     The key.
2112     @@Param:
2113     @@@Name: value
2114     @@@Type: PerlCodeInlines
2115     @@@enDesc:
2116     The value.
2117     @@Return:
2118     @@@PerlDef:
2119     __DEEP{
2120     my @children = @{$self-><AG::Node.childNodes>};
2121     R: {
2122     while (@children) {
2123     my $ckey = shift @children;
2124     my $cval = shift @children;
2125     if ($ckey-><AG::Node.textContent> eq $key) {
2126     $self-><M::Node.replaceChild> ($value, $cval);
2127     last R;
2128     }
2129     }
2130    
2131     $self-><M::Node.appendChild>
2132     ($self-><AG::Node.ownerDocument>
2133     -><M::Document.createElementNS>
2134     (<Q::pc:>, 'stringLiteral'))
2135     -><AS::Node.textContent> ($key);
2136     $self-><M::Node.appendChild> ($value);
2137     } # R
2138     }__;
2139    
2140     @ToStringMethod:
2141     @@Return:
2142     @@@Type: DOMString
2143     @@@enDesc:
2144     Perl code.
2145     @@@PerlDef:
2146     __DEEP{
2147     my %r = map {$_->stringify} @{$self-><AG::Node.childNodes>};
2148     ## Different values with same key are not preserved.
2149 wakaba 1.58 $r = '{' . join (",\n", map {$_ => $r{$_}}
2150 wakaba 1.41 sort {$a cmp $b} keys %r) . '}';
2151     }__;
2152     ##PCHashRefLiteral
2153    
2154     ResourceDef:
2155     @QName: unsignedLong
2156     @AliasFor: idl|unsignedLong||ManakaiDOM|all
2157     @For: ManakaiDOM|DOM
2158    
2159     IFClsETDef:
2160 wakaba 1.25 @IFQName: PerlTokens
2161 wakaba 1.35 @CQName: ManakaiPCTokens
2162     @ETQName: pc|tokens
2163 wakaba 1.12
2164 wakaba 1.25 @IFISA: PerlCode
2165 wakaba 1.35 @CISA: ManakaiPCCode
2166 wakaba 1.25
2167 wakaba 1.6 @enDesc:
2168 wakaba 1.36 Unparsed Perl inline code fragments.
2169 wakaba 1.6
2170     @ToStringMethod:
2171     @@Return:
2172 wakaba 1.43 @@@Type: DOMString
2173 wakaba 1.6 @@@PerlDef:
2174 wakaba 1.35 __DEEP{
2175     $r = $self-><AG::Node.textContent>;
2176     }__;
2177     ##PCTokens
2178 wakaba 1.6
2179 wakaba 1.35 IFClsETDef:
2180 wakaba 1.25 @IFQName: PerlAtom
2181 wakaba 1.35 @CQName: ManakaiPCAtom
2182     @ETQName: pc|atom
2183 wakaba 1.25
2184     @IFISA: PerlCode
2185 wakaba 1.35 @CISA: ManakaiPCTokens
2186 wakaba 1.25
2187 wakaba 1.6 @enDesc:
2188     Unparsed Perl atomic code fragments (such as numeric literal).
2189    
2190 wakaba 1.14 @NumValMethod:
2191     @@Return:
2192 wakaba 1.35 @@@Type: idl|unsignedLong||ManakaiDOM|all
2193 wakaba 1.14 @@@enDesc:
2194     Numeric value of the Perl code.
2195     @@@PerlDef:
2196 wakaba 1.35 __DEEP{
2197     $r = 0 + $self-><AG::Node.textContent>;
2198     }__;
2199 wakaba 1.9
2200 wakaba 1.6 @ToStringMethod:
2201     @@Return:
2202 wakaba 1.35 @@@Type: DOMString
2203 wakaba 1.6 @@@enDesc:
2204     Perl code.
2205     @@@PerlDef:
2206 wakaba 1.35 __DEEP{
2207     $r = $self-><AG::Node.textContent>;
2208     }__;
2209 wakaba 1.6 ##PerlAtom
2210    
2211 wakaba 1.35 IFClsETDef:
2212 wakaba 1.25 @IFQName: PerlVariable
2213 wakaba 1.35 @CQName: ManakaiPCVariable
2214     @ETQName: pc|variable
2215 wakaba 1.25
2216     @IFISA: PerlCode
2217 wakaba 1.35 @CISA: ManakaiPCCode
2218 wakaba 1.25
2219 wakaba 1.6 @enDesc:
2220     Unparsed Perl variable.
2221     \
2222     {NOTE:: Future version of the implementation may
2223     support to specify array index or hash key.
2224     \
2225 wakaba 1.36 }
2226 wakaba 1.6
2227 wakaba 1.35 @ATTR:
2228 wakaba 1.6 @@Name: variableType
2229 wakaba 1.35 @@ATTRQName: pc|variableType
2230 wakaba 1.6 @@enDesc:
2231     Perl variable type (<CODE::$>, <CODE::@>, <CODE::%>,
2232     <CODE::&> or empty string).
2233 wakaba 1.35 @@ReflectCDATA:
2234 wakaba 1.6 @@Get:
2235     @@Set:
2236    
2237 wakaba 1.35 @ATTR:
2238 wakaba 1.6 @@Name: packageName
2239 wakaba 1.35 @@ATTRQName: pc|packageName
2240 wakaba 1.6 @@enDesc:
2241     The name of the package to which this variable belongs.
2242 wakaba 1.35 @@ReflectCDATA:
2243 wakaba 1.6 @@Get:
2244     @@@nullCase:
2245     @@@@enDesc:
2246     This package belongs to the current package or
2247     does not belong to any package.
2248     @@Set:
2249     @@@nullCase:
2250     @@@@enDesc:
2251     This package belongs to the current package or
2252     does not belong to any package.
2253    
2254 wakaba 1.35 @ATTR:
2255 wakaba 1.36 @@Name: pcLocalName
2256 wakaba 1.35 @@ATTRQName: pc|localName
2257 wakaba 1.6 @@enDesc:
2258     The local variable name.
2259 wakaba 1.35 @@ReflectCDATA:
2260 wakaba 1.6 @@Get:
2261     @@Set:
2262    
2263 wakaba 1.35 @ATTR:
2264 wakaba 1.6 @@Name: variableScope
2265 wakaba 1.35 @@ATTRQName: pc|variableScope
2266 wakaba 1.6 @@enDesc:
2267     Scope modifier (<CODE::my> or <CODE::our> or <CODE::local>).
2268 wakaba 1.35 @@ReflectCDATA:
2269 wakaba 1.6 @@Get:
2270     @@@nullCase:
2271     @@@@enDesc:
2272     This variable does not have scope modifier.
2273     @@Set:
2274     @@@nullCase:
2275     @@@@enDesc:
2276     This variable does not have scope modifier.
2277    
2278     @ToStringMethod:
2279     @@Return:
2280 wakaba 1.35 @@@Type: DOMString
2281 wakaba 1.6 @@@enDesc:
2282     Perl code.
2283     @@@PerlDef:
2284 wakaba 1.35 __DEEP{
2285     my $t = $self-><AG::PerlVariable.variableScope>;
2286     $r .= $t . ' ' if length $t;
2287 wakaba 1.55 $r .= $t = $self-><AG::PerlVariable.variableType>;
2288 wakaba 1.35 my $v = $self-><AG::PerlVariable.packageName>;
2289     $r .= $v . '::' if length $v;
2290     $r .= $self-><AG::PerlVariable.pcLocalName>;
2291     $v = $self-><AG::PerlVariable.hashKey>;
2292     if ($t eq '$' and length $v) {
2293     $v =~ s/(['\\])/\\$1/g;
2294     $r .= q<{'> . $v . q<'}>;
2295     }
2296     }__;
2297 wakaba 1.6
2298 wakaba 1.35 @ATTR:
2299 wakaba 1.6 @@Name: hashKey
2300 wakaba 1.35 @@ATTRQName: pc|hashKey
2301 wakaba 1.6 @@enDesc:
2302     The key for hash.
2303     \
2304     {NOTE:: Using Perl code for key is not supported in the current
2305     version of the implementation.
2306     \
2307     }
2308 wakaba 1.35 @@ReflectCDATA:
2309 wakaba 1.6 @@Get:
2310     @@@nullCase:
2311     @@@@enDesc:
2312     This variable is not for hash value access.
2313     @@Set:
2314     @@@nullCase:
2315     @@@@enDesc:
2316     This variable is not for hash value access.
2317 wakaba 1.15 ##PerlVariable
2318 wakaba 1.6
2319 wakaba 1.25 IFClsDef:
2320     @IFQName: PerlCodeUnits
2321 wakaba 1.35 @CQName: ManakaiPCCodeUnits
2322 wakaba 1.25
2323 wakaba 1.35 @CISA: ManakaiPCCode
2324 wakaba 1.25
2325 wakaba 1.6 @enDesc:
2326     A base class implemented by both inline container and
2327     block-level container.
2328    
2329     @Attr:
2330     @@Name: length
2331     @@enDesc:
2332     The number of child code fragments.
2333 wakaba 1.35 @@Type: idl|unsignedLong||ManakaiDOM|all
2334 wakaba 1.6 @@Get:
2335     @@@PerlDef:
2336 wakaba 1.35 __DEEP{
2337     $r = @{$self-><AG::Node.childNodes>};
2338     }__;
2339 wakaba 1.6
2340     @Method:
2341     @@Name: appendStringLiteral
2342     @@enDesc:
2343     Appends a Perl string literal (<CODE::q>).
2344     @@Param:
2345     @@@Name: stringArg
2346 wakaba 1.35 @@@Type: DOMString
2347 wakaba 1.6 @@@enDesc:
2348     A string.
2349     @@Return:
2350 wakaba 1.35 @@@Type: PerlStringLiteral
2351 wakaba 1.6 @@@enDesc:
2352     The newly created Perl string literal object.
2353     @@@PerlDef:
2354 wakaba 1.35 __DEEP{
2355     $r = $self-><AG::Node.ownerDocument>-><M::Document.createElementNS>
2356     (<Q::pc:>, 'stringLiteral');
2357     $r-><AS::Node.textContent> ($stringArg);
2358     $self-><M::Node.appendChild> ($r);
2359     }__;
2360 wakaba 1.6
2361     @Method:
2362 wakaba 1.41 @@Name: appendNewPCLiteral
2363     @@enDesc:
2364     Creates a <IF::PCLiteral> object and appends it to the node.
2365     @@Param:
2366     @@@Name: value
2367     @@@Type: DISPerl|Any
2368     @@@enDesc: The value.
2369     @@Return:
2370     @@@Type: PerlCode
2371     @@@enDesc:
2372     The newly created object.
2373     @@@PerlDef:
2374     __DEEP{
2375     $r = $self-><AG::Node.ownerDocument>
2376     -><M::PCDocument.createPCLiteral> ($value);
2377     $self-><M::Node.appendChild> ($r);
2378     }__;
2379    
2380     @Method:
2381 wakaba 1.44 @@Name: appendNewPCNumberLiteral
2382     @@enDesc:
2383     Creates a <IF::PCNumberLiteral> object and appends it to the node.
2384     @@Param:
2385     @@@Name: value
2386     @@@Type: DISPerl|NumberValue
2387     @@@enDesc:
2388     The value.
2389     @@Return:
2390     @@@Type: PCNumberLiteral
2391     @@@enDesc:
2392     The newly created node.
2393     @@@PerlDef:
2394     __DEEP{
2395     $r = $self-><AG::Node.ownerDocument>
2396     -><M::PCDocument.createPCNumberLiteral> ($value);
2397     $self-><M::Node.appendChild> ($r);
2398     }__;
2399    
2400     @Method:
2401 wakaba 1.6 @@Name: appendAtom
2402     @@enDesc:
2403     Appends a Perl atomic code fragment.
2404     @@Param:
2405     @@@Name: codeArg
2406 wakaba 1.35 @@@Type: DOMString
2407 wakaba 1.6 @@@enDesc:
2408     An atom.
2409     @@Return:
2410 wakaba 1.35 @@@Type: PerlAtom
2411 wakaba 1.6 @@@enDesc:
2412     The newly created Perl code object.
2413     @@@PerlDef:
2414 wakaba 1.35 __DEEP{
2415     $r = $self-><AG::Node.ownerDocument>-><M::Document.createElementNS>
2416     (<Q::pc:>, 'atom');
2417     $r-><AS::Node.textContent> ($codeArg);
2418     $self-><M::Node.appendChild> ($r);
2419     }__;
2420 wakaba 1.6
2421     @Method:
2422     @@Name: appendBare
2423     @@enDesc:
2424     Appends a Perl bare code fragment.
2425     @@Param:
2426     @@@Name: codeArg
2427 wakaba 1.35 @@@Type: DOMString
2428 wakaba 1.6 @@@enDesc:
2429 wakaba 1.7 An bare code.
2430 wakaba 1.6 @@Return:
2431 wakaba 1.35 @@@Type: PerlBare
2432 wakaba 1.6 @@@enDesc:
2433     The newly created Perl code object.
2434     @@@PerlDef:
2435 wakaba 1.35 __DEEP{
2436     $r = $self-><AG::Node.ownerDocument>-><M::Document.createElementNS>
2437     (<Q::pc:>, 'tokens');
2438     $r-><AS::Node.textContent> ($codeArg);
2439     $self-><M::Node.appendChild> ($r);
2440     }__;
2441 wakaba 1.11
2442     @Method:
2443 wakaba 1.44 @@Name: appendNewPCVariable
2444     @@enDesc:
2445     Creates a variable object and appends it to the children list of
2446     the node.
2447     @@Param:
2448     @@@Name: variableTypeArg
2449     @@@Type: DOMString
2450     @@@enDesc:
2451     The variable type prefix such as <Perl::$>, if any, or an empty string.
2452     @@Param:
2453     @@@Name: packageNameArg
2454     @@@Type: DOMString
2455     @@@enDesc:
2456     The name of the package to which the variable belongs.
2457     @@@nullCase:
2458     @@@@enDesc:
2459     The variable does not belong to any package or belongs
2460     to the current package.
2461     @@Param:
2462     @@@Name: localNameArg
2463     @@@Type: DOMString
2464     @@@enDesc:
2465     The local part of the variable name.
2466     @@Return:
2467     @@@Type: PerlVariable
2468     @@@enDesc:
2469     The newly created variable object.
2470     @@@PerlDef:
2471     __DEEP{
2472     $r = $self-><AG::Node.ownerDocument>
2473     -><M::PCDocument.createPCVariable>
2474     ($variableTypeArg, $packageNameArg, $localNameArg);
2475     $self-><M::Node.appendChild> ($r);
2476     }__;
2477    
2478     @Method:
2479     @@Name: appendNewPCDereference
2480     @@enDesc:
2481     Creates a <IF::PCDereference> object and appends it to the child
2482     node list of the node.
2483     @@Param:
2484     @@@Name: variableTypeArg
2485     @@@Type: DOMString
2486     @@@enDesc:
2487     The type of the referenced value, such as <Perl::$>.
2488     @@Return:
2489     @@@Type: PCDereference
2490     @@@enDesc:
2491     The newly created element node.
2492     @@@PerlDef:
2493     __DEEP{
2494     $r = $self-><AG::Node.ownerDocument>
2495 wakaba 1.48 -><M::PCDocument.createPCDereference>
2496     ($variableTypeArg);
2497     $self-><M::Node.appendChild> ($r);
2498     }__;
2499    
2500     @Method:
2501     @@Name: appendNewPCReference
2502     @@enDesc:
2503     Creates a <IF::PCReference> object and appends it to the child
2504     node list of the node.
2505     @@Return:
2506     @@@Type: PCReference
2507     @@@enDesc:
2508     The newly created element node.
2509     @@@PerlDef:
2510     __DEEP{
2511     $r = $self-><AG::Node.ownerDocument>
2512     -><M::PCDocument.createPCReference>;
2513 wakaba 1.44 $self-><M::Node.appendChild> ($r);
2514     }__;
2515    
2516     @Method:
2517 wakaba 1.43 @@Name: appendNewPCExpression
2518     @@enDesc:
2519     Appends a newly created <IF::PCExpression> node.
2520     @@Param:
2521     @@@Name: operatorArg
2522     @@@Type: DOMString
2523     @@@enDesc:
2524     The operator of the expression.
2525     @@Return:
2526     @@@Type: PCExpression
2527     @@@enDesc:
2528     The newly created expression object.
2529     @@@PerlDef:
2530     __DEEP{
2531     $r = $self-><AG::Node.ownerDocument>
2532     -><M::PCDocument.createPCExpression> ($operatorArg);
2533     $self-><M::Node.appendChild> ($r);
2534     }__;
2535    
2536     @Method:
2537 wakaba 1.11 @@Name: appendNewAssignment
2538     @@enDesc:
2539     Appends a newly created <Class::ManakaiPerlAssign> object.
2540     @@Param:
2541     @@@Name: leftArg
2542 wakaba 1.35 @@@Type: PerlCode
2543 wakaba 1.11 @@@enDesc:
2544     A left hand side code fragment object.
2545     @@Param:
2546     @@@Name: rightArg
2547 wakaba 1.35 @@@Type: PerlCode
2548 wakaba 1.11 @@@enDesc:
2549     A right hand side code fragment object.
2550     @@Return:
2551 wakaba 1.36 @@@Type: PerlAssignment
2552 wakaba 1.61 @@@PerlDef:
2553 wakaba 1.35 __DEEP{
2554     $r = $self-><AG::Node.ownerDocument>-><M::Document.createElementNS>
2555     (<Q::pc:>, 'assignment');
2556     $r-><AS::PerlAssignment.leftCode> ($leftArg);
2557     $r-><AS::PerlAssignment.rightCode> ($rightArg);
2558     $self-><M::Node.appendChild> ($r);
2559     }__;
2560 wakaba 1.43
2561     @Method:
2562 wakaba 1.44 @@Name: appendNewPCApply
2563     @@enDesc:
2564     Creates a <IF::PCApply> object and appends it to the children list
2565     of the node.
2566     @@Return:
2567     @@@Type: PCApply
2568     @@@enDesc: The newly created node.
2569     @@@PerlDef:
2570     __DEEP{
2571     $r = $self-><AG::Node.ownerDocument>-><M::PCDocument.createPCApply>;
2572     $self-><M::Node.appendChild> ($r);
2573     }__;
2574    
2575     @Method:
2576 wakaba 1.43 @@Name: appendNewPCFunctionCall
2577     @@enDesc:
2578     Appends a newly created <IF::PCFunctionCall> node.
2579     @@Param:
2580     @@@Name: packageArg
2581     @@@Type: DOMString
2582     @@@enDesc:
2583     The package name of the function.
2584     @@@nullCase:
2585     @@@@enDesc: No package name.
2586     @@Param:
2587     @@@Name: localNameArg
2588     @@@Type: DOMString
2589     @@@enDesc:
2590     The local part of the function name.
2591     @@Return:
2592     @@@Type: PCFunctionCall
2593     @@@enDesc:
2594     The newly created functin call object.
2595     @@@PerlDef:
2596     __DEEP{
2597     $r = $self-><AG::Node.ownerDocument>
2598     -><M::PCDocument.createPCFunctionCall>
2599     ($packageArg, $localNameArg);
2600     $self-><M::Node.appendChild> ($r);
2601     }__;
2602     ##PCCodeUnits
2603 wakaba 1.6
2604 wakaba 1.35 IFClsETDef:
2605 wakaba 1.25 @IFQName: PerlStatement
2606 wakaba 1.35 @CQName: ManakaiPCStatement
2607     @ETQName: pc|statement
2608 wakaba 1.25
2609     @IFISA: PerlCode
2610     @IFISA: PerlCodeInlines
2611 wakaba 1.35 @CISA: ManakaiPCCodeInlines
2612 wakaba 1.25
2613 wakaba 1.8 @enDesc:
2614 wakaba 1.36 Perl statements.
2615 wakaba 1.8
2616     @ToStringMethod:
2617     @@Return:
2618 wakaba 1.35 @@@Type: DOMString
2619 wakaba 1.8 @@@enDesc:
2620     Perl code.
2621     @@@PerlDef:
2622     $r = $self->SUPER::stringify;
2623 wakaba 1.16 $r .= ";\n" if length $r;
2624 wakaba 1.8 ##PerlStatement
2625 wakaba 1.6
2626 wakaba 1.35 IFClsETDef:
2627 wakaba 1.25 @IFQName: PerlCodeInlines
2628 wakaba 1.35 @CQName: ManakaiPCCodeInlines
2629     @ETQName: pc|inlineContainer
2630 wakaba 1.25
2631 wakaba 1.35 @CISA: ManakaiPCCodeUnits
2632 wakaba 1.25
2633 wakaba 1.6 @enDesc:
2634 wakaba 1.41 Perl inline code block.
2635 wakaba 1.6
2636     @Method:
2637     @@Name: appendCode
2638     @@enDesc:
2639     Appends an unparsed Perl code fragment.
2640     @@Param:
2641     @@@Name: codeArg
2642 wakaba 1.35 @@@Type: DOMString
2643 wakaba 1.6 @@@enDesc:
2644     An unparsed Perl code fragment.
2645     @@Return:
2646 wakaba 1.25 @@@Type: PerlInlineUnparsedCode
2647 wakaba 1.6 @@@enDesc:
2648     The newly created Perl code object.
2649     @@@PerlDef:
2650 wakaba 1.35 __DEEP{
2651     $r = $self-><AG::Node.ownerDocument>-><M::Document.createElementNS>
2652     (<Q::pc:>, 'inlineUnparsed');
2653     $r-><AS::Node.textContent> ($codeArg);
2654     $self-><M::Node.appendChild> ($r);
2655     }__;
2656 wakaba 1.6
2657     @ToStringMethod:
2658     @@Return:
2659 wakaba 1.35 @@@Type: DOMString
2660 wakaba 1.6 @@@enDesc:
2661     Perl code.
2662     @@@PerlDef:
2663 wakaba 1.35 __DEEP{
2664     my @child = @{$self-><AG::Node.childNodes>};
2665     for my $child (@child) {
2666     if ($child-><AG::Node.namespaceURI> eq <Q::pc:> and
2667     $child-><AG::Node.localName> eq 'inlineContainer' and
2668     1 == @child) {
2669     $r .= '(' . $child->stringify . ')';
2670     } else {
2671     $r .= $child->stringify;
2672     }
2673     }
2674     }__;
2675     ##PCCodeInlines
2676 wakaba 1.6
2677 wakaba 1.35 IFClsETDef:
2678 wakaba 1.25 @IFQName: PerlBlock
2679 wakaba 1.44 @CQName: ManakaiPerlBlock
2680 wakaba 1.35 @ETQName: pc|block
2681 wakaba 1.25
2682     @IFISA: PerlCode
2683     @IFISA: PerlCodeStatements
2684 wakaba 1.35 @CISA: ManakaiPCCodeStatements
2685 wakaba 1.25
2686 wakaba 1.8 @enDesc:
2687 wakaba 1.36 Perl block-level code block.
2688 wakaba 1.8
2689     @ToStringMethod:
2690     @@Return:
2691 wakaba 1.35 @@@Type: DOMString
2692 wakaba 1.8 @@@enDesc:
2693     Perl code.
2694     @@@PerlDef:
2695 wakaba 1.43 __DEEP{
2696 wakaba 1.35 my @child = @{$self-><AG::Node.childNodes>};
2697 wakaba 1.43 my $label = $self-><AG::PerlCodeStatements.label>;
2698     if (not $label and @child == 1 and
2699 wakaba 1.35 $child[0]-><AG::Node.localName> eq 'block') {
2700 wakaba 1.39 $r = "\x0A" . $child[0]->stringify . "\x0A";
2701 wakaba 1.43 } elsif (not $label and @child == 1 and
2702 wakaba 1.35 $child[0]-><AG::Node.localName> eq 'unparsed' and
2703     $child[0]-><AG::Node.textContent> =~ /^\s*$/) {
2704     #
2705     } else {
2706 wakaba 1.39 $r = "\x0A";
2707 wakaba 1.35 for my $child (@child) {
2708     if ($child-><AG::Node.localName> eq 'inlineContainer' and
2709     1 == @child) {
2710     $r .= '(' . $child->stringify . ')';
2711     } else {
2712     $r .= $child->stringify;
2713     }
2714     }
2715 wakaba 1.39 $r .= "\x0A";
2716 wakaba 1.35
2717 wakaba 1.59 $r = "\n{\n$r\n;}\n" if 2 < length $r;
2718 wakaba 1.43
2719     $r = "\n" . $label . ':' . $r if $label;
2720     }
2721     }__;
2722 wakaba 1.44 ##PerlBlock
2723 wakaba 1.8
2724 wakaba 1.35 IFClsETDef:
2725 wakaba 1.25 @IFQName: PerlCodeBlocks
2726 wakaba 1.35 @CQName: ManakaiPCCodeBlocks
2727     @ETQName: pc|blockContainer
2728 wakaba 1.25
2729     @IFISA: PerlCodeStatements
2730 wakaba 1.35 @CISA: ManakaiPCCodeStatements
2731 wakaba 1.25
2732 wakaba 1.9 @enDesc:
2733     Perl block-level code container whose content may or may
2734     not semantically be self-contained.
2735    
2736     @ToStringMethod:
2737     @@Return:
2738 wakaba 1.35 @@@Type: DOMString
2739 wakaba 1.9 @@@enDesc:
2740     Perl code.
2741     @@@PerlDef:
2742 wakaba 1.35 my @child = @{$self-><AG::Node.childNodes>};
2743     if (@child == 1 and
2744     {
2745     block => true, blockContainer => true,
2746     }->{$child[0]-><AG::Node.localName>}) {
2747     $r = $child[0]->stringify;
2748     } else {
2749     for my $child (@child) {
2750     if ($child-><AG::Node.localName> eq 'inlineContainer' and
2751     1 == @child) {
2752     $r .= '(' . $child->stringify . ')';
2753     } else {
2754     $r .= $child->stringify;
2755     }
2756     }
2757     }
2758     ##PCCodeBlocks
2759    
2760     IFClsETDef:
2761 wakaba 1.44 @IFQName: PCDereference
2762     @CQName: ManakaiPCDereference
2763     @ETQName: pc|dereference
2764    
2765     @IFISA: PerlCode
2766     @IFISA: PerlCodeInlines
2767     @CISA: ManakaiPCCodeInlines
2768    
2769     @enDesc:
2770     A <IF::PCDereference> object represents a dereference.
2771    
2772     @ATTR:
2773     @@Name: variableType
2774     @@ATTRQName: pc|variableType
2775     @@enDesc:
2776     The type of the value, such as <Perl::$>.
2777     @@ReflectCDATA:
2778     @@Get:
2779     @@Set:
2780    
2781     @ToStringMethod:
2782     @@Return:
2783     @@@Type: DOMString
2784     @@@PerlDef:
2785     __DEEP{
2786     $r = $self-><AG::PCDereference.variableType> . '{';
2787     A: for my $child (@{$self-><AG::Node.childNodes>}) {
2788     next A unless $child-><AG::Node.nodeType> == <C::Node.ELEMENT_NODE>;
2789     $r .= $child;
2790     }
2791     $r .= '}';
2792     }__;
2793     ##PCDereference
2794    
2795     IFClsETDef:
2796 wakaba 1.48 @IFQName: PCReference
2797     @CQName: ManakaiPCReference
2798     @ETQName: pc|reference
2799    
2800     @IFISA: PerlCode
2801     @IFISA: PerlCodeInlines
2802     @CISA: ManakaiPCCodeInlines
2803    
2804     @enDesc:
2805     A <IF::PCReference> object represents a reference (<Perl::\>) operation.
2806    
2807     @ToStringMethod:
2808     @@Return:
2809     @@@Type: DOMString
2810     @@@PerlDef:
2811     __DEEP{
2812     $r = '\(undef)';
2813     no warnings 'uninitialized';
2814     A: for my $child (@{$self-><AG::Node.childNodes>}) {
2815     next A unless $child-><AG::Node.nodeType> ==
2816     <C::Node.ELEMENT_NODE>;
2817     $r = $child;
2818     unless ({
2819     <Q::pc:variable> => true,
2820     }->{$child-><AG::Node.namespaceURI>.
2821     $child-><AG::Node.localName>}) {
2822 wakaba 1.53 $r = '\('.$r.')';
2823 wakaba 1.48 }
2824     last A;
2825     }
2826     }__;
2827     ##PCReference
2828    
2829     IFClsETDef:
2830 wakaba 1.44 @IFQName: PCApply
2831     @CQName: ManakaiPCApply
2832     @ETQName: pc|apply
2833    
2834     @IFISA: PerlCode
2835     @IFISA: PerlCodeInlines
2836     @CISA: ManakaiPCCodeInlines
2837    
2838     @enDesc:
2839     A <IF::PCApply> object represents a function call.
2840    
2841     The first child element must be an expression results in a function name
2842     (such as bare function or operator name represented
2843     as a <IF::PCVariable> object or an <IF::PCExpression> with
2844     operator <Perl::-<gt>> whose last operand is a method name.
2845    
2846     The second child element, if any, is an expression intended to be
2847     an argument for the function. It is possible to specify more than
2848     one arguments by <IF::PCExpression> with operator <Perl::,>.
2849    
2850     The third child element, if any, is an expression that is put
2851     into the indirect object slot.
2852    
2853     @Attr:
2854     @@Name: function
2855     @@enDesc:
2856     The function child element of the element.
2857     @@Type: PerlCode
2858     @@Get:
2859     @@@nullCase:
2860     @@@@enDesc: There is no child element.
2861     @@@PerlDef:
2862     __DEEP{
2863     A: for my $child (@{$self-><AG::Node.childNodes>}) {
2864     next A unless $child-><AG::Node.nodeType> == <C::Node.ELEMENT_NODE>;
2865     $r = $child;
2866     last A;
2867     }
2868     }__;
2869    
2870     @Attr:
2871     @@Name: argument
2872     @@enDesc:
2873     The argument child element of the element.
2874     @@Type: PerlCode
2875     @@Get:
2876     @@@nullCase:
2877     @@@@enDesc: There is no argument element.
2878     @@@PerlDef:
2879     __DEEP{
2880     my $x;
2881     A: for my $child (@{$self-><AG::Node.childNodes>}) {
2882     next A unless $child-><AG::Node.nodeType> == <C::Node.ELEMENT_NODE>;
2883     if ($x) {
2884     $r = $child;
2885     last A;
2886     } else {
2887     $x = true;
2888     }
2889     }
2890     }__;
2891    
2892     @Attr:
2893     @@Name: indirect
2894     @@enDesc:
2895     The indirect object slot child element of the element.
2896     @@Type: PerlCode
2897     @@Get:
2898     @@@nullCase:
2899     @@@@enDesc: There is no indirect object element.
2900     @@@PerlDef:
2901     __DEEP{
2902     my $x = 0;
2903     A: for my $child (@{$self-><AG::Node.childNodes>}) {
2904     next A unless $child-><AG::Node.nodeType> == <C::Node.ELEMENT_NODE>;
2905     if ($x++ == 2) {
2906     $r = $child;
2907     last A;
2908     }
2909     }
2910     }__;
2911    
2912    
2913     @ToStringMethod:
2914     @@Return:
2915     @@@Type: DOMString
2916     @@@PerlDef:
2917     __DEEP{
2918     my $f;
2919     my $arg;
2920     my $obj;
2921     no warnings 'uninitialized';
2922     A: for my $child (@{$self-><AG::Node.childNodes>}) {
2923     next A unless $child-><AG::Node.nodeType> == <C::Node.ELEMENT_NODE>;
2924     if (not defined $f) {
2925     $f = ''.$child;
2926     } elsif (not defined $arg) {
2927     $arg = ''.$child;
2928     } else {
2929     $obj = ''.$child;
2930     last A;
2931     }
2932     }
2933    
2934     $r = $f;
2935     $r .= ' ' . $obj if defined $obj;
2936    
2937     if ({
2938     'die' => true,
2939     'last' => true,
2940     'next' => true,
2941     'redo' => true,
2942     'return' => true,
2943     'warn' => true,
2944     }->{$r}) {
2945     $r .= ' ' . $arg;
2946     } else {
2947     $r .= ' (' . $arg . ')';
2948     }
2949     }__;
2950     ##PCApply
2951    
2952     IFClsETDef:
2953 wakaba 1.43 @IFQName: PCExpression
2954     @CQName: ManakaiPCExpression
2955     @ETQName: pc|expression
2956    
2957     @IFISA: PerlCode
2958     @IFISA: PerlCodeInlines
2959     @CISA: ManakaiPCCodeInlines
2960    
2961     @enDesc:
2962     A <IF::PCExpression> object represents a sequence of one or more
2963     expression fragments (operands) separated by the same operator.
2964    
2965     @ATTR:
2966     @@Name: operator
2967     @@ATTRQName: pc|operator
2968     @@enDesc:
2969     The operator.
2970     @@ReflectCDATA:
2971     @@Get:
2972     @@Set:
2973    
2974     @Attr:
2975     @@Name: operandNumber
2976     @@enDesc:
2977     The number of operands.
2978     @@Type: idl|unsignedLong||ManakaiDOM|all
2979     @@Get:
2980     @@@PerlDef:
2981     __DEEP{
2982     $r = @{$self-><AG::Node.childNodes>};
2983     }__;
2984    
2985     @ToStringMethod:
2986     @@Return:
2987     @@@Type: DOMString
2988     @@@PerlDef:
2989     __DEEP{
2990     my @r;
2991     no warnings 'uninitialized';
2992     A: for my $child (@{$self-><AG::Node.childNodes>}) {
2993     next A unless $child-><AG::Node.nodeType> == <C::Node.ELEMENT_NODE>;
2994 wakaba 1.44 my $xuri = $child-><AG::Node.namespaceURI>
2995     . $child-><AG::Node.localName>;
2996     push @r, [$child.'', $child, $xuri];
2997 wakaba 1.43 }
2998     if (@r > 1) {
2999     my $op = $self-><AG::PCExpression.operator>;
3000     for (@r) {
3001 wakaba 1.44 if ($_->[2] ne <Q::pc:expression> and not {
3002 wakaba 1.45 <Q::pc:apply> => true,
3003 wakaba 1.44 <Q::pc:arrayRefLiteral> => true,
3004     <Q::pc:atom> => true,
3005     <Q::pc:dereference> => true,
3006     <Q::pc:hashRefLiteral> => true,
3007     <Q::pc:numberLiteral> => true,
3008     <Q::pc:stringLiteral> => true,
3009     <Q::pc:tokens> => true,
3010     <Q::pc:variable> => true,
3011     }->{$_->[2]}) {
3012     $_ = '(' . $_->[0] . ')';
3013     } elsif ($_->[2] eq <Q::pc:expression> and
3014     (not {
3015 wakaba 1.46 '**' => {'->' => true},
3016     '=~' => {'->' => true},
3017     '!~' => {'->' => true},
3018     '*' => {'->' => true, '*' => true},
3019     '/' => {'->' => true},
3020     '%' => {'->' => true},
3021     'x' => {'->' => true},
3022     '+' => {'->' => true, '*' => true, '+' => true, '-' => true},
3023     '-' => {'->' => true, '*' => true},
3024     '.' => {'->' => true},
3025     '<' => {'->' => true},
3026     '>' => {'->' => true},
3027     '<=' => {'->' => true},
3028     '>=' => {'->' => true},
3029     'lt' => {'->' => true},
3030     'gt' => {'->' => true},
3031     'le' => {'->' => true},
3032     'gr' => {'->' => true},
3033     '==' => {'->' => true},
3034     '!=' => {'->' => true},
3035     '<=>' => {'->' => true},
3036     'eq' => {'->' => true},
3037     'ne' => {'->' => true},
3038     'cmp' => {'->' => true},
3039     '&&' => {'->' => true, '&&' => true},
3040     '||' => {'->' => true, '||' => true},
3041     '..' => {'->' => true},
3042     '=' => {'->' => true},
3043     ',' => {'->' => true, ',' => true, '=>' => true},
3044     '=>' => {'->' => true, ',' => true, '=>' => true},
3045     'and' => {'->' => true, 'and' => true},
3046     'or' => {'->' => true, 'or' => true},
3047 wakaba 1.43 }->{$op}->{$_->[1]-><AG::PCExpression.operator>}) and
3048     $_->[1]-><AG::PCExpression.operandNumber> > 1) {
3049     $_ = '(' . $_->[0] . ')';
3050     } else {
3051     $_ = $_->[0];
3052     }
3053     }
3054 wakaba 1.44 $op = ' '.$op unless {
3055     ',' => true,
3056     '->' => true,
3057 wakaba 1.46 '..' => true,
3058     '...' => true,
3059 wakaba 1.44 }->{$op};
3060     $op = $op.' ' unless {
3061     '->' => true,
3062 wakaba 1.46 '..' => true,
3063     '...' => true,
3064 wakaba 1.44 }->{$op};
3065     $r = join $op, @r;
3066 wakaba 1.43 } elsif (@r) {
3067     $r = $r[0]->[0];
3068 wakaba 1.48 } elsif ($self-><AG::PCExpression.operator> eq ',') {
3069     $r = '()';
3070 wakaba 1.43 } else {
3071     $r = 'undef';
3072     }
3073     }__;
3074     ##PCExpression
3075    
3076     IFClsETDef:
3077 wakaba 1.25 @IFQName: PerlAssignment
3078 wakaba 1.35 @CQName: ManakaiPCAssignment
3079     @ETQName: pc|assignment
3080 wakaba 1.25
3081     @IFISA: PerlCode
3082 wakaba 1.35 @CISA: ManakaiPCCode
3083 wakaba 1.25
3084 wakaba 1.11 @enDesc:
3085 wakaba 1.36 Perl variable assignment.
3086 wakaba 1.11
3087     @ToStringMethod:
3088     @@Return:
3089 wakaba 1.35 @@@Type: DOMString
3090 wakaba 1.11 @@@enDesc:
3091     Perl code.
3092     @@@PerlDef:
3093 wakaba 1.35 __DEEP{
3094     $r = $self-><AG::PerlAssignment.leftCode>->stringify
3095     . ' = '
3096     . $self-><AG::PerlAssignment.rightCode>->stringify;
3097     }__;
3098    
3099     @Attr:
3100     @@Name: leftCode
3101     @@enDesc:
3102     Left-hand expression.
3103     @@Type: PerlCodeInlines
3104     @@Get:
3105     @@@nullCase:
3106     @@@@enDesc: Left-hand code not yet specified.
3107     @@@PerlDef:
3108     __DEEP{
3109     F: for my $child (@{$self-><AG::Node.childNodes>}) {
3110     if ($child-><AG::Node.namespaceURI> eq <Q::pc:> and
3111     $child-><AG::Node.localName> eq 'left') {
3112     $r = $child-><AG::Node.lastChild>;
3113     last F;
3114     }
3115     }
3116     }__;
3117     @@Set:
3118     @@@PerlDef:
3119     __DEEP{
3120     F: {
3121     for my $child (@{$self-><AG::Node.childNodes>}) {
3122     if ($child-><AG::Node.namespaceURI> eq <Q::pc:> and
3123     $child-><AG::Node.localName> eq 'left') {
3124     $child-><AS::Node.textContent> ('');
3125     $child-><M::Node.appendChild> ($given);
3126     last F;
3127     }
3128     }
3129     my $node = $self-><AG::Node.ownerDocument>
3130     -><M::Document.createElementNS>
3131     (<Q::pc:>, 'left');
3132     $node-><M::Node.appendChild> ($given);
3133     $self-><M::Node.appendChild> ($node);
3134     }
3135     }__;
3136    
3137     @Attr:
3138     @@Name: rightCode
3139     @@enDesc:
3140     Right-hand expression.
3141     @@Type: PerlCodeInlines
3142     @@Get:
3143     @@@nullCase:
3144     @@@@enDesc: Right-hand code not yet specified.
3145     @@@PerlDef:
3146     __DEEP{
3147     F: for my $child (@{$self-><AG::Node.childNodes>}) {
3148     if ($child-><AG::Node.namespaceURI> eq <Q::pc:> and
3149     $child-><AG::Node.localName> eq 'right') {
3150     $r = $child-><AG::Node.lastChild>;
3151     last F;
3152     }
3153     }
3154     }__;
3155     @@Set:
3156     @@@PerlDef:
3157     __DEEP{
3158     F: {
3159     for my $child (@{$self-><AG::Node.childNodes>}) {
3160     if ($child-><AG::Node.namespaceURI> eq <Q::pc:> and
3161     $child-><AG::Node.localName> eq 'right') {
3162     $child-><AS::Node.textContent> ('');
3163     $child-><M::Node.appendChild> ($given);
3164     last F;
3165     }
3166     }
3167     my $node = $self-><AG::Node.ownerDocument>
3168     -><M::Document.createElementNS>
3169     (<Q::pc:>, 'right');
3170     $node-><M::Node.appendChild> ($given);
3171     $self-><M::Node.appendChild> ($node);
3172     }
3173     }__;
3174 wakaba 1.11 ##PerlAssignment
3175    
3176 wakaba 1.35 IFClsETDef:
3177 wakaba 1.44 @IFQName: PCCondition
3178     @CQName: ManakaiPCCondition
3179     @ETQName: pc2|condition
3180    
3181     @IFISA: PerlCode
3182     @IFISA: PerlCodeInlines
3183     @CISA: ManakaiPCCodeInlines
3184    
3185     @enDesc:
3186     A <IF::PCCondition> object represents a condition expression
3187     part of an <Perl::if> or <Perl::while> statement.
3188    
3189     @ToStringMethod:
3190     @@Return:
3191     @@@Type: DOMString
3192     @@@PerlDef:
3193     __DEEP{
3194     A: for my $child (@{$self-><AG::Node.childNodes>}) {
3195     next A unless $child-><AG::Node.nodeType> == <C::Node.ELEMENT_NODE>;
3196     $r .= $child;
3197     }
3198     }__;
3199     ##PCCondition
3200    
3201     IFClsETDef:
3202     @IFQName: PCBlock
3203     @CQName: ManakaiPCBlock
3204     @ETQName: pc2|block
3205    
3206     @IFISA: PerlCode
3207     @IFISA: PerlCodeStatements
3208     @CISA: ManakaiPCCodeStatements
3209    
3210     @enDesc:
3211     A <Q::PCBlock> object represents a Perl code block, i.e.
3212     a set of statements enclosed by <CHAR::{> and <CHAR::}> pair.
3213    
3214     @ToStringMethod:
3215     @@Return:
3216     @@@Type: DOMString
3217     @@@PerlDef:
3218     __DEEP{
3219     my @child = @{$self-><AG::Node.childNodes>};
3220     my $label = $self-><AG::PerlCodeStatements.label>;
3221    
3222     $r = "\x0A";
3223     for my $child (@child) {
3224     if ($child-><AG::Node.localName> eq 'inlineContainer' and
3225     1 == @child) {
3226     $r .= '(' . $child->stringify . ')';
3227     } else {
3228     $r .= $child->stringify;
3229     }
3230     }
3231     $r .= "\x0A";
3232     $r .= ';' unless @child;
3233    
3234 wakaba 1.59 $r = "\n{\n$r\n}\n";
3235 wakaba 1.44
3236     $r = "\n" . $label . ':' . $r . '# ' . $label . "\n"
3237     if length $label;
3238    
3239     }__;
3240     ##PCBlock
3241    
3242     IFClsETDef:
3243 wakaba 1.45 @IFQName: PCWhile
3244     @CQName: ManakaiPCWhile
3245     @ETQName: pc|while
3246    
3247     @IFISA: PerlCode
3248     @CISA: ManakaiPCCode
3249    
3250     @enDesc:
3251     A <IF::PCWhile> object represents a <Perl::while> statement.
3252     It can contain two child elements: <Q::pc2|condition> and <Q::pc2|block>,
3253     each represents the condition expression and the block of the <Perl::while>
3254     statement.
3255    
3256     @ATTR:
3257     @@Name: label
3258     @@ATTRQName: pc|label
3259     @@enDesc:
3260     Label for this block.
3261     @@ReflectCDATA:
3262     @@Get:
3263     @@@nullCase:
3264     @@@@enDesc:
3265     No label.
3266     @@Set:
3267     @@@nullCase:
3268     @@@@enDesc:
3269     No label.
3270    
3271     @Attr:
3272     @@Name: condition
3273     @@enDesc:
3274     The condition object.
3275     @@Type: PCCondition
3276     @@Get:
3277     @@@nullCase:
3278     @@@@enDesc:
3279     There is no condition element.
3280     @@@PerlDef:
3281     __CODE{getChildElementByType::
3282     $namespaceURI => {<Q::pc2:>},
3283     $localName => {'condition'},
3284     $parent => $self,
3285     $result => $r,
3286     }__;
3287    
3288     @Attr:
3289     @@Name: block
3290     @@enDesc:
3291     The code block that is executed while the <A::PCWhile.condition> met.
3292     @@Type: PCBlock
3293     @@Get:
3294     @@@nullCase:
3295     @@@@enDesc:
3296     There is no <Q::pc2:block> child element.
3297     @@@PerlDef:
3298     __CODE{getChildElementByType::
3299     $namespaceURI => {<Q::pc2:>},
3300     $localName => {'block'},
3301     $parent => $self,
3302     $result => $r,
3303     }__;
3304    
3305     @ToStringMethod:
3306     @@Return:
3307     @@@Type: DOMString
3308     @@@PerlDef:
3309     __DEEP{
3310     $r = 'while (';
3311     my $cond = $self-><AG::PCWhile.condition>;
3312     if ($cond) {
3313     $r .= $cond->stringify;
3314     } else {
3315     $r .= '0';
3316     }
3317     $r .= ') ';
3318     my $block = $self-><AG::PCWhile.block>;
3319     if ($block) {
3320     $r .= $block->stringify;
3321     } else {
3322     $r .= "{ }\n";
3323     }
3324    
3325     my $label = $self-><AG::PCWhile.label>;
3326     $r = "\n" . $label . ': ' . $r . ' # ' . $label . "\n"
3327     if length $label;
3328     }__;
3329     ##PCWhile
3330    
3331     IFClsETDef:
3332 wakaba 1.43 @IFQName: PCChoose
3333     @CQName: ManakaiPCChoose
3334     @ETQName: pc|choose
3335    
3336     @IFISA: PerlCode
3337     @CISA: ManakaiPCCode
3338    
3339     @enDesc:
3340     A <IF::PCChoose> object, or a <Q::pc|choose> element, represents
3341     a set of <Perl::if>, <Perl::elsif>, and <Perl::else> statements.
3342    
3343     @Method:
3344     @@Name: getWhen
3345     @@enDesc:
3346     Returns a <IF::PCWhen> by its ordinal index.
3347     @@Param:
3348     @@@Name: index
3349     @@@Type: idl|unsignedLong||ManakaiDOM|all
3350     @@@enDesc:
3351     The ordinal index of the <Q::pc|when> element.
3352     @@Return:
3353     @@@Type: PCWhen
3354     @@@enDesc:
3355     The <P::index>th <Q::pc|when> object.
3356     @@@nullCase:
3357     @@@@enDesc:
3358     There is no <P::index>th element.
3359     @@@PerlDef:
3360     __DEEP{
3361     my $i = 0;
3362     no warnings 'uninitialized';
3363     A: for my $child (@{$self-><AG::Node.childNodes>}) {
3364     if ($child-><AG::Node.nodeType> == <C::Node.ELEMENT_NODE> and
3365     $child-><AG::Node.namespaceURI> eq <Q::pc:> and
3366     $child-><AG::Node.localName> eq 'when' and
3367     ++$i == $index) {
3368     $r = $child;
3369     last A;
3370     }
3371     }
3372     }__;
3373    
3374     @Method:
3375     @@Name: appendNewPCWhen
3376     @@enDesc:
3377     Appends a new <Q::pc|when> element.
3378     @@Return:
3379     @@@Type: PCWhen
3380     @@@enDesc:
3381     The newly created <Q::pc|when> element.
3382     @@@PerlDef:
3383     __DEEP{
3384     my $od = $self-><AG::Node.ownerDocument>;
3385     $r = $od-><M::Document.createElementNS> (<Q::pc:>, 'when');
3386     my $cond = $od-><M::Document.createElementNS>
3387 wakaba 1.44 (<Q::pc2:>, 'condition');
3388 wakaba 1.43 $r-><M::Node.appendChild> ($cond);
3389     my $block = $od-><M::Document.createElementNS>
3390 wakaba 1.44 (<Q::pc2:>, 'block');
3391 wakaba 1.43 $r-><M::Node.appendChild> ($block);
3392     $self-><M::Node.insertBefore> ($r, $self-><AG::PCChoose.otherwise>);
3393     }__;
3394    
3395     @Attr:
3396     @@Name: otherwise
3397     @@enDesc:
3398     Returns the <IF::PCOtherwise> by its ordinal index.
3399     @@Type: PCOtherwise
3400     @@Get:
3401     @@@enDesc:
3402     The <Q::pc|otherwise> object.
3403     @@@nullCase:
3404     @@@@enDesc:
3405     There is no <Q::pc|otherwise> element.
3406     @@@PerlDef:
3407     __CODE{getChildElementByType::
3408     $namespaceURI => {<Q::pc:>},
3409     $localName => {'otherwise'},
3410     $parent => $self,
3411     $result => $r,
3412     }__;
3413    
3414     @Method:
3415     @@Name: appendNewPCOtherwise
3416     @@enDesc:
3417     Appends a new <Q::pc|otherwise> element. If there is already the
3418     <Q::pc|otherwise> element, then no element is created and
3419     the element is returned.
3420     @@Return:
3421     @@@Type: PCOtherwise
3422     @@@enDesc:
3423     The <Q::pc|otherwise> element.
3424     @@@PerlDef:
3425     __DEEP{
3426     $r = $self-><AG::PCChoose.otherwise>;
3427     unless ($r) {
3428     my $od = $self-><AG::Node.ownerDocument>;
3429     $r = $od-><M::Document.createElementNS> (<Q::pc:>, 'otherwise');
3430     my $block = $od-><M::Document.createElementNS>
3431 wakaba 1.44 (<Q::pc2:>, 'block');
3432 wakaba 1.43 $r-><M::Node.appendChild> ($block);
3433     $self-><M::Node.appendChild> ($r);
3434     }
3435     }__;
3436    
3437     @ToStringMethod:
3438     @@Return:
3439     @@@Type: DOMString
3440     @@@PerlDef:
3441     __DEEP{
3442     S: for my $child (@{$self-><AG::Node.childNodes>}) {
3443     next S unless $child-><AG::Node.nodeType> == <C::Node.ELEMENT_NODE>;
3444     next S unless $child-><AG::Node.namespaceURI> eq <Q::pc:>;
3445     my $ln = $child-><AG::Node.localName>;
3446     if ($ln eq 'when') {
3447     $r .= 'els' if length $r;
3448     $r .= $child->stringify;
3449     } elsif ($ln eq 'otherwise') {
3450     $r .= $child->stringify;
3451     last S;
3452     }
3453     } # S
3454     }__;
3455     ##PCChoose
3456    
3457     IFClsETDef:
3458     @IFQName: PCWhen
3459     @CQName: ManakaiPCWhen
3460     @ETQName: pc|when
3461    
3462     @IFISA: PerlCode
3463     @CISA: ManakaiPCCode
3464    
3465     @enDesc:
3466     A <IF::PCWhen> object, or a <Q::pc|when> element, represents an
3467     <Perl::if> or <Perl::elsif> block.
3468    
3469     @Attr:
3470     @@Name: condition
3471     @@enDesc:
3472 wakaba 1.44 The condition object.
3473     @@Type: PCCondition
3474 wakaba 1.43 @@Get:
3475     @@@nullCase:
3476     @@@@enDesc:
3477 wakaba 1.44 There is no condition element.
3478 wakaba 1.43 @@@PerlDef:
3479     __CODE{getChildElementByType::
3480 wakaba 1.44 $namespaceURI => {<Q::pc2:>},
3481 wakaba 1.43 $localName => {'condition'},
3482     $parent => $self,
3483     $result => $r,
3484     }__;
3485    
3486     @Attr:
3487     @@Name: block
3488     @@enDesc:
3489     The code block that is executed when the <A::PCWhen.condition> met.
3490 wakaba 1.44 @@Type: PCBlock
3491 wakaba 1.43 @@Get:
3492     @@@nullCase:
3493     @@@@enDesc:
3494 wakaba 1.44 There is no <Q::pc2:block> child element.
3495 wakaba 1.43 @@@PerlDef:
3496     __CODE{getChildElementByType::
3497 wakaba 1.44 $namespaceURI => {<Q::pc2:>},
3498 wakaba 1.43 $localName => {'block'},
3499     $parent => $self,
3500     $result => $r,
3501     }__;
3502    
3503     @ToStringMethod:
3504     @@Return:
3505     @@@Type: DOMString
3506     @@@PerlDef:
3507     __DEEP{
3508     $r = 'if (';
3509     my $cond = $self-><AG::PCWhen.condition>;
3510     if ($cond) {
3511     $r .= $cond->stringify;
3512     } else {
3513     $r .= '0';
3514     }
3515     $r .= ') ';
3516     my $block = $self-><AG::PCWhen.block>;
3517     if ($block) {
3518     $r .= $block->stringify;
3519     } else {
3520     $r .= "{ }\n";
3521     }
3522     }__;
3523     ##PCWhen
3524    
3525     IFClsETDef:
3526     @IFQName: PCOtherwise
3527     @CQName: ManakaiPCOtherwise
3528     @ETQName: pc|otherwise
3529    
3530     @IFISA: PerlCode
3531     @CISA: ManakaiPCCode
3532    
3533     @enDesc:
3534     A <IF::PCOtherwise> object, or a <Q::pc|otherwise> element, represents an
3535     <Perl::else> clause.
3536    
3537     @Attr:
3538     @@Name: block
3539     @@enDesc:
3540     The code block that is executed.
3541 wakaba 1.44 @@Type: PCBlock
3542 wakaba 1.43 @@Get:
3543     @@@nullCase:
3544     @@@@enDesc:
3545 wakaba 1.44 There is no <Q::pc2:block> child element.
3546 wakaba 1.43 @@@PerlDef:
3547     __CODE{getChildElementByType::
3548 wakaba 1.44 $namespaceURI => {<Q::pc2:>},
3549 wakaba 1.43 $localName => {'block'},
3550     $parent => $self,
3551     $result => $r,
3552     }__;
3553    
3554     @ToStringMethod:
3555     @@Return:
3556     @@@Type: DOMString
3557     @@@PerlDef:
3558     __DEEP{
3559     my $block = $self-><AG::PCOtherwise.block>;
3560     if ($block) {
3561     $r = 'else ' . $block->stringify;
3562     }
3563     }__;
3564     ##PCOtherwise
3565    
3566     ResourceDef:
3567     @For: ManakaiDOM|ManakaiDOM
3568     @QName: getChildElementByType
3569     @rdf:type: DISPerl|BlockCode
3570     @enDesc:
3571     Returns the first element of a type.
3572     @PerlCDef:
3573     __DEEP{
3574     no warnings 'uninitialized';
3575     A: for my $__child (@{$parent-><AG::Node.childNodes>}) {
3576     if ($__child-><AG::Node.nodeType> == <C::Node.ELEMENT_NODE> and
3577     $__child-><AG::Node.namespaceURI> eq $namespaceURI and
3578     $__child-><AG::Node.localName> eq $localName) {
3579     $result = $__child;
3580     last A;
3581     }
3582     }
3583     }__;
3584    
3585     IFClsETDef:
3586 wakaba 1.26 @IFQName: PerlIf
3587 wakaba 1.35 @CQName: ManakaiPCIf
3588     @ETQName: pc|if
3589 wakaba 1.25
3590     @IFISA: PerlCode
3591 wakaba 1.35 @CISA: ManakaiPCCode
3592 wakaba 1.25
3593 wakaba 1.12 @enDesc:
3594     Perl variable assignment.
3595    
3596     @ToStringMethod:
3597     @@Return:
3598 wakaba 1.35 @@@Type: DOMString
3599 wakaba 1.12 @@@enDesc:
3600     Perl code.
3601     @@@PerlDef:
3602 wakaba 1.35 __DEEP{
3603     my $tcode = $self-><AG::PerlIf.trueCode>;
3604     my $fcode = $self-><AG::PerlIf.falseCode>;
3605     my $ccode = $self-><AG::PerlIf.condition>;
3606     if (defined $tcode) {
3607     if (defined $fcode) {
3608     $r = q<if (> . $ccode->stringify . q<) {> . $tcode->stringify .
3609     q<} else {> . $fcode->stringify . qq<}\n>;
3610     } else {
3611 wakaba 1.36 $r = q<if (> . $ccode->stringify . q<) {> . $tcode->stringify .
3612 wakaba 1.35 qq<}\n>;
3613     }
3614     } else {
3615     $r = q<unless (> . $ccode->stringify . q<) {> . $fcode->stringify .
3616     qq<}\n>;
3617     }
3618     }__;
3619    
3620     @Attr:
3621     @@Name: condition
3622     @@enDesc:
3623     Condition expression.
3624     @@Type: PerlCodeInlines
3625     @@Get:
3626     @@@nullCase:
3627     @@@@enDesc: Condition code not yet specified.
3628     @@@PerlDef:
3629     __DEEP{
3630     F: for my $child (@{$self-><AG::Node.childNodes>}) {
3631     if ($child-><AG::Node.namespaceURI> eq <Q::pc:> and
3632     $child-><AG::Node.localName> eq 'condition') {
3633     $r = $child-><AG::Node.lastChild>;
3634     last F;
3635     }
3636     }
3637     }__;
3638     @@Set:
3639     @@@PerlDef:
3640     __DEEP{
3641     F: {
3642     for my $child (@{$self-><AG::Node.childNodes>}) {
3643     if ($child-><AG::Node.namespaceURI> eq <Q::pc:> and
3644     $child-><AG::Node.localName> eq 'condition') {
3645     $child-><AS::Node.textContent> ('');
3646     $child-><M::Node.appendChild> ($given);
3647     last F;
3648     }
3649     }
3650     my $node = $self-><AG::Node.ownerDocument>
3651     -><M::Document.createElementNS>
3652     (<Q::pc:>, 'condition');
3653     $node-><M::Node.appendChild> ($given);
3654     $self-><M::Node.appendChild> ($node);
3655     }
3656     }__;
3657    
3658     @Attr:
3659     @@Name: trueCode
3660     @@enDesc:
3661     True-case code.
3662     @@Type: PerlCodeBlocks
3663     @@Get:
3664     @@@nullCase:
3665     @@@@enDesc: True-case code not yet specified.
3666     @@@PerlDef:
3667     __DEEP{
3668     F: for my $child (@{$self-><AG::Node.childNodes>}) {
3669     if ($child-><AG::Node.namespaceURI> eq <Q::pc:> and
3670     $child-><AG::Node.localName> eq 'tr'.'ue') {
3671     $r = $child-><AG::Node.lastChild>;
3672     last F;
3673     }
3674     }
3675     }__;
3676     @@Set:
3677     @@@PerlDef:
3678     __DEEP{
3679     F: {
3680     for my $child (@{$self-><AG::Node.childNodes>}) {
3681     if ($child-><AG::Node.namespaceURI> eq <Q::pc:> and
3682     $child-><AG::Node.localName> eq 'tr'.'ue') {
3683     $child-><AS::Node.textContent> ('');
3684     $child-><M::Node.appendChild> ($given);
3685     last F;
3686     }
3687     }
3688     my $node = $self-><AG::Node.ownerDocument>
3689     -><M::Document.createElementNS>
3690     (<Q::pc:>, 'tr'.'ue');
3691     $node-><M::Node.appendChild> ($given);
3692     $self-><M::Node.appendChild> ($node);
3693     }
3694     }__;
3695    
3696     @Attr:
3697     @@Name: falseCode
3698     @@enDesc:
3699     False-case code.
3700     @@Type: PerlCodeBlocks
3701     @@Get:
3702     @@@nullCase:
3703     @@@@enDesc: True-case code not yet specified.
3704     @@@PerlDef:
3705     __DEEP{
3706     F: for my $child (@{$self-><AG::Node.childNodes>}) {
3707     if ($child-><AG::Node.namespaceURI> eq <Q::pc:> and
3708     $child-><AG::Node.localName> eq 'fal'.'se') {
3709     $r = $child-><AG::Node.lastChild>;
3710     last F;
3711     }
3712     }
3713     }__;
3714     @@Set:
3715     @@@PerlDef:
3716     __DEEP{
3717     F: {
3718     for my $child (@{$self-><AG::Node.childNodes>}) {
3719     if ($child-><AG::Node.namespaceURI> eq <Q::pc:> and
3720     $child-><AG::Node.localName> eq 'fal'.'se') {
3721     $child-><AS::Node.textContent> ('');
3722     $child-><M::Node.appendChild> ($given);
3723     last F;
3724     }
3725     }
3726     my $node = $self-><AG::Node.ownerDocument>
3727     -><M::Document.createElementNS>
3728     (<Q::pc:>, 'fal'.'se');
3729     $node-><M::Node.appendChild> ($given);
3730     $self-><M::Node.appendChild> ($node);
3731     }
3732     }__;
3733 wakaba 1.12 ##PerlIf
3734    
3735 wakaba 1.43 IFClsETDef:
3736     @IFQName: PCFunctionCall
3737     @CQName: ManakaiPCFunctionCall
3738     @ETQName: pc|call
3739    
3740     @IFISA: PerlCode
3741     @IFISA: PerlCodeInlines
3742     @CISA: ManakaiPCCodeInlines
3743    
3744     @enDesc:
3745     A <IF::PCFunctionCall> object represents a function call or
3746     function-like statement such as <Perl::next>.
3747    
3748     @ATTR:
3749     @@Name: variableType
3750     @@ATTRQName: pc|variableType
3751     @@enDesc:
3752     The value of the attribute <kwd:MAY> be <Perl::&>,
3753     which introduces a subroutine name.
3754     @@ReflectCDATA:
3755     @@Get:
3756     @@Set:
3757    
3758     @ATTR:
3759     @@Name: packageName
3760     @@ATTRQName: pc|packageName
3761     @@enDesc:
3762     The name of the package to which the subroutine belongs.
3763     @@ReflectCDATA:
3764     @@Get:
3765     @@@nullCase:
3766     @@@@enDesc:
3767     The object belongs to the current package or
3768     does not belong to any package.
3769     @@Set:
3770     @@@nullCase:
3771     @@@@enDesc:
3772     The object belongs to the current package or
3773     does not belong to any package.
3774    
3775     @ATTR:
3776     @@Name: pcLocalName
3777     @@ATTRQName: pc|localName
3778     @@enDesc:
3779     The local part of the subroutine name.
3780     @@ReflectCDATA:
3781     @@Get:
3782     @@Set:
3783    
3784     @ToStringMethod:
3785     @@Return:
3786     @@@Type: DOMString
3787     @@@PerlDef:
3788     __DEEP{
3789     $r .= $self-><AG::PCFunctionCall.variableType>;
3790     my $v = $self-><AG::PCFunctionCall.packageName>;
3791     $r .= $v . '::' if length $v;
3792     $r .= $self-><AG::PCFunctionCall.pcLocalName>;
3793    
3794     my @arg;
3795     no warnings 'uninitialized';
3796     A: for my $child (@{$self-><AG::Node.childNodes>}) {
3797     next A unless $child-><AG::Node.nodeType> == <C::Node.ELEMENT_NODE>;
3798     push @arg, ''.$child;
3799     }
3800     my $arg = join ', ', @arg;
3801     if ({
3802     'die' => true,
3803     'last' => true,
3804     'next' => true,
3805     'redo' => true,
3806 wakaba 1.44 'return' => true,
3807 wakaba 1.43 'warn' => true,
3808 wakaba 1.44 }->{$r}) {
3809 wakaba 1.43 $r .= ' ' . $arg;
3810     } else {
3811     $r .= ' (' . $arg . ')';
3812     }
3813     }__;
3814     ##PCFunctionCall
3815    
3816 wakaba 1.39 ## -- Configuration Parameters
3817    
3818     boolCParam:
3819 wakaba 1.54 @QName: pc|preserve-line-break
3820     @nodeProp: plb
3821 wakaba 1.59 @c:targetType: tc|Document
3822 wakaba 1.54 @IsSupportRequired:1
3823     @TrueCase:
3824 wakaba 1.59 @@c:isSupported:1
3825 wakaba 1.54 @@enDesc:
3826     When stringifying a <IF::PerlStringLiteral>, if it contains
3827     <CODE::U+000A> and / or <CODE::U+000D> characters, then
3828     they are escaped (e.g. <Perl::\x0A>).
3829     @@TestC:
3830     @@@QName: cfg.preserve-line-break.true.test
3831     @@@PerlCDef:
3832     my $doc;
3833     __CODE{createPCDocumentForTest:: $doc => $doc}__;
3834    
3835     my $cfg = $doc-><AG::Document.domConfig>;
3836     $cfg-><M::CFG.setParameter> (<Q::pc|preserve-line-break> => true);
3837    
3838     $test->id ('crlf');
3839     my $sl = $doc-><M::PCDocument.createPCLiteral> ("ab\x0D\x0Acd");
3840     my $str = $sl->stringify;
3841     $test->assert_equals ($str, q<"ab\x0D\x0Acd">);
3842    
3843     $test->id ('lf');
3844     my $sl2 = $doc-><M::PCDocument.createPCLiteral> ("ab\x0Acd");
3845     my $str2 = $sl2->stringify;
3846     $test->assert_equals ($str2, q<"ab\x0Acd">);
3847     @FalseCase:
3848 wakaba 1.59 @@c:isSupported:1
3849 wakaba 1.54 @@IsSupportRequired:1
3850     @@IsDefault:1
3851     @@enDesc:
3852     Line break characters are stringified as is.
3853     @@TestC:
3854     @@@QName: cfg.preserve-line-break.false.test
3855     @@@PerlCDef:
3856     my $doc;
3857     __CODE{createPCDocumentForTest:: $doc => $doc}__;
3858    
3859     my $cfg = $doc-><AG::Document.domConfig>;
3860     $cfg-><M::CFG.setParameter> (<Q::pc|preserve-line-break> => false);
3861    
3862     $test->id ('crlf');
3863     my $sl = $doc-><M::PCDocument.createPCLiteral> ("ab\x0D\x0Acd");
3864     my $str = $sl->stringify;
3865     $test->assert_equals ($str, q<'ab>.qq<\x0D\x0A>.q<cd'>);
3866    
3867     $test->id ('lf');
3868     my $sl2 = $doc-><M::PCDocument.createPCLiteral> ("ab\x0Acd");
3869     my $str2 = $sl2->stringify;
3870     $test->assert_equals ($str2, q<'ab>.qq<\x0A>.q<cd'>);
3871     @TestC:
3872     @@QName: cfg.preserve-line-break.set.test
3873     @@PerlCDef:
3874     my $doc;
3875     __CODE{createPCDocumentForTest:: $doc => $doc}__;
3876    
3877     my $cfg = $doc-><AG::Document.domConfig>;
3878    
3879     $test->id ('default');
3880     $test->assert_false ($cfg-><M::CFG.getParameter>
3881     (<Q::pc|preserve-line-break>));
3882    
3883     $test->id ('set.f.to.t');
3884     $cfg-><M::CFG.setParameter> (<Q::pc|preserve-line-break> => true);
3885     $test->assert_true ($cfg-><M::CFG.getParameter>
3886     (<Q::pc|preserve-line-break>));
3887    
3888     $test->id ('set.t.to.f');
3889     $cfg-><M::CFG.setParameter> (<Q::pc|preserve-line-break> => false);
3890     $test->assert_false ($cfg-><M::CFG.getParameter>
3891     (<Q::pc|preserve-line-break>));
3892    
3893     $cfg-><M::CFG.setParameter> (<Q::pc|preserve-line-break> => true);
3894    
3895     $test->id ('reset');
3896     $cfg-><M::CFG.setParameter> (<Q::pc|preserve-line-break> => null);
3897     $test->assert_false ($cfg-><M::CFG.getParameter>
3898     (<Q::pc|preserve-line-break>));
3899    
3900     ResourceDef:
3901     @QName: CFG
3902 wakaba 1.59 @AliasFor: c|DOMConfiguration
3903 wakaba 1.54 @For: ManakaiDOM|DOM3
3904 wakaba 1.39
3905     CParam:
3906     @QName: pc|split-resolver
3907     @nodeProp: pcsres
3908     @IsSupportRequired:1
3909 wakaba 1.59 @c:targetType: tc|Document
3910 wakaba 1.39 @Type: DISPerl|CODE||ManakaiDOM|all
3911     @enDesc:
3912     Splits module file. The parameter value <kwd:MUST> be
3913     a Perl code reference. The serializer would invoke
3914     the code with arguments: a reserved parameter, a <IF::PerlFile>
3915     whose serialization is being split, and a string
3916     that identifies the split part. The code is expected
3917     to return a <IF::DOMLS:LSOutput> object to which the module part
3918     is written. Note that splitting serialized module file
3919     does not affect to the <IF::PerlFile> tree.
3920     @nullCase:
3921     @@enDesc:
3922     Does not split module file.
3923    
3924     ElementTypeBinding:
3925     @Name: nodeProp
3926     @ElementType:
3927 wakaba 1.59 tc:nodeStemKey
3928 wakaba 1.39 @ShadowContent:
3929     @@For: =ManakaiDOM|all
3930    
3931     ElementTypeBinding:
3932     @Name: CParam
3933     @ElementType:
3934     dis:ResourceDef
3935     @ShadowContent:
3936     @@rdf:type:
3937 wakaba 1.59 @@@@: c|DOMConfigurationParameter
3938 wakaba 1.39 @@@For: ManakaiDOM|DOM
3939     @@rdf:type:
3940     @@@@: DISCore|Property
3941     @@@For: =ManakaiDOM|all
3942     @@For: ManakaiDOM|DOM3
3943     @@For: =ManakaiDOM|all
3944    
3945     ElementTypeBinding:
3946     @Name: boolCParam
3947     @ElementType:
3948     dis:ResourceDef
3949     @ShadowContent:
3950     @@rdf:type:
3951 wakaba 1.59 @@@@: c|DOMConfigurationParameter
3952 wakaba 1.39 @@@For: ManakaiDOM|DOM
3953     @@rdf:type:
3954     @@@@: DISCore|Property
3955     @@@For: =ManakaiDOM|all
3956     @@For: ManakaiDOM|DOM3
3957     @@For: =ManakaiDOM|all
3958     @@Type: idl|boolean||ManakaiDOM|all
3959    
3960 wakaba 1.41 ## -- PCDocument
3961    
3962     IFClsDef:
3963     @IFQName: PCDocument
3964     @CQName: ManakaiPCDocument
3965    
3966     @IFISA: Document
3967 wakaba 1.60 @CISA: td|ManakaiDOMDocument
3968 wakaba 1.41
3969     @enDesc:
3970     A <IF::PCDocument> is a <IF::Document> that represents a Perl code.
3971    
3972     @s:rootElementType: pc|file
3973    
3974 wakaba 1.59 @Test:
3975     @@QName: DOMImplementation.createDocument.PCDocument.test
3976     @@PerlDef:
3977     my $impl;
3978     __CODE{tc|createImplForTest:: $impl => $impl}__;
3979    
3980     my $doc = $impl-><M::DOMImpl.createDocument> (<Q::pc:>, 'pc:file');
3981    
3982     $test->id ('Document');
3983     $test->assert_isa ($doc, <IFName::Document>);
3984    
3985     $test->id ('PCDocument');
3986     $test->assert_isa ($doc, <IFName::PCDocument>);
3987    
3988     my $de = $doc-><AG::Document.documentElement>;
3989    
3990     $test->id ('documentElement.Element');
3991     $test->assert_isa ($de, <IFName::Element>);
3992    
3993     $test->id ('documentElement.PerlFile');
3994     $test->assert_isa ($de, <IFName::PerlFile>);
3995    
3996 wakaba 1.41 @Method:
3997     @@Name: createPCLiteral
3998     @@enDesc:
3999     Creates a literal object.
4000 wakaba 1.47
4001     {NOTE:: If a member of <P::value> is a <IF::PerlCode> object,
4002 wakaba 1.62 then it is appended to the tree as is.
4003 wakaba 1.47 }
4004 wakaba 1.41 @@Param:
4005     @@@Name: value
4006 wakaba 1.58 @@@Type: DISPerl|Any||ManakaiDOM|all
4007 wakaba 1.41 @@@enDesc:
4008     The value.
4009     @@@InCase:
4010 wakaba 1.58 @@@@Type: DISPerl|String||ManakaiDOM|all
4011 wakaba 1.41 @@@@enDesc:
4012     A <IF::PerlStringLiteral> whose value is <P::value> is created.
4013     @@@InCase:
4014 wakaba 1.58 @@@@Type: DISPerl|ARRAY||ManakaiDOM|all
4015 wakaba 1.41 @@@@enDesc:
4016     A <IF::PCArrayRefLiteral> is created. If <P::value>
4017     has items, then objects are recursively created.
4018     @@@InCase:
4019 wakaba 1.58 @@@@Type: DISPerl|HASH||ManakaiDOM|all
4020 wakaba 1.41 @@@@enDesc:
4021     A <IF::PCHashRefLiteral> is created. If <P::value>
4022     has key-value pairs, then objects are recursively created.
4023     @@Return:
4024     @@@Type: PerlCode
4025     @@@enDesc: The newly created value object.
4026     @@@PerlDef:
4027     __DEEP{
4028     if (ref $value eq 'HASH' or ref $value eq 'ARRAY') {
4029     $r = $self-><M::Document.createElementNS>
4030     (<Q::pc:>, ref $value eq 'HASH' ? 'hashRefLiteral'
4031     : 'arrayRefLiteral');
4032     for my $v (ref $value eq 'HASH' ? %$value : @$value) {
4033 wakaba 1.62 unless (UNIVERSAL::isa ($v, <IFName::PerlCode>)) {
4034 wakaba 1.63 $v = $self-><M::PCDocument.createPCLiteral> ($v);
4035 wakaba 1.41 }
4036 wakaba 1.64 $r-><M::Node.appendChild> ($v);
4037 wakaba 1.41 }
4038 wakaba 1.51 } elsif (defined $value) {
4039 wakaba 1.41 $r = $self-><M::Document.createElementNS>
4040     (<Q::pc:>, 'stringLiteral');
4041     $r-><AS::Node.textContent> ($value);
4042 wakaba 1.51 } else {
4043     $r = $self-><M::Document.createElementNS>
4044     (<Q::pc:>, 'atom');
4045     $r-><AS::Node.textContent> ('undef');
4046 wakaba 1.41 }
4047 wakaba 1.43 }__;
4048 wakaba 1.51 @@Test:
4049     @@@QName: PCDocument.createPCLiteral.undef.test
4050     @@@PerlDef:
4051     my $doc;
4052     __CODE{createPCDocumentForTest:: $doc => $doc}__;
4053    
4054     $test->id ('undef.element');
4055     my $e1 = $doc-><M::PCDocument.createPCLiteral> (null);
4056     $test->assert_isa ($e1, <IFName::PerlAtom>);
4057     $test->assert_equals ($e1-><AG::Node.textContent>, 'undef');
4058    
4059     $test->id ('string.empty.element');
4060     my $e2 = $doc-><M::PCDocument.createPCLiteral> ('');
4061     $test->assert_isa ($e2, <IFName::PerlStringLiteral>);
4062     $test->assert_equals ($e2-><AG::Node.textContent>, '');
4063    
4064     $test->id ('string.zero.element');
4065     my $e3 = $doc-><M::PCDocument.createPCLiteral> ('0');
4066     $test->assert_isa ($e3, <IFName::PerlStringLiteral>);
4067     $test->assert_equals ($e3-><AG::Node.textContent>, '0');
4068 wakaba 1.43
4069     @Method:
4070 wakaba 1.44 @@Name: createPCNumberLiteral
4071     @@enDesc:
4072     Creates a number literal object.
4073     @@Param:
4074     @@@Name: value
4075     @@@Type: DISPerl|NumberValue
4076     @@@enDesc:
4077     The value.
4078     @@Return:
4079     @@@Type: PCNumberValue
4080     @@@enDesc: The newly created value object.
4081     @@@PerlDef:
4082     __DEEP{
4083     $r = $self-><M::Document.createElementNS>
4084     (<Q::pc:>, 'numberLiteral');
4085     $r-><AS::Node.textContent> ($value);
4086     }__;
4087    
4088     @Method:
4089     @@Name: createPCVariable
4090     @@enDesc:
4091     Creates a new <IF::PerlVariable> object.
4092     @@Param:
4093     @@@Name: variableType
4094     @@@Type: DOMString
4095     @@@enDesc:
4096     Variable prefix.
4097     @@@nullCase:
4098     @@@@enDesc:
4099     If the <P::packageName> is <DOM::null>, then
4100     the <P::variableType> is detected by the prefix of
4101     <P::localName>. Otherwise, it is an unprefixed variable
4102     such as file handle.
4103     @@Param:
4104     @@@Name: packageName
4105     @@@Type: DOMString
4106     @@@enDesc:
4107     Package name.
4108     @@@nullCase:
4109     @@@@enDesc:
4110     The variable belongs to the current package or a
4111     lexical-scoped variable.
4112     @@Param:
4113     @@@Name: localName
4114     @@@Type: DOMString
4115     @@@enDesc:
4116     Variable name. If both <P::variableType> and <P::packageName>
4117     is <DOM::null>, the <P::localName> value may be prefixed
4118     by any possible <P::variableType> value.
4119     @@Return:
4120     @@@Type: PerlVariable
4121     @@@enDesc:
4122     Newly created Perl variable object.
4123     @@@PerlDef:
4124     __DEEP{
4125     $r = $self-><M::Document.createElementNS> (<Q::pc:>, 'variable');
4126     if (not $variableType and not $packageName and
4127     $localName =~ s/^(\\?[\$\@%&*])//) {
4128     $variableType = $1;
4129     }
4130     $r-><AS::PerlVariable.variableType> ($variableType)
4131     if defined $variableType;
4132     $r-><AS::PerlVariable.packageName> ($packageName)
4133     if defined $packageName;
4134     $r-><AS::PerlVariable.pcLocalName> ($localName);
4135     }__;
4136    
4137     @Method:
4138     @@Name: createPCDereference
4139     @@enDesc:
4140     Creates a <IF::PCDereference> object.
4141     @@Param:
4142     @@@Name: variableType
4143     @@@Type: DOMString
4144     @@@enDesc:
4145     The type of the referenced value, such as <Perl::$>.
4146     @@Return:
4147     @@@Type: PCDereference
4148     @@@enDesc:
4149     The newly created element node.
4150     @@@PerlDef:
4151     __DEEP{
4152 wakaba 1.48 $r = $self-><M::Document.createElementNS>
4153     (<Q::pc:>, 'dereference');
4154 wakaba 1.44 $r-><AS::PCDereference.variableType> ($variableType);
4155 wakaba 1.48 }__;
4156    
4157     @Method:
4158     @@Name: createPCReference
4159     @@enDesc:
4160     Creates a <IF::PCReference> object.
4161     @@Return:
4162     @@@Type: PCReference
4163     @@@enDesc:
4164     The newly created element node.
4165     @@@PerlDef:
4166     __DEEP{
4167     $r = $self-><M::Document.createElementNS>
4168     (<Q::pc:>, 'reference');
4169 wakaba 1.44 }__;
4170    
4171     @Method:
4172 wakaba 1.43 @@Name: createPCExpression
4173     @@enDesc:
4174     Creates a <Q::pc:expression> element node.
4175     @@Param:
4176     @@@Name: operator
4177     @@@Type: DOMString
4178     @@@enDesc:
4179     The operator of the expression.
4180     @@Return:
4181     @@@Type: PCExpression
4182     @@@enDesc:
4183     The newly created expression object.
4184     @@@PerlDef:
4185     __DEEP{
4186 wakaba 1.44 $r = $self-><M::Document.createElementNS> (<Q::pc:>, 'expression');
4187 wakaba 1.43 $r-><AS::PCExpression.operator> ($operator);
4188     }__;
4189    
4190     @Method:
4191 wakaba 1.44 @@Name: createPCApply
4192     @@enDesc:
4193     Creates a <Q::pc:apply> element node.
4194     @@Return:
4195     @@@Type: PCApply
4196     @@@enDesc: The newly created element node.
4197     @@@PerlDef:
4198     __DEEP{
4199     $r = $self-><M::Document.createElementNS> (<Q::pc:>, 'apply');
4200     }__;
4201    
4202     @Method:
4203 wakaba 1.43 @@Name: createPCFunctionCall
4204     @@enDesc:
4205 wakaba 1.44 Creates a function call element node.
4206 wakaba 1.43 @@Param:
4207     @@@Name: package
4208     @@@Type: DOMString
4209     @@@enDesc:
4210     The package to which the function belongs.
4211     @@@nullCase:
4212     @@@@enDesc: No package name.
4213     @@Param:
4214     @@@Name: localName
4215     @@@Type: DOMString
4216     @@@enDesc:
4217     The local part of the function name.
4218     @@Return:
4219 wakaba 1.44 @@@Type: PCApply
4220 wakaba 1.43 @@@enDesc:
4221     The newly created function object.
4222     @@@PerlDef:
4223     __DEEP{
4224 wakaba 1.44 $r = $self-><M::Document.createElementNS> (<Q::pc:>, 'apply');
4225     my $func = $self-><M::PCDocument.createPCVariable>
4226     ('', $package, $localName);
4227     $r-><M::Node.appendChild> ($func);
4228     }__;
4229    
4230     @Method:
4231 wakaba 1.46 @@Name: createPCStatement
4232     @@enDesc:
4233     Creates a statement object.
4234     @@Return:
4235     @@@Type: PerlStatement
4236     @@@enDesc:
4237     The newly created statement element node.
4238     @@@PerlDef:
4239     __DEEP{
4240     $r = $self-><M::Document.createElementNS> (<Q::pc:>, 'statement');
4241     }__;
4242    
4243     @Method:
4244 wakaba 1.44 @@Name: createPCBlock
4245     @@enDesc:
4246     Creates a <Q::pc2:block> element node.
4247     @@Return:
4248     @@@Type: PCBlock
4249     @@@enDesc:
4250     The newly created <Q::pc2:block> element.
4251     @@@PerlDef:
4252     __DEEP{
4253     $r = $self-><M::Document.createElementNS> (<Q::pc2:>, 'block');
4254 wakaba 1.43 }__;
4255    
4256     @Method:
4257     @@Name: createPCChoose
4258     @@enDesc:
4259     Creates a <Q::pc:choose> element node.
4260     @@Return:
4261     @@@Type: PCChoose
4262     @@@enDesc:
4263     The newly created <Q::pc:choose> element.
4264     @@@PerlDef:
4265     __DEEP{
4266     $r = $self-><M::Document.createElementNS> (<Q::pc:>, 'choose');
4267 wakaba 1.45 }__;
4268    
4269     @Method:
4270     @@Name: createPCWhile
4271     @@enDesc:
4272     Creates a <Q::pc:while> element node.
4273     @@Return:
4274     @@@Type: PCWhile
4275     @@@enDesc:
4276     The newly created <Q::pc:while> element.
4277     @@@PerlDef:
4278     __DEEP{
4279     $r = $self-><M::Document.createElementNS> (<Q::pc:>, 'while');
4280     $r-><M::Node.appendChild>
4281     ($self-><M::Document.createElementNS> (<Q::pc2:>, 'condition'));
4282     $r-><M::Node.appendChild>
4283     ($self-><M::Document.createElementNS> (<Q::pc2:>, 'block'));
4284 wakaba 1.41 }__;
4285 wakaba 1.46
4286     @Method:
4287     @@Name: createPerlSub
4288     @@enDesc:
4289     Creates a new <IF::PerlSub> object.
4290     @@Param:
4291     @@@Name: subName
4292     @@@Type: DOMString
4293     @@@enDesc:
4294     The name of the subroutine to create.
4295     @@@nullCase:
4296     @@@@enDesc:
4297     The subroutine created has no name.
4298     @@Return:
4299     @@@Type: PerlSub
4300     @@@enDesc:
4301     Newly created Perl subroutine object.
4302     @@@PerlDef:
4303     __DEEP{
4304     $r = $self-><M::Document.createElementNS> (<Q::pc:>, 'sub');
4305     $r-><M::PerlSub.addPerlName> ($subName) if defined $subName;
4306     }__;
4307 wakaba 1.51
4308     @ResourceDef:
4309     @@ForCheck: ManakaiDOM|ForClass
4310     @@QName: createPCDocumentForTest
4311     @@rdf:type: DISPerl|BlockCode
4312     @@PerlDef:
4313     my $impl = <Class::ManakaiPCImplementation>->_new;
4314     $doc = $impl-><M::DOMImpl.createDocument> (<Q::pc:>, 'file');
4315 wakaba 1.61
4316     @Method:
4317     @@Name: createPCIf
4318     @@enDesc:
4319     Creates a <IF::PerlIf> object.
4320     @@Param:
4321     @@@Name: conditionArg
4322     @@@Type: PerlCodeInlines
4323     @@@enDesc:
4324     Condition code fragment object.
4325     @@Param:
4326     @@@Name: trueArg
4327     @@@Type: PerlCodeBlocks
4328     @@@enDesc:
4329     A true code fragment object.
4330     @@@nullCase:
4331     @@@@enDesc: No true code.
4332     @@Param:
4333     @@@Name: falseArg
4334     @@@Type: PerlCodeBlocks
4335     @@@enDesc:
4336     A false code fragment object.
4337     @@@nullCase:
4338     @@@@enDesc: No false code.
4339     @@Return:
4340     @@@Type: PerlIf
4341     @@@PerlDef:
4342     __DEEP{
4343     $r = $self-><M::Document.createElementNS> (<Q::pc:>, 'if');
4344     $r-><AS::PerlIf.condition> ($conditionArg) if defined $conditionArg;
4345     $r-><AS::PerlIf.trueCode> ($trueArg) if defined $trueArg;
4346     $r-><AS::PerlIf.falseCode> ($falseArg) if defined $falseArg;
4347     }__;
4348    
4349     @@Test:
4350     @@@QName: PCDocument.createPCIf.noarg.test
4351     @@@PerlDef:
4352     my $doc;
4353     __CODE{createPCDocumentForTest:: $doc => $doc}__;
4354    
4355     my $e1 = $doc-><M::Document.createElementNS> (null, 'e1');
4356    
4357     my $if = $doc-><M::PCDocument.createPCIf> ($e1);
4358    
4359     $test->assert_isa ($if, <IFName::PerlIf>);
4360    
4361     $test->id ('condition');
4362     $test->assert_equals ($if-><AG::PerlIf.condition>, $e1);
4363    
4364     $test->id ('trueCode');
4365     $test->assert_null ($if-><AG::PerlIf.trueCode>);
4366    
4367     $test->id ('falseCode');
4368     $test->assert_null ($if-><AG::PerlIf.falseCode>);
4369     @@Test:
4370     @@@QName: PCDocument.createPCIf.args.test
4371     @@@PerlDef:
4372     my $doc;
4373     __CODE{createPCDocumentForTest:: $doc => $doc}__;
4374    
4375     my $e1 = $doc-><M::Document.createElementNS> (null, 'e1');
4376     my $e2 = $doc-><M::Document.createElementNS> (null, 'e2');
4377     my $e3 = $doc-><M::Document.createElementNS> (null, 'e3');
4378    
4379     my $if = $doc-><M::PCDocument.createPCIf> ($e1, $e2, $e3);
4380    
4381     $test->id ('return');
4382     $test->assert_isa ($if, <IFName::PerlIf>);
4383    
4384     $test->id ('condition');
4385     $test->assert_equals ($if-><AG::PerlIf.condition>, $e1);
4386    
4387     $test->id ('trueCode');
4388     $test->assert_equals ($if-><AG::PerlIf.trueCode>, $e2);
4389    
4390     $test->id ('falseCode');
4391     $test->assert_equals ($if-><AG::PerlIf.falseCode>, $e3);
4392    
4393     @Method:
4394     @@Name: createPCPackage
4395     @@enDesc:
4396     Creates a new package scope block.
4397     @@Param:
4398     @@@Name: packageName
4399     @@@Type: DOMString
4400     @@@enDesc:
4401     The fully-qualified name of the package to create.
4402     @@Return:
4403     @@@Type: PerlPackage
4404     @@@enDesc:
4405     The newly created package scope object.
4406     @@@PerlDef:
4407     __DEEP{
4408     $r = $self-><M::Document.createElementNS> (<Q::pc:>, 'package');
4409     $r-><AS::PerlPackage.packageName> ($packageName);
4410     }__;
4411    
4412     @@Test:
4413     @@@QName: PCDocument.createPCPackage
4414     @@@PerlDef:
4415     my $doc;
4416     __CODE{createPCDocumentForTest:: $doc => $doc}__;
4417    
4418     my $pack = $doc-><M::PCDocument.createPCPackage> ('Package::Name');
4419    
4420     $test->id ('package');
4421     $test->assert_isa ($pack, <IFName::PerlPackage>);
4422    
4423     $test->id ('packageName');
4424     $test->assert_equals ($pack-><AG::PerlPackage.packageName>,
4425     'Package::Name');
4426 wakaba 1.41 ##PCDocument
4427    
4428 wakaba 1.39 ## -- Implementation
4429 wakaba 1.6
4430 wakaba 1.25 IFClsDef:
4431     @IFQName: PCImplementation
4432 wakaba 1.35 @CQName: ManakaiPCImplementation
4433 wakaba 1.25
4434 wakaba 1.1 @enDesc:
4435     The class that provides factory methods.
4436 wakaba 1.20
4437 wakaba 1.59 @CISA: c|ManakaiDOMImplementation||ManakaiDOM|ManakaiDOMLatest
4438 wakaba 1.17
4439 wakaba 1.35 @f:provides: pc|CoreFeature10
4440 wakaba 1.1
4441 wakaba 1.59 @Test:
4442     @@QName: ImplementationRegistry.PCImplementation.1.0.test
4443     @@PerlDef:
4444     my $impl = $Message::DOM::ImplementationRegistry
4445     ->get_implementation ({<Q::Util|PerlCode> => '1.0'});
4446    
4447     $test->assert_isa ($impl, <IFName::PCImplementation>);
4448     @Test:
4449     @@QName: ImplementationRegistry.PCImplementation.empty.test
4450     @@PerlDef:
4451     my $impl = $Message::DOM::ImplementationRegistry
4452     ->get_implementation ({<Q::Util|PerlCode> => ''});
4453    
4454     $test->assert_isa ($impl, <IFName::PCImplementation>);
4455     @Test:
4456     @@QName: ImplementationRegistry.PCImplementation.null.test
4457     @@PerlDef:
4458     my $impl = $Message::DOM::ImplementationRegistry
4459     ->get_implementation ({<Q::Util|PerlCode> => null});
4460    
4461     $test->assert_isa ($impl, <IFName::PCImplementation>);
4462    
4463 wakaba 1.1 @Method:
4464 wakaba 1.61 @@Name: createPCFile
4465 wakaba 1.1 @@enDesc:
4466 wakaba 1.61 Creates a <IF::PerlFile> object that belongs to the new
4467     <IF::PCDocument>.
4468 wakaba 1.1 @@Return:
4469 wakaba 1.25 @@@Type: PerlFile
4470 wakaba 1.61 @@@enDesc:
4471     {P:: The newly created Perl file object where:
4472    
4473     - The <A::Document.strictErrorChecking> attribute
4474     is set to <DOM::false>.
4475    
4476     - The <Q::cfg|dtd-default-attribute> configuration
4477     parameter is set to <DOM::false>.
4478    
4479     - The <Q::cfg|dtd-attribute-type> configuration
4480     parameter is set to <DOM::false>.
4481    
4482     }
4483     @@@PerlDef:
4484     __DEEP{
4485     my $rdoc = $self-><M::DOMImpl.createDocument> (<Q::pc:>, 'file');
4486    
4487     $rdoc-><AS::Document.strictErrorChecking> (false);
4488     my $rdoc_cfg = $rdoc-><AG::Document.domConfig>;
4489     $rdoc_cfg-><M::CFG.setParameter>
4490     (<Q::cfg|dtd-default-attribute> => false);
4491     $rdoc_cfg-><M::CFG.setParameter>
4492     (<Q::cfg|dtd-attribute-type> => false);
4493    
4494     $r = $rdoc-><AG::Document.documentElement>;
4495     }__;
4496    
4497     @@Test:
4498     @@@QName: PCImplementation.createPCFile.test
4499 wakaba 1.1 @@@PerlDef:
4500 wakaba 1.61 my $impl;
4501     __CODE{tc|createImplForTest:: $impl => $impl}__;
4502     $impl = $impl->get_feature (<Q::Util|PerlCode> => '1.0');
4503    
4504     my $file = $impl-><M::PCImplementation.createPCFile>;
4505    
4506     $test->id ('interface');
4507     $test->assert_isa ($file, <IFName::PerlFile>);
4508    
4509     my $od = $file->owner_document;
4510    
4511     $test->id ('od.interface');
4512     $test->assert_isa ($od, <IFName::PCDocument>);
4513    
4514     $test->id ('parentNode');
4515     $test->assert_equals ($file->parent_node, $od);
4516    
4517     $test->id ('strictErrorChecking');
4518     $test->assert_false ($od->strict_error_checking);
4519    
4520     my $cfg = $od->dom_config;
4521    
4522     $test->id ('cfg.dtd-default-attribute');
4523     $test->assert_false ($cfg->get_parameter
4524     (<Q::cfg|dtd-default-attribute>));
4525    
4526     $test->id ('cfg.dtd-attribute-type');
4527     $test->assert_false ($cfg->get_parameter
4528     (<Q::cfg|dtd-attribute-type>));
4529 wakaba 1.1
4530     @IntMethod:
4531 wakaba 1.25 @@ForCheck: ManakaiDOM|ForClass
4532 wakaba 1.1 @@Name: perlComment
4533     @@ManakaiDOM:isStatic:1
4534     @@enDesc:
4535     Generates a Perl comment string.
4536     @@Param:
4537     @@@Name: str
4538 wakaba 1.35 @@@Type: DOMString
4539 wakaba 1.1 @@@enDesc:
4540     A comment text.
4541     @@Return:
4542 wakaba 1.35 @@@Type: DOMString
4543 wakaba 1.1 @@@enDesc:
4544     A Perl comment string.
4545     @@@PerlDef:
4546     $r = $str;
4547     $r =~ s/\n/\n## /g;
4548     $r =~ s/\n## $/\n/s;
4549     $r .= "\n" unless $r =~ /\n$/;
4550     $r = q<## > . $r;
4551    
4552     @IntMethod:
4553 wakaba 1.25 @@ForCheck: ManakaiDOM|ForClass
4554 wakaba 1.1 @@Name: rfc3339DateTime
4555     @@ManakaiDOM:isStatic:1
4556     @@enDesc:
4557     Returns RFC 3339 <CODE::date-time> representation of a date.
4558     @@Param:
4559     @@@Name: perlDate
4560 wakaba 1.35 @@@Type: idl|unsignedLong||ManakaiDOM|all
4561 wakaba 1.1 @@@enDesc:
4562     A Perl representation of date.
4563     @@Return:
4564 wakaba 1.35 @@@Type: DOMString
4565 wakaba 1.1 @@@enDesc:
4566     RFC 3339 date string.
4567     @@@PerlDef:
4568     my @time = gmtime $perlDate;
4569     $r = sprintf q<%04d-%02d-%02dT%02d:%02d:%02d+00:00>,
4570     $time[5] + 1900, $time[4] + 1, @time[3,2,1,0];
4571    
4572     @IntMethod:
4573 wakaba 1.25 @@ForCheck: ManakaiDOM|ForClass
4574 wakaba 1.1 @@Name: versionDateTime
4575     @@ManakaiDOM:isStatic:1
4576     @@enDesc:
4577     Returns date for version.
4578     @@Param:
4579     @@@Name: perlDate
4580 wakaba 1.35 @@@Type: idl|unsignedLong||ManakaiDOM|all
4581 wakaba 1.1 @@@enDesc:
4582     A Perl representation of date.
4583     @@Return:
4584 wakaba 1.35 @@@Type: DOMString
4585 wakaba 1.1 @@@enDesc:
4586     A Perl number literal.
4587     @@@PerlDef:
4588     my @time = gmtime $perlDate;
4589     $r = sprintf q<%04d%02d%02d.%02d%02d>,
4590     $time[5] + 1900, $time[4] + 1, @time[3,2,1];
4591    
4592     @Method:
4593     @@Name: perlLiteral
4594     @@enDesc:
4595     Perl code representation.
4596     @@Param:
4597     @@@Name: val
4598 wakaba 1.35 @@@Type: DISPerl|Any||ManakaiDOM|all
4599 wakaba 1.1 @@@enDesc:
4600     A Perl value.
4601     @@Return:
4602 wakaba 1.35 @@@Type: DOMString
4603 wakaba 1.1 @@@enDesc:
4604     A Perl lexical representation of <P::val>.
4605     @@@PerlDef:
4606     unless (defined $val) {
4607     $r = q<undef>;
4608     } elsif (ref $val eq 'ARRAY') {
4609     __DEEP{
4610 wakaba 1.36 $r = q<[> . <ClassM::ManakaiPCImplementation
4611 wakaba 1.14 .perlList> ($val) . q<]>;
4612 wakaba 1.1 }__;
4613     } elsif (ref $val eq 'HASH') {
4614     __DEEP{
4615 wakaba 1.31 $r = q<{>
4616 wakaba 1.36 . <ClassM::ManakaiPCImplementation.perlList>
4617 wakaba 1.31 ([map {$_ => $val->{$_}} sort {$a cmp $b} keys %$val])
4618     . q<}>;
4619 wakaba 1.1 }__;
4620 wakaba 1.38 } elsif (ref $val eq 'manakai::code') {
4621     $r = $$val;
4622 wakaba 1.1 } else {
4623     $val =~ s/(['\\])/\\$1/g;
4624     $r = q<'> . $val . q<'>;
4625     }
4626    
4627     @Method:
4628     @@Name: perlList
4629     @@enDesc:
4630     Perl code representation of a list.
4631     @@Param:
4632     @@@Name: val
4633 wakaba 1.35 @@@Type: DISPerl|ARRAY||ManakaiDOM|all
4634 wakaba 1.1 @@@enDesc:
4635     A Perl array reference.
4636     @@Return:
4637 wakaba 1.35 @@@Type: DOMString
4638 wakaba 1.1 @@@enDesc:
4639     A Perl lexical representation of <CODE::@$val>.
4640     @@@PerlDef:
4641     __DEEP{
4642 wakaba 1.58 $r = join (qq<,\n>, map {<ClassM::ManakaiPCImplementation
4643 wakaba 1.1 .perlLiteral> ($_)} @{$val});
4644     }__;
4645 wakaba 1.25 ##PCImplementation
4646 wakaba 1.1
4647 wakaba 1.5 ResourceDef:
4648 wakaba 1.35 @QName: DOMImpl
4649 wakaba 1.59 @AliasFor: c|DOMImplementation
4650 wakaba 1.41 @For: ManakaiDOM|DOM
4651    
4652     ResourceDef:
4653     @QName: NodeList
4654 wakaba 1.59 @AliasFor: tc|NodeList
4655 wakaba 1.35 @For: ManakaiDOM|DOM
4656    
4657     ResourceDef:
4658     @QName: Node
4659 wakaba 1.59 @AliasFor: tc|Node
4660 wakaba 1.35 @For: ManakaiDOM|DOM
4661    
4662     ResourceDef:
4663     @QName: Element
4664 wakaba 1.59 @AliasFor: tc|Element
4665 wakaba 1.35 @For: ManakaiDOM|DOM
4666    
4667     ResourceDef:
4668     @QName: Document
4669 wakaba 1.59 @AliasFor: tc|Document
4670 wakaba 1.35 @For: ManakaiDOM|DOM
4671    
4672 wakaba 1.1 ElementTypeBinding:
4673     @Name: Method
4674     @ElementType:
4675     dis:ResourceDef
4676     @ShadowContent:
4677     @@rdf:type:
4678     DISLang:Method
4679    
4680     ElementTypeBinding:
4681     @Name: ToStringMethod
4682     @ElementType:
4683     dis:ResourceDef
4684     @ShadowContent:
4685     @@rdf:type:
4686     DISLang:Method
4687     @@Operator:
4688     @@@@:
4689     DISPerl:AsStringMethod
4690 wakaba 1.35 @@@ContentType: DISCore|QName
4691 wakaba 1.1 @@Description:
4692     @@@lang:en
4693     @@@@:
4694     Returns the textual Perl source code representation of this object.
4695 wakaba 1.9
4696 wakaba 1.14 ElementTypeBinding:
4697     @Name: NumValMethod
4698     @ElementType:
4699     dis:ResourceDef
4700     @ShadowContent:
4701     @@rdf:type:
4702     DISLang:Method
4703     @@Operator:
4704     @@@@: 0+
4705     @@@ContentType:
4706     lang:Perl
4707     @@Description:
4708     @@@lang:en
4709     @@@@:
4710     Returns the numeric value of this object.
4711 wakaba 1.9
4712     ElementTypeBinding:
4713 wakaba 1.1 @Name: IntMethod
4714     @ElementType:
4715     dis:ResourceDef
4716     @ShadowContent:
4717     @@rdf:type:
4718     DISLang:Method
4719     @@ManakaiDOM:isForInternal:1
4720    
4721     ElementTypeBinding:
4722     @Name: Attr
4723     @ElementType:
4724     dis:ResourceDef
4725     @ShadowContent:
4726     @@rdf:type:
4727     DISLang:Attribute
4728    
4729     ElementTypeBinding:
4730     @Name: Return
4731     @ElementType:
4732     dis:ResourceDef
4733     @ShadowContent:
4734     @@rdf:type:
4735     DISLang:MethodReturn
4736    
4737     ElementTypeBinding:
4738     @Name: Get
4739     @ElementType:
4740     dis:ResourceDef
4741     @ShadowContent:
4742     @@rdf:type:
4743     DISLang:AttributeGet
4744    
4745     ElementTypeBinding:
4746     @Name: Set
4747     @ElementType:
4748     dis:ResourceDef
4749     @ShadowContent:
4750     @@rdf:type:
4751     DISLang:AttributeSet
4752    
4753     ElementTypeBinding:
4754     @Name: Param
4755     @ElementType:
4756     dis:ResourceDef
4757     @ShadowContent:
4758     @@rdf:type:
4759     DISLang:MethodParameter
4760    
4761     ElementTypeBinding:
4762     @Name: PerlDef
4763     @ElementType:
4764     dis:Def
4765     @ShadowContent:
4766     @@ContentType:
4767     lang:Perl
4768 wakaba 1.27 @@ForCheck: ManakaiDOM|ForClass
4769 wakaba 1.28
4770     ElementTypeBinding:
4771     @Name: PerlCDef
4772     @ElementType:
4773     dis:Def
4774     @ShadowContent:
4775     @@ContentType:
4776     lang:Perl
4777 wakaba 1.1
4778     ElementTypeBinding:
4779     @Name: disDef
4780     @ElementType:
4781     dis:Def
4782     @ShadowContent:
4783     @@ContentType:
4784     lang:dis
4785 wakaba 1.27 @@ForCheck: ManakaiDOM|ForClass
4786 wakaba 1.1
4787     ElementTypeBinding:
4788     @Name: InCase
4789     @ElementType:
4790     dis:ResourceDef
4791     @ShadowContent:
4792     @@rdf:type:
4793     ManakaiDOM:InCase
4794    
4795     ElementTypeBinding:
4796     @Name: nullCase
4797     @ElementType:
4798     dis:ResourceDef
4799     @ShadowContent:
4800     @@rdf:type:
4801     ManakaiDOM:InCase
4802     @@Value:
4803     @@@is-null:1
4804    
4805     ElementTypeBinding:
4806     @Name: TrueCase
4807     @ElementType:
4808     dis:ResourceDef
4809     @ShadowContent:
4810     @@rdf:type:
4811     ManakaiDOM:InCase
4812 wakaba 1.27 @@Value:
4813     @@@@:1
4814     @@@ContentType: DISCore|Boolean
4815 wakaba 1.1 @@Type:
4816 wakaba 1.12 DOMMain:boolean::ManakaiDOM:all
4817 wakaba 1.1
4818    
4819     ElementTypeBinding:
4820     @Name: FalseCase
4821     @ElementType:
4822     dis:ResourceDef
4823     @ShadowContent:
4824     @@rdf:type:
4825     ManakaiDOM:InCase
4826 wakaba 1.27 @@Value:
4827     @@@@:0
4828     @@@ContentType: DISCore|Boolean
4829 wakaba 1.1 @@Type:
4830 wakaba 1.12 DOMMain:boolean::ManakaiDOM:all
4831 wakaba 1.1
4832     ElementTypeBinding:
4833     @Name: enDesc
4834     @ElementType:
4835     dis:Description
4836     @ShadowContent:
4837     @@lang:en
4838    
4839     ElementTypeBinding:
4840     @Name: NamedParam
4841     @ElementType:
4842     dis:ResourceDef
4843     @ShadowContent:
4844     @@rdf:type:
4845     DISLang:MethodParameter
4846     @@DISPerl:isNamedParameter:1
4847    

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24