/[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.59 - (hide annotations) (download)
Sat Apr 1 14:41:33 2006 UTC (19 years, 3 months ago) by wakaba
Branch: MAIN
Changes since 1.58: +140 -288 lines
++ manakai/t/ChangeLog	1 Apr 2006 09:28:43 -0000
2006-04-01  Wakaba  <wakaba@suika.fam.cx>

	* Makefile (util-dis-DPG.t): New test.

	* Makefile (dom-XML.t): New test.
	* Makefile (dom-TreeCore.t): New test.
++ manakai/bin/ChangeLog	1 Apr 2006 08:52:15 -0000
2006-04-01  Wakaba  <wakaba@suika.fam.cx>

	* daf.pl (perl-pm, daf_generate_perl_test): Sets
	the |$Message::Util::DIS::Perl::Implementation| variable
	for compatibility.

++ manakai/lib/Message/Util/ChangeLog	1 Apr 2006 11:55:12 -0000
2006-04-01  Wakaba  <wakaba@suika.fam.cx>

	* Grove.dis (destroy): Threshold value changed to 4096.

	* PerlCode.dis (PerlCode): Associated as the default
	class with |pc:*| and |pc2:*| element types.
	(currentPackage, currentChunkNumber, getNextChunkNumber): Removed.
	(ReflectCDATA): Reimplemented using standard |Element|
	methods.
	(sourceFile, sourceLine, currentSourceFile, currentSourceLine,
	skipLines): Removed.
	(pc:line): Removed.
	(stringify): Support for the |pc:line| configuration
	parameter is removed.

	* DIS.dis (isFeatureProvided): Removed.

++ manakai/lib/Message/Util/DIS/ChangeLog	1 Apr 2006 09:24:59 -0000
2006-04-01  Wakaba  <wakaba@suika.fam.cx>

	* Perl.dis (plImplementation): Get the instance
	from the |$Message::Util::DIS::Perl::Implementation| variable.
	(plIsFeatureImplemented): Removed.
	(plPreprocessPerlCode, plPreprocessPerlStatement): The |sourceFile|
	and |sourceLine| parameters are removed.

	* DPG.dis (DPGElement): Associated to the |pg:*| element types.

++ manakai/lib/Message/DOM/ChangeLog	1 Apr 2006 11:35:47 -0000
	* DOMFeature.dis (getImplementation, getImplementationList): Support
	for new class information variables.
	(DOMLS:Generic): This old feature name is removed.

	* GenericLS.dis (createGLSParser, createGLSSerializer): Support
	for new class information variables.

	* TreeCore.dis (manakaiExpandedURI): New attribute.
	(Document, Element.___create_node_ref): New method
	implementations.

2006-04-01  Wakaba  <wakaba@suika.fam.cx>

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24