/[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.60 - (hide annotations) (download)
Sat Apr 1 17:52:34 2006 UTC (19 years, 3 months ago) by wakaba
Branch: MAIN
Changes since 1.59: +7 -3 lines
++ manakai/t/ChangeLog	1 Apr 2006 17:11:22 -0000
2006-04-02  Wakaba  <wakaba@suika.fam.cx>

	* Makefile: Tests |dom-Tree.t| and |dom-DOMXML.t| are
	removed.  Tests |dom-Document.t| and |dom-Element.t| are added.

++ manakai/lib/Message/Util/DIS/ChangeLog	1 Apr 2006 17:10:39 -0000
2006-04-02  Wakaba  <wakaba@suika.fam.cx>

	* Perl.dis (plGeneratePerlModule): Some class names are changed.

++ manakai/lib/Message/DOM/ChangeLog	1 Apr 2006 17:09:40 -0000
2006-04-02  Wakaba  <wakaba@suika.fam.cx>

	* Makefile: Rules for |Tree.pm| and |DOMXML.pm| are
	removed.  For |Element.pm| and |Document.pm| are added.

	* Document.dis, Element.dis: New module split from |TreeCore.dis|.

	* TreeCore.dis (Document, DocumentFragment, Element, Attr): Removed.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24