/[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.65 - (hide annotations) (download)
Fri Nov 3 17:53:34 2006 UTC (18 years, 8 months ago) by wakaba
Branch: MAIN
Changes since 1.64: +79 -1 lines
++ manakai/bin/ChangeLog	3 Nov 2006 11:50:21 -0000
2006-11-03  Wakaba  <wakaba@suika.fam.cx>

	* grep-dis.pl: New script.

++ manakai/lib/Message/Util/ChangeLog	3 Nov 2006 17:49:43 -0000
2006-11-03  Wakaba  <wakaba@suika.fam.cx>

	* autoload/: New directory.

	* DIS.dis (getPropertyResourceList): Unused |defaultMediaType|
	parameter is deleted.  New |isaRecursivePropName|
	and |recursiveISAPropName| parameters are added.

	* PerlCode.dis (addRevISAPackageName, getRevISAPackageName):
	New methods.
	(stringify): Support for the rev-ISA packages is added.
	(getAutoloadDefinitionList): New method.

++ manakai/lib/Message/Util/DIS/ChangeLog	3 Nov 2006 17:51:23 -0000
2006-11-03  Wakaba  <wakaba@suika.fam.cx>

	* Perl.dis (plCodeFragment): Don't generate
	method parameter code if |DISPerl:noParameterModification|
	property is set.  Support for the |domperl:classExtends|
	and |domperl:classImplementedByObjectsOf| property
	is added.

++ manakai/lib/Message/DOM/ChangeLog	3 Nov 2006 17:47:28 -0000
2006-11-04  Wakaba  <wakaba@suika.fam.cx>

	* DOMCore.dis (ManakaiDOMImplementation): No longer
	explicitly inherits |tc:ManakaiDOMImplementationTC|.
	(ManakaiDOMImplementation.AUTOLOAD): New method definition.

	* TreeCore.dis (ManakaiDOMImplementationTC): Extends
	the |ManakaiDOMImplementation| class.

2006-11-03  Wakaba  <wakaba@suika.fam.cx>

	* DOMFeature.dis: Definitions for various concepts
	are added.

	* GenericLS.dis (GLSImplementation): It no
	longer inherits the |MinimumImplementation|; rather,
	any |ManakaiMinimumImplementation| object also
	implements |GLSImplementation| methods.

	* TreeStore.dis (DOMImplementationTreeStore): It no
	longer inherits the |DOMImplementation|; rather,
	any |ManakaiDOMImplementation| object also
	implements |DOMImplementationTreeStore| methods.

++ manakai/lib/manakai/ChangeLog	3 Nov 2006 17:53:26 -0000
2006-11-03  Wakaba  <wakaba@suika.fam.cx>

	* DISLang.dis (DISLang:AnyObject): New.
	(DISLang:extends, DISLang:implements): New.

	* DISPerl.dis (p:revISA): New.
	(p:noParameterModification): New.

	* daf-perl-pm.pl (daf_perl_pm): Update
	the |Message::Util::AutoLoad::Registry| module
	after the Perl module is generated.

++ manakai/lib/ChangeLog	3 Nov 2006 17:42:27 -0000
2006-11-04  Wakaba  <wakaba@suika.fam.cx>

	* Makefile (all): Make |Message/Util/AutoLoad/Registry.pm|.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24