/[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.63 - (hide annotations) (download)
Wed Apr 5 14:49:31 2006 UTC (19 years, 3 months ago) by wakaba
Branch: MAIN
Changes since 1.62: +2 -3 lines
++ manakai/lib/Message/Util/ChangeLog	5 Apr 2006 14:49:13 -0000
2006-04-05  Wakaba  <wakaba@suika.fam.cx>

	* Grove.dis (generateUniqueID): Don't include random number; it
	is unnecessary as long as only local uniquness is required.
	(destroy): Delete singleton.

	* PerlCode.dis (createPCLiteral): A variable was not set.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24