/[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.50 - (hide annotations) (download)
Sat Jan 21 17:37:51 2006 UTC (19 years, 5 months ago) by wakaba
Branch: MAIN
Changes since 1.49: +19 -17 lines
++ manakai/lib/Message/Util/ChangeLog	21 Jan 2006 17:23:17 -0000
2006-01-22  Wakaba  <wakaba@suika.fam.cx>

	* PerlCode.dis: Fixed not |getAttributeNS| to cause
	uninitialized value warnings.

++ manakai/lib/Message/Util/DIS/ChangeLog	21 Jan 2006 17:24:28 -0000
	* DPG.dis (plCodeFragment): A returning |#EOF| case
	was missing so that illegal character was appended to the sequence.
++ manakai/lib/Message/DOM/ChangeLog	21 Jan 2006 17:27:27 -0000
2006-01-22  Wakaba  <wakaba@suika.fam.cx>

	* Tree.dis (getAttribute): Returns |null| if there
	is no attribute in |ManakaiDOM:DOMLatest| for compatibility
	with Web browser implementations.
	(getAttributeNS): It returned |null| if there
	is no attribute in any |For| unintentionally.  It now
	returns an empty string in DOM levels less than or equals
	to three.

	* XMLParser.dis (shiftChar): Fixed not to be warned as
	uninitialized value or substring out of range.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24