/[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.47 - (hide annotations) (download)
Sat Dec 24 07:27:13 2005 UTC (19 years, 6 months ago) by wakaba
Branch: MAIN
Changes since 1.46: +21 -3 lines
++ manakai/lib/Message/Util/ChangeLog	24 Dec 2005 07:21:48 -0000
2005-12-24  Wakaba  <wakaba@suika.fam.cx>

	* PerlCode.dis (PerlSub.clearPerlName): New method.
	(PCDocument.createPCLiteral): Adopts |PerlCode| node
	if it is a foreign one.

	* DIS.dis (underscoreNameToCamelCaseName): A |HYPHEN-MINUS|
	character is replaced to |UNDERLINE| character.

++ manakai/lib/Message/Util/DIS/ChangeLog	24 Dec 2005 07:27:07 -0000
2005-12-24  Wakaba  <wakaba@suika.fam.cx>

	* Perl.dis (DISResourcePerl.plName): Implemented
	for |DISLang:AnyClass| resources.
	(DISResourcePerl.getPerlNameList): Don't prefix by |UNDERLINE|
	if the name comes from |DISPerl:methodName| attribute
	in case the method is for internal use.
	(DISResourcePerl.plCodeFragment): Generates return
	value convertion code from |DISLang:OutputProcessor| for
	attribute getter.  |ecore:textFormatter| attribute is
	implemented.  |Muf2003:RuleDefClass| is implemented.

	* DPG.dis (token-error): Packs error location
	information into the error object.
	(DPGExceptionFormatter): New interface.

++ manakai/lib/Message/DOM/ChangeLog	23 Dec 2005 14:20:29 -0000
2005-12-23  Wakaba  <wakaba@suika.fam.cx>

	* DOMCore.dis (DOMLocator): Implemented.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24