/[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.76 - (show annotations) (download)
Fri Sep 21 08:10:06 2007 UTC (17 years, 9 months ago) by wakaba
Branch: MAIN
CVS Tags: HEAD
Changes since 1.75: +1 -1 lines
FILE REMOVED
++ manakai/bin/ChangeLog	21 Sep 2007 07:55:21 -0000
2007-09-21  Wakaba  <wakaba@suika.fam.cx>

	* daf.pl, mkdisdump.pl, grep-dis.pl, mkdommemlist.pl: Removed.

++ manakai/lib/Message/IMT/ChangeLog	21 Sep 2007 08:02:20 -0000
2007-09-21  Wakaba  <wakaba@suika.fam.cx>

	* InternetMediaType.pm: Don't raise CoreException even if
	a read-only attribute is attempted to be modified.

++ manakai/lib/Message/Markup/ChangeLog	21 Sep 2007 07:46:59 -0000
2007-09-21  Wakaba  <wakaba@suika.fam.cx>

	* SuikaWikiConfig21.dis, SuikaWikiConfig21.pm, common.dis,
	H2H.dis: Removed.

++ manakai/lib/Message/Util/ChangeLog	21 Sep 2007 07:44:10 -0000
2007-09-21  Wakaba  <wakaba@suika.fam.cx>

	* Makefile (clean): Don't remove generated files.

	* ManakaiNode.dis, ManakaiNodeTest.dis, PerlCode.dis,
	PerlCode.pm, ManakaiNode.pm, common.dis, DIS.dis, DIS.pm: Removed.

	* DIS/, AutoLoad/: Removed.

++ manakai/lib/Message/Util/Error/ChangeLog	21 Sep 2007 07:44:55 -0000
2007-09-21  Wakaba  <wakaba@suika.fam.cx>

	* Core.dis, DOMException.pm, DOMException.dis: Removed.

++ manakai/lib/Message/Util/Formatter/ChangeLog	21 Sep 2007 08:09:07 -0000
2007-09-21  Wakaba  <wakaba@suika.fam.cx>

	* Base.pm (___error_def): Error description key names
	are updated.

	* Muf2003.dis: Removed.

++ manakai/lib/manakai/ChangeLog	21 Sep 2007 07:52:20 -0000
2007-09-21  Wakaba  <wakaba@suika.fam.cx>

	* DISLang.dis, Document.dis, NaturalLanguage.dis, DISMarkup.dis,
	ECMAScript.dis, Test.dis, Charset.dis, DISPerl.dis, Java.dis,
	XML.dis, DISCore.dis, DISRDF.dis, DISIDL.dis, DISSource.dis,
	Message.dis, daf-perl-t.pl, daf-dtd-modules.pl, daf-perl-pm.pl,
	dis-catalog, mndebug.pl: Removed.

++ manakai/t/ChangeLog	21 Sep 2007 08:00:31 -0000
2007-09-21  Wakaba  <wakaba@suika.fam.cx>

	* util-mnode.t: Removed.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24