Module: @QName: Util:PerlCode @FullName: @@lang: en @@@: Perl Code Constructor @Namespace: http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/PerlCode# @Description: @@lang:en @@@: This module provides an object-oriented interface to construct Perl code. @DISCore:author: DISCore|Wakaba @License: @@@: license:Perl+MPL @@Original: @@@FullName: manakai @@@Year:2004 @@@DISCore:author: DISCore|Wakaba @Date: @@@: $Date: 2005/12/24 07:27:13 $ @@ContentType: dis:Date.RCS @Require: @@Module: @@@QName: MDOM|DOMCore @@@WithFor: ManakaiDOM|ManakaiDOMLatest @DefaultFor: ManakaiDOM|ManakaiDOMLatest Namespace: @DIS: http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS# @dis: http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis-- @dx: http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException# @ecore: http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/Core/ @f: http://suika.fam.cx/~wakaba/archive/2004/dom/feature# @idl: http://suika.fam.cx/~wakaba/archive/2004/dis/IDL# @kwd: http://suika.fam.cx/~wakaba/archive/2005/rfc2119/ @lang: http://suika.fam.cx/~wakaba/archive/2004/8/18/lang# @license: http://suika.fam.cx/~wakaba/archive/2004/8/18/license# @ManakaiDOM: http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom# @MDOM: http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#ManakaiDOM. @MDOMX: http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception# @mn: http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/ManakaiNode# @pc: http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/PerlCode# @pc2: http://suika.fam.cx/~wakaba/archive/2005/12/pc/ @rdf: http://www.w3.org/1999/02/22-rdf-syntax-ns# @rdfs: http://www.w3.org/2000/01/rdf-schema# @s: http://suika.fam.cx/~wakaba/archive/2004/dis/Markup# @test: http://suika.fam.cx/~wakaba/archive/2004/dis/Test# @Util: http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/ ## -- Module sets ResourceDef: @QName: Util| @For: ManakaiDOM|DOM @rdf:type: dis|ModuleGroup @FullName: @@lang:en @@@: Manakai support modules @DISPerl:packageName: Message::Util:: @DISPerl:interfacePackageName: @@@: Message::Util::IF:: @@For: ManakaiDOM|ManakaiDOM !ManakaiDOM|ManakaiDOMLatest @DISPerl:interfacePackageName: @@@: Message::Util::IFLatest:: @@For: ManakaiDOM|ManakaiDOMLatest @ImplNote: @@lang:en @@@: Resources for and for is defined in module . ## -- Features ElementTypeBinding: @Name: FeatureDef @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: DOMFeature|Feature @@For: =ManakaiDOM|all ElementTypeBinding: @Name: FeatureVerDef @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: DOMFeature|Feature ElementTypeBinding: @Name: featureQName @ElementType: DOMFeature:name @ShadowContent: @@ContentType: DISCore|QName FeatureDef: @QName: CoreFeature @featureQName: Util:PerlCode @FeatureVerDef: @@QName: CoreFeature10 @@Version: 1.0 @@ISA: CoreFeature @@FullName: @@@lang:en @@@@: Perl Code Constructor, version 1.0 @@Description: @@@lang:en @@@@: Perl Code Constructor, version 1.0. ElementTypeBinding: @Name: IFClsDef @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: @@@@: dis|MultipleResource @@@ForCheck: !ManakaiDOM|ForIF !ManakaiDOM|ForClass @@resourceFor: ManakaiDOM|ForIF @@resourceFor: ManakaiDOM|ForClass @@For: ManakaiDOM|ManakaiDOM @@rdf:type: @@@@: DISLang|Interface @@@ForCheck: ManakaiDOM|ForIF @@rdf:type: @@@@: DISLang|Class @@@ForCheck: ManakaiDOM|ForClass @@Implement: @@@@: ||ManakaiDOM|ManakaiDOM||ManakaiDOM|ForIF @@@ContentType: DISCore|TFPQNames @@@ForCheck: ManakaiDOM|ForClass ManakaiDOM|ManakaiDOM @@Implement: @@@@: ||ManakaiDOM|ManakaiDOMLatest||ManakaiDOM|ForIF @@@ContentType: DISCore|TFPQNames @@@ForCheck: ManakaiDOM|ForClass ManakaiDOM|ManakaiDOMLatest @@f:implements: pc|CoreFeature10 ElementTypeBinding: @Name: IFClsETDef @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: @@@@: dis|MultipleResource @@@ForCheck: !ManakaiDOM|ForIF !ManakaiDOM|ForClass !s|ForML @@resourceFor: ManakaiDOM|ForIF @@resourceFor: ManakaiDOM|ForClass @@resourceFor: s|ForML @@For: ManakaiDOM|ManakaiDOM @@rdf:type: @@@@: DISLang|Interface @@@ForCheck: ManakaiDOM|ForIF @@rdf:type: @@@@: DISLang|Class @@@ForCheck: ManakaiDOM|ForClass @@Implement: @@@@: ||ManakaiDOM|ManakaiDOM||ManakaiDOM|ForIF @@@ContentType: DISCore|TFPQNames @@@ForCheck: ManakaiDOM|ForClass ManakaiDOM|ManakaiDOM @@Implement: @@@@: ||ManakaiDOM|ManakaiDOMLatest||ManakaiDOM|ForIF @@@ContentType: DISCore|TFPQNames @@@ForCheck: ManakaiDOM|ForClass ManakaiDOM|ManakaiDOMLatest @@s:elementType: @@@@: ||+||s|ForML @@@ContentType: DISCore|TFPQNames @@@DISCore:stopISARecursive:1 @@rdf:type: @@@@: s|ElementType @@@ForCheck: s|ForML @@f:implements: pc|CoreFeature10 ElementTypeBinding: @Name: IFQName @ElementType: dis:QName @ShadowContent: @@ForCheck: ManakaiDOM|ForIF ElementTypeBinding: @Name: CQName @ElementType: dis:QName @ShadowContent: @@ForCheck: ManakaiDOM|ForClass ElementTypeBinding: @Name: IFISA @ElementType: dis:ISA @ShadowContent: @@ForCheck: ManakaiDOM|ForIF ElementTypeBinding: @Name: CISA @ElementType: dis:ISA @ShadowContent: @@ForCheck: ManakaiDOM|ForClass ## -- Classes IFClsDef: @IFQName: PerlCode @CQName: ManakaiPCCode @CISA: DOMCore|ManakaiDOMElement @enDesc: A class on which another Perl code classes are constructed based. @Attr: @@Name: fileNode @@enDesc: The root node of the tree to which this node belongs. @@Type: PerlCode @@Get: @@@enDesc: The node of the tree. @@@nullCase: @@@@enDesc: This node does not belong to any file tree. @@@PerlDef: __DEEP{ $r = $self-> ->; if ($r) { unless (defined $r-> and $r-> eq and $r-> eq 'file') { $r = null; } } }__; @Method: @@Name: replaceVariable @@enDesc: Replaces a variable. \ {NOTE:: For objects of type , , and , the result is undefined. \ } @@Param: @@@Name: originalVariable @@@Type: lang:Perl::ManakaiDOM:all @@@enDesc: Original variable specification, including prefix. \ {NOTE:: Qualified name variable and hash key is not supported. \ } @@Param: @@@Name: newValue @@@Type: DOMMain:any::ManakaiDOM:all @@@enDesc: New value to replace. @@@InCase: @@@@Type: PerlCode @@@@enDesc: New Perl code fragment to replace by. @@@InCase: @@@@Type: lang:Perl::ManakaiDOM:all @@@@enDesc: Inline Perl code fragment string to replace by. @@Return: @@@PerlDef: my $ln = $self->; if ($ln eq 'unparsed' or $ln eq 'inlineUnparsed') { my $new_var = ref $newValue ? $newValue->stringify : ''.$newValue; my $val = $self->; $val =~ s/\Q$originalVariable\E\b/$new_var/g; $self-> ($val); } elsif ($ln eq 'stringLiteral' or $ln eq 'atom' or $ln eq 'tokens') { # } elsif ($self->) { __DEEP{ my @child_nodes = @{$self->}; for my $child_node (@child_nodes) { if (defined $child_node-> and $child_node-> eq ) { if ($child_node-> eq 'variable') { if (substr ($originalVariable, 0, 1) eq $child_node-> and not defined $child_node-> and substr ($originalVariable, 1) eq $child_node-> and not defined $child_node->) { if (ref $newValue) { $self-> ($child_node => $newValue); } else { ## ISSUE: Is this correct? $child_node-> ($newValue); } } } else { ## Non-variable child $child_node-> ($originalVariable => $newValue); } } else { # } } }__; } # has child @ResourceDef: @@ForCheck: ManakaiDOM|ForClass @@QName: addNameListAttr @@rdf:type: DISPerl|BlockCode @@PerlDef: my %__mn = map {$_ => true} split /\s+/, $node-> (, $attrName); $__mn{$newName} = true; $node-> (, 'pc:'.$attrName => join ' ', keys %__mn); @Method: @@Name: addUsePerlModuleName @@enDesc: Adds a Perl module into the list of Perl modules d by this code fragment. @@Param: @@@Name: moduleName @@@Type: DOMString @@@enDesc: The name of the module package that should be d. @@Return: @@@PerlDef: __DEEP{ __CODE{addNameListAttr:: $node => {$self}, $attrName => 'useModuleName', $newName => {$moduleName}, }__; }__; @Method: @@Name: addUseCharClassName @@enDesc: Adds a Perl module into the list of Perl character classes d by this code fragment. @@Param: @@@Name: moduleName @@@Type: DOMString @@@enDesc: The name of the module package that should be d. @@Param: @@@Name: charClassName @@@Type: DOMString @@@enDesc: The name of the character class. @@Return: @@@PerlDef: __DEEP{ __CODE{addNameListAttr:: $node => {$self}, $attrName => 'useCharClassName', $newName => {$moduleName.'.'.$charClassName}, }__; }__; @Method: @@Name: addRequirePerlModuleName @@enDesc: Adds a Perl module into the list of Perl modules d by this code fragment. @@Param: @@@Name: moduleName @@@Type: DOMString @@@enDesc: The name of the module package that should be d. @@Return: @@@PerlDef: __DEEP{ __CODE{addNameListAttr:: $node => {$self}, $attrName => 'requireModuleName', $newName => {$moduleName}, }__; }__; @Method: @@Name: addExceptionInterfacePackageName @@enDesc: Adds a Perl exception interface into the list of Perl packages. @@Param: @@@Name: moduleName @@@Type: DOMString @@@enDesc: The name of the interface package. @@Return: @@@PerlDef: __DEEP{ __CODE{addNameListAttr:: $node => {$self}, $attrName => 'exceptionInterfaceName', $newName => {$moduleName}, }__; }__; @ResourceDef: @@ForCheck: ManakaiDOM|ForClass @@QName: getNameListAttrR @@rdf:type: DISPerl|BlockCode @@PerlDef: my @__nodes = ($node); my %__result; while (@__nodes) { my $__cnode = shift @__nodes; if ($__cnode-> == and defined $__cnode-> and $__cnode-> eq ) { for (split /\s+/, $__cnode-> (, $attrName)) { $__result{$_} = true; } push @__nodes, @{$__cnode->}; } } $result = [sort {$a cmp $b} keys %__result]; @ResourceDef: @@ForCheck: ManakaiDOM|ForClass @@QName: getNameListAttr @@rdf:type: DISPerl|BlockCode @@PerlDef: my %__result; for (split /\s+/, $node-> (, $attrName)) { $__result{$_} = true; } $result = [sort {$a cmp $b} keys %__result]; @Method: @@Name: getUsePerlModuleNameList @@enDesc: Returns a list of Perl modules names that is d by this code fragment, including all descendant nodes. @@Return: @@@Type: DISPerl|ARRAY||ManakaiDOM|all @@@enDesc: A list of module names. Note that the list is ; any modification to it does not affect to the code fragment and vice versa. @@@PerlDef: __DEEP{ __CODE{getNameListAttrR:: $node => {$self}, $attrName => 'useModuleName', $result => {$r}, }__; }__; @Method: @@Name: getUseCharClassNameList @@enDesc: Returns a list of Perl character class names that is d by this code fragment, including all descendant nodes. @@Return: @@@Type: DISPerl|HASH||ManakaiDOM|all @@@enDesc: A list of module names. Note that the list is ; any modification to it does not affect to the code fragment and vice versa. @@@PerlDef: my $mc; __DEEP{ __CODE{getNameListAttrR:: $node => {$self}, $attrName => 'useCharClassName', $result => {$mc}, }__; }__; for (@$mc) { my ($m, $c) = split /\./, $_, 2; $r->{$m}->{$c} = true; } @Method: @@Name: getRequirePerlModuleNameList @@enDesc: Returns a list of Perl modules names that is d by this code fragment, including all descendant nodes. @@Return: @@@Type: DISPerl|ARRAY||ManakaiDOM|all @@@enDesc: A list of module names. Note that the list is ; any modification to it does not affect to the code fragment and vice versa. @@@PerlDef: __DEEP{ __CODE{getNameListAttrR:: $node => {$self}, $attrName => 'requireModuleName', $result => {$r}, }__; }__; @Method: @@Name: getExceptionInterfacePackageNameList @@enDesc: Returns a list of Perl exception interface package names by this code fragment, including all descendant nodes. @@Return: @@@Type: DISPerl|ARRAY||ManakaiDOM|all @@@enDesc: A list of package names. Note that the list is ; any modification to it does not affect to the code fragment and vice versa. @@@PerlDef: __DEEP{ __CODE{getNameListAttrR:: $node => {$self}, $attrName => 'exceptionInterfaceName', $result => {$r}, }__; }__; @Method: @@Name: disAddRequireURI @@enDesc: Adds a resource into the list of d resources of this code fragment. @@Param: @@@Name: uriArg @@@Type: DOMString @@@enDesc: The URI reference of the resource to add. @@Return: @@@PerlDef: __DEEP{ __CODE{addNameListAttr:: $node => {$self}, $attrName => 'requireResourceURI', $newName => {$uriArg}, }__; }__; @Method: @@Name: disGetRequireURIList @@enDesc: Returns a list of resource URI references that is d by this code fragment, including all descendant nodes. @@Return: @@@Type: DISPerl|ARRAY||ManakaiDOM|all @@@enDesc: A list of resource URI references. Note that the list is ; any modification to it does not affect to the code fragment and vice versa. @@@PerlDef: __DEEP{ __CODE{getNameListAttrR:: $node => {$self}, $attrName => 'requireResourceURI', $result => {$r}, }__; }__; @Method: @@ForCheck: ManakaiDOM|ForClass @@Operator: DISPerl|CloneMethod @@Return: @@@Type: PerlCode @@@PerlDef: __DEEP{ $r = $self-> (true); }__; ##PerlCode PropDef: @QName: useModuleName @enDesc: The list of modules. PropDef: @QName: pc|exceptionInterfaceName @enDesc: The list of exception interface packages. PropDef: @QName: useCharClassName @enDesc: The list of modules. PropDef: @QName: requireResourceURI @enDesc: The list of resources. ElementTypeBinding: @Name: ETQName @ElementType: dis:AppName @ShadowContent: @@ForCheck: s|ForML @@ContentType: DISCore|QName IFClsETDef: @IFQName: PerlFile @CQName: ManakaiPCFile @ETQName: pc|file @QName: @@@: pc|file @@ForCheck: s|ForML @IFISA: PerlCode @IFISA: PerlCodeStatements @CISA: ManakaiPCCodeStatements @enDesc: Perl source code files. @Method: @@Name: appendNewPackage @@enDesc: Appends a new package scope block. @@Param: @@@Name: packageName @@@Type: DOMString @@@enDesc: The fully-qualified name of the package to create. @@Return: @@@Type: PerlPackage @@@enDesc: The newly created package scope object. @@@PerlDef: __DEEP{ $r = $self->-> (, 'package'); $r-> ($packageName); $self-> ($r); }__; @Method: @@Name: appendPackage @@enDesc: Appends a Perl package scope object. @@Param: @@@Name: codeArg @@@Type: PerlPackage @@@enDesc: The package to append. @@Return: @@@RaiseException: @@@@@:IN_USE_NODE_ERR @@@@enDesc: An attempt is made to set a subroutine that is already used elsewhere. @@@PerlDef: if ($codeArg->) { __EXCEPTION{IN_USE_NODE_ERR:: pc:childNode => {$codeArg}, MDOMX:param-name => 'codeArg', }__; } __DEEP{ $self->-> ($codeArg); $self-> ($codeArg); }__; @Method: @@Name: getLastPackage @@enDesc: Gets the last package scope block of a name. @@Param: @@@Name: packageName @@@@Type: DOMString @@@@enDesc: The fully-qualified name of the package to get. @@NamedParam: @@@Name: makeNewPackage @@@Type: idl|boolean||ManakaiDOM|all @@@enDesc: Whether a new package scope object should be created if no package of found. @@@TrueCase: @@@@enDesc: Makes a new object if not found. @@@FalseCase: @@@@enDesc: Don't make a new object. @@Return: @@@Type: PerlPackage @@@enDesc: The last package scope object whose name is equal to . @@@nullCase: @@@@enDesc: There is no package object and the parameter is set to . @@@PerlDef: __DEEP{ for my $child (@{$self->}) { if ($child-> == and defined $child-> and $child-> eq and $child-> eq 'package') { if ($child-> (, 'packageName') eq $packageName) { $r = $child; } } } if (not $r and $makeNewPackage) { $r = $self-> ($packageName); } }__; @ATTR: @@Name: sourceFile @@ATTRQName: pc|sourceFile @@enDesc: The file name of the source file from which this Perl code is primary generated. @@ReflectCDATA: @@Get: @@Set: @ATTR: @@Name: sourceModule @@ATTRQName: pc|sourceModule @@enDesc: The name URI reference of the source module that this package defines. @@ReflectCDATA: @@Get: @@Set: @ATTR: @@Name: sourceFor @@ATTRQName: pc|sourceFor @@enDesc: The URI reference of the source module for which this package is. @@ReflectCDATA: @@Get: @@Set: @ToStringMethod: @@Return: @@@Type: DOMString @@@enDesc: The Perl code generated. @@@PerlDef: __DEEP{ ## -- Header $r = qq<#!/usr/bin/perl \n>; $r .= (q); $r .= (q< at >. (time).q<,>); $r .= (q< from file ">.$self->.q<",>); $r .= (q[ module <].$self->.q[>,]); $r .= (q[ for <].$self->.q[>.]); $r .= (q); $r .= qq; $self-> ('main'); $self-> (0); ## -- Requires my $req = $self->; for my $pack (sort {$a cmp $b} @$req) { $r .= qq; } ## -- Packages and global objects my $pack = {}; for my $child (@{$self->}) { $r .= $child->stringify; if ($child-> == and defined $child-> and $child-> eq and $child-> eq 'package') { for my $ipack (@{$child->}) { $pack->{$ipack} ||= true; # not defined } $pack->{$child->} = []; # defined } } ## -- Exception interface packages for (sort {$a cmp $b} @{$self->}) { next if ref $pack->{$_}; $pack->{$_} = []; $r .= sprintf q. q, $_, $_, "\n"; } ## -- Enables interface packages my @packs = map {'$' . $_ . '::'} sort {$a cmp $b} grep {not ref $pack->{$_} and $pack->{$_}} keys %$pack; $r .= q. join (', ', @packs) . qq<){}\n> if @packs; ## -- Footer $r .= (q[License: <].$self->.qq[>\n]); $r .= qq<1;\n>; }__; @Attr: @@Name: currentPackage @@enDesc: The current Perl package (used in stringify method). {NOTE:: This attribute is not preserved by the operation. } @@Type: DOMString @@Get: @@@disDef: @@@@GetProp: currentPackage @@Set: @@@disDef: @@@@SetProp: currentPackage @Attr: @@Name: currentChunkNumber @@enDesc: The current code chunk number (used in stringify method). {NOTE:: This attribute is not preserved by the operation. } @@Type: idl|unsignedLong||ManakaiDOM|all @@Get: @@@disDef: @@@@GetProp: currentChunk @@Set: @@@disDef: @@@@SetProp: currentChunk @Method: @@Name: getNextChunkNumber @@enDesc: Increments the current chunk number of this file and returns it. @@Return: @@@Type: idl|unsignedLong||ManakaiDOM|all @@@enDesc: The next chunk number. @@@PerlDef: $r = ++$self->{}->{}; @ATTR: @@Name: licenseURI @@ATTRQName: pc|license @@enDesc: The license term URI reference for this code. @@ReflectCDATA: @@Get: @@Set: ##PerlFile PropDef: @QName: pc|currentChunk @enDesc: The current chunk number. PropDef: @QName: pc|currentPackage @enDesc: The current package fully qualified name. ElementTypeBinding: @Name: ReflectCDATA @ElementType: dis:Type @ShadowContent: @@@: DOMString @ShadowSibling: @@actualType: CDATADOMString ResourceDef: @QName: DOMString @For: ManakaiDOM|Perl @AliasFor: DOMMain|DOMString||ManakaiDOM|ManakaiDOMLatest ReflectTypeDef: @QName: CDATADOMString @enDesc: for DOM attributes reflecting element attributes. @rdfs:subClassOf: DOMString @ResourceDef: @@rdf:type: DOMMain|ReflectGet @@enDesc: The DOM attribute returns the current value of the element attribute in a transparent, case-sensitive manner. \ If the element attribute is absent, the default value, if any, or an empty string is returned. @@PerlCDef: my $attr_stem; __CODE{DOMCore:selectAttrNodeObjectNS:: $namespaceURI => $NS_URI_NO_NULL, $localName => $LOCAL_NAME, $r => $attr_stem, }__; if ($attr_stem) { my $attr; __CODE{ManakaiNode:getWeakReference||ManakaiDOM:Perl:: $object => $attr_stem, $ref => $attr, $class => {}, }__; __CODE{DOMCore:getNodeTextContent:: $node => $attr, $result => $r, }__; } # else : default : empty string @ResourceDef: @@QName: CDATADOMStringSet @@rdf:type: DOMMain|ReflectSet @@enDesc: The corresponding element attribute is set to the given value, in a transparent, case-sensitive manner. @@ImplNote: @@@lang:en @@@@: What will happen if the value is given? @@PerlCDef: if (defined $given) { my $prefix; __CODE{DOMCore:setAttrValueNS:: $namespaceURI => $NS_URI_NO_NULL, $localName => $LOCAL_NAME, $prefix => $prefix, $element => $self, $value => $given, }__; } else { __DEEP{ $self-> ($NS_URI_NO_NULL, $LOCAL_NAME); }__; } ElementTypeBinding: @Name: ReflectTypeDef @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: DISLang|DataType @@ForCheck: !ManakaiDOM|IDL @@For: ManakaiDOM|DOM ElementTypeBinding: @Name: ATTR @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: @@@@: s|Attribute @@@ForCheck: s|ForML @@rdf:type: @@@@: DISLang|Attribute @@@ForCheck: ManakaiDOM|ForClass @@rdf:type: @@@@: DISLang|Attribute @@@ForCheck: ManakaiDOM|ForIF @@DocAttr: @@@@: ||+||s|ForML @@@ContentType: DISCore|TFPQNames @@@ForCheck: ManakaiDOM|ForClass @@DocAttr: @@@@: ||+||s|ForML @@@ContentType: DISCore|TFPQNames @@@ForCheck: ManakaiDOM|ForIF @@ForCheck: !=ManakaiDOM|ManakaiDOM ElementTypeBinding: @Name: ATTRQName @ElementType: dis:AppName @ShadowContent: @@ForCheck: s|ForML @@ContentType: DISCore|QName IFClsETDef: @IFQName: PerlPackage @CQName: ManakaiPCPackage @ETQName: pc|package @IFISA: PerlCode @IFISA: PerlCodeStatements @CISA: ManakaiPCCodeStatements @enDesc: A Perl lexical lines for which a declaration in effect. @ATTR: @@Name: packageName @@ATTRQName: pc|packageName @@ReflectCDATA: @@enDesc: The fully-qualified package name. @@Get: @@Set: @Method: @@Name: getSub @@enDesc: Gets a subroutine. @@Param: @@@Name: subName @@@Type: DOMString @@@enDesc: The name of subroutine to get. @@NamedParam: @@@Name: makeNewNode @@@Type: idl|boolean||ManakaiDOM|all @@@enDesc: Whether a new subroutine object should be created, if it is not exist, or not. @@Return: @@@Type: PerlSub @@@enDesc: The subroutine object. @@@nullCase: @@@@enDesc: Either the specified subroutine is not found and the parameter is set to or the subroutine is defined as an alias. @@@PerlDef: __DEEP{ F: { for my $child (@{$self->}) { if ($child-> == and defined $child-> and $child-> eq and $child-> eq 'sub') { if ($child-> ($subName)) { $r = $child; last F; } } } if ($makeNewNode) { $r = $self-> -> (, 'sub'); $r-> ($subName); $self-> ($r); } } # F }__; @Method: @@Name: setSubNode @@enDesc: Sets a subrotine. @@Param: @@@Name: subArg @@@Type: PerlSub @@@enDesc: The subroutine object. @@Return: @@@RaiseException: @@@@@:IN_USE_NODE_ERR @@@@enDesc: An attempt is made to set a subroutine that is already used elsewhere. @@@PerlDef: __DEEP{ if ($subArg->) { __UNDEEP{__EXCEPTION{IN_USE_NODE_ERR:: pc:childNode => {$subArg}, }__}__; } $self->-> ($subArg); $self-> ($subArg); }__; @Method: @@Name: getOverloadSub @@enDesc: Gets an overloading subroutine. @@Param: @@@Name: opName @@@Type: DISLang:String::ManakaiDOM:all @@@enDesc: The name of the overloaded operator. @@NamedParam: @@@Name: makeNewNode @@@Type: DOMMain:boolean::ManakaiDOM:all @@@enDesc: Whether a new subroutine object should be created, if it is not exist, or not. @@Return: @@@Type: PerlSub @@@enDesc: The subroutine object. @@@nullCase: @@@@enDesc: Either the specified subroutine is not found and the parameter is set to or the specified operator is overloaded by specifying method name. @@@UnknownOperatorException: @@@PerlDef: unless (->{$opName}) { __EXCEPTION{UNSUPPORTED_OPERATOR_ERR:: pc:operator => {$opName}, MDOMX:param-name => 'opName', }__; } __DEEP{ F: { for my $child (@{$self->}) { if ($child-> == and defined $child-> and $child-> eq and $child-> eq 'sub') { if ($child-> ($opName)) { $r = $child; last F; } } } if ($makeNewNode) { $r = $self-> -> (, 'sub'); $r-> ($opName); $self-> ($r); } } # F }__; @Method: @@Name: addISAPackage @@enDesc: Adds a class package that this class inherits. @@Param: @@@Name: packageName @@@Type: DOMString @@@enDesc: The name of package to add. @@Return: @@@PerlDef: __DEEP{ $self-> (, 'pc:extends' => join ' ', (split /\s+/, $self-> (, 'extends')), $packageName); }__; @Method: @@Name: getISAPackageNameList @@enDesc: Returns a list of names of packages extended by the package. @@Return: @@@Type: DISPerl|ARRAY||ManakaiDOM|all @@@enDesc: An ordered snapshot list of superpackage names. @@@PerlDef: __DEEP{ $r = [split /\s+/, $self-> (, 'extends')]; }__; @Method: @@Name: addImplementPackage @@enDesc: Adds a interface package that this class implements. @@Param: @@@Name: packageName @@@Type: DOMString @@@enDesc: The name of package to add. @@Return: @@@PerlDef: __DEEP{ __CODE{addNameListAttr:: $node => {$self}, $attrName => 'implements', $newName => {$packageName}, }__; }__; @Method: @@Name: getImplementPackageNameList @@enDesc: Returns a list of names of packages implemented by the package. @@Return: @@@Type: DISPerl|ARRAY||ManakaiDOM|all @@@enDesc: An unordered snapshot list of interface packages. @@@PerlDef: __DEEP{ __CODE{getNameListAttr:: $node => {$self}, $attrName => 'implements', $result => {$r}, }__; }__; @ToStringMethod: @@Return: @@@Type: DOMString @@@enDesc: Perl code. @@@PerlDef: __DEEP{ my $file = $self->; ## Package name my $pn = $self->; $r .= q . $pn . ";\n"; $file-> ($pn) if $file; ## Package version $r .= 'our $VERSION = '. (time). ";\n"; ## Inheritance my @isa = (@{$self->}, sort {$a cmp $b} @{$self->}); if (@isa) { $r .= 'push our @ISA, ' . (\@isa) . ";\n"; } ## Use'ing modules for my $pack (sort {$a cmp $b} @{$self->}) { $r .= 'use ' . $pack . ";\n"; } my $cls = $self->; for my $pack (sort {$a cmp $b} keys %$cls) { $r .= 'use ' . $pack . ' ' . ([sort {$a cmp $b} grep {$cls->{$pack}->{$_}} keys %{$cls->{$pack}}]) . ";\n"; } ## Package-scope objects my $has_bool; my $op = ''; for my $child (@{$self->}) { if ($child-> == and defined $child-> and $child-> eq ) { my $ln = $child->; if ($ln eq 'sub') { my $names = $child->; my $ops = $child->; if (@$names) { $r .= $child->stringify; if (@$names > 1) { $r .= sprintf q<*%s = \&%s;%s>, $_, $names->[0], "\n" for @$names[1..$#$names]; } for (@$ops) { $op .= sprintf q['%s' => '%s', %s], $_ => $names->[0], "\n"; $has_bool = true if $_ eq 'bool'; } } else { my $v = $child->stringify; for (@$ops) { $op .= sprintf q['%s' => %s, %s], $_ => $v, "\n"; $has_bool = true if $_ eq 'bool'; } } } else { $r .= $child->stringify; } } # pc:* } # children if (length $op) { $r .= "use overload \n"; $r .= "bool => sub () {1}, \n" unless $has_bool; $r .= $op . "fallback => 1;\n"; } ## -- Exports my $xport = $self->; if (map {values %$_} values %$xport) { $r .= q[our %EXPORT_TAG = (] . ([map {$_ => [sort {$a cmp $b} keys %{$xport->{$_}}]} sort {$a cmp $b} grep {length} keys %$xport]) . qq[);\n]; $r .= q[our @EXPORT_OK = (] . ([map {sort {$a cmp $b} keys %{$xport->{$_}}} sort {$a cmp $b} keys %$xport]) . qq[);\n]; $r .= q[use Exporter; push our @ISA, 'Exporter';] . qq[\n]; } }__; @Method: @@Name: getExportList @@enDesc: Returns a list of export tag and names. @@Return: @@@Type: DISPerl|HASH||ManakaiDOM|all @@@enDesc: Snapshot list of lists. @@@PerlDef: my $mc; __DEEP{ __CODE{getNameListAttr:: $node => {$self}, $attrName => 'export', $result => {$mc}, }__; }__; for (@$mc) { my ($m, $c) = split /\./, $_, 2; $r->{$m}->{$c} = true; } @Method: @@Name: addExport @@enDesc: Adds a name to the list of exported items (). @@Param: @@@Name: exportTag @@@Type: DOMString @@@enDesc: The name of the tag (without prefix). The is added both to and }>. @@@nullCase: @@@@enDesc: The is added only to the . @@Param: @@@Name: exportName @@@Type: DOMString @@@enDesc: The name to be exported. @@Return: @@@PerlDef: __DEEP{ __CODE{addNameListAttr:: $node => {$self}, $attrName => 'export', $newName => {$exportTag.'.'.$exportName}, }__; }__; ##PCPackage ElementTypeBinding: @Name: UnknownOperatorException @ElementType: ManakaiDOM:raises @ShadowContent: @@@:UNSUPPORTED_OPERATOR_ERR @@enDesc: An attempt is made to overload an unknown operator. XParamDef: @QName: pc:operator @enDesc: An operator to overload. ResourceDef: @For: ManakaiDOM|Perl @QName: operatorNameList @enDesc: The list of valid operators for pragma. @rdf:type: DISPerl|InlineCode @PerlCDef: {qw[ + 1 - 1 * 1 / 1 % 1 ** 1 << 1 >> 1 x 1 . 1 += 1 -= 1 *= 1 /= 1 %= 1 **= 1 <<= 1 >>= 1 x= 1 .= 1 < 1 <= 1 > 1 >= 1 == 1 != 1 <=> 1 lt 1 le 1 gt 1 ge 1 eq 1 ne 1 cmp 1 & 1 | 1 ^ 1 neg 1 ! 1 ~ 1 ++ 1 -- 1 = 1 atan2 1 cos 1 sin 1 exp 1 abs 1 log 1 sqrt 1 bool 1 "" 1 0+ 1 ${} 1 @{} 1 %{} 1 &{} 1 *{} 1 <> 1 nomethod 1 ]} IFClsETDef: @IFQName: PerlCodeStatements @CQName: ManakaiPCCodeStatements @ETQName: @@@: pc|statementContainer @@ImplNote: @@@lang:en @@@@: Dummy. @IFISA: PerlCodeUnits @CISA: ManakaiPCCodeUnits @enDesc: A base class for node types that contains zero or more statements and/or blocks. @ATTR: @@Name: sourceFile @@ATTRQName: pc|sourceFile @@enDesc: The source file name of this fragment. @@ReflectCDATA: @@Get: @@@enDesc: Any string identifying the source. @@@nullCase: @@@@enDesc: No source file name is set. @@Set: @@@nullCase: @@@@enDesc: No (or unknown) source file. @ATTR: @@Name: sourceLine @@ATTRQName: pc|sourceLine @@enDesc: Source file line number of the first line of this fragment. @@ReflectCDATA: @@Get: @@Set: @ATTR: @@Name: currentSourceFile @@ATTRQName: pc|currentSourceFile @@enDesc: The current source file name that is referred when a code fragment is added. @@ReflectCDATA: @@Get: @@@nullCase: @@@@enDesc: No source file name is set. @@Set: @@@nullCase: @@@@enDesc: No (or unknown) source file. @ATTR: @@Name: currentSourceLine @@ATTRQName: pc|currentSourceLine @@enDesc: The current line number in source file that is referred when a code fragment is added. @@ReflectCDATA: @@Get: @@Set: @Method: @@Name: appendCodeFragment @@enDesc: Appends a object. @@Param: @@@Name: codeArg @@@Type: PerlCode @@@enDesc: A code fragment object. @@Return: @@@RaiseException: @@@@@:BAD_CHILD_ERR @@@@enDesc: An attempt is made to append a child that is not a . @@@RaiseException: @@@@@:IN_USE_NODE_ERR @@@@enDesc: An attempt is made to append a node that is already used elsewhere. @@@PerlDef: if ({ unparsed => 1, if => 1, statement => 1, block => 1, choose => true, blockContainer => true, inlineUnparsed => 1, variable => 1, tokens => 1, atom => 1, inlineContainer => 1, stringLiteral => 1, assignment => 1, list => true, arrayRefLiteral => true, hashRefLiteral => true, }->{$codeArg->}) { if ($codeArg->) { __EXCEPTION{IN_USE_NODE_ERR:: pc:childNode => {$codeArg}, MDOMX:param-name => 'codeArg', }__; } __DEEP{ $self-> -> ($codeArg); $self-> ($codeArg); }__; } else { __EXCEPTION{BAD_CHILD_ERR:: pc:parentNode => {$self}, pc:childNode => {$codeArg}, MDOMX:param-name => 'codeArg', }__; } @Method: @@Name: appendCode @@enDesc: Appends an unparsed Perl code fragment. @@Param: @@@Name: codeArg @@@Type: DOMString @@@enDesc: An unparsed Perl code fragment. @@Return: @@@Type: PerlUnparsedCode @@@enDesc: The newly created Perl code object. @@@PerlDef: __DEEP{ $r = $self->-> (, 'unparsed'); $r-> ($codeArg); $r-> ($self->); my $sl = $self->; $r-> ($sl); $self-> ($sl + ($codeArg =~ tr/\x0A/\x0A/)); $self-> ($r); }__; @Method: @@Name: skipLines @@enDesc: Skips lines in a code. @@Param: @@@Name: codeArg @@@Type: DOMString @@@enDesc: A code fragment, which is counted lines. @@Return: @@@PerlDef: $self->{}->{} += ($codeArg =~ tr/\x0A/\x0A/); @ATTR: @@Name: label @@ATTRQName: pc|label @@enDesc: Label for this block. @@ReflectCDATA: @@Get: @@@nullCase: @@@@enDesc: No label. @@Set: @@@nullCase: @@@@enDesc: No label. @Method: @@Name: appendBlock @@enDesc: Appends a Perl block code. @@Return: @@@Type: PerlBlock @@@enDesc: The newly created Perl code object. @@@PerlDef: __DEEP{ $r = $self->-> (, 'block'); $self-> ($r); }__; @Method: @@Name: appendStatement @@enDesc: Appends a Perl statement. @@Param: @@@Name: codeArg @@@Type: DOMString @@@enDesc: A Perl statement without terminating . @@@nullCase: @@@@enDesc: No initial content. @@Return: @@@Type: PerlStatement @@@enDesc: The newly created Perl code object. @@@PerlDef: __DEEP{ $r = $self->-> (, 'statement'); if (defined $codeArg) { $r-> ($codeArg); } $self-> ($r); }__; @Method: @@Name: appendNewPCBlock @@enDesc: Creates a and appends it to the node. @@Return: @@@Type: PCBlock @@@enDesc: The newly created block element. @@@PerlDef: __DEEP{ $r = $self->->; $self-> ($r); }__; @Method: @@Name: appendNewPCChoose @@enDesc: Creates a and appends it to the node. @@Return: @@@Type: PCChoose @@@enDesc: The newly created choose element. @@@PerlDef: __DEEP{ $r = $self->->; $self-> ($r); }__; @Method: @@Name: appendNewPCWhile @@enDesc: Creates a and appends it to the node. @@Return: @@@Type: PCWhile @@@enDesc: The newly created while element. @@@PerlDef: __DEEP{ $r = $self->->; $self-> ($r); }__; @Method: @@Name: appendNewIf @@enDesc: Appends a newly created object. @@Param: @@@Name: conditionArg @@@Type: PerlCode @@@enDesc: Conditoon code fragment object. @@Param: @@@Name: trueArg @@@Type: PerlCode @@@enDesc: A true code fragment object. @@@nullCase: @@@@enDesc: No true code. @@Param: @@@Name: falseArg @@@Type: PerlCode @@@enDesc: A false code fragment object. @@@nullCase: @@@@enDesc: No false code. @@Return: @@@Type: PerlIf @@@enDesc: The newly created element. @@@RaiseException: @@@@@:BAD_CHILD_ERR @@@@enDesc: An attempt is made to append a child that is not valid type. @@@RaiseException: @@@@@:IN_USE_NODE_ERR @@@@enDesc: An attempt is made to append a node that is already used elsewhere. @@@PerlDef: for my $arg ([conditionArg => $conditionArg]) { if ({ atom => 1, tokens => 1, inlineContainer => 1, assignment => true, inlineUnparsed => 1, variable => 1, stringLiteral => true, list => true, arrayRefLiteral => true, hashRefLiteral => true, }->{$arg->[1]->}) { if ($arg->[1]->) { __EXCEPTION{IN_USE_NODE_ERR:: pc:childNode => {$arg->[1]}, MDOMX:param-name => {$arg->[0]}, }__; } } else { __EXCEPTION{BAD_CHILD_ERR:: pc:parentNode => {$self}, pc:childNode => {$arg->[1]}, MDOMX:param-name => {$arg->[0]}, }__; } } # c for my $arg ([trueArg => $trueArg], [falseArg => $falseArg]) { next unless $arg->[1]; if ({ blockContainer => true, }->{$arg->[1]->}) { if ($arg->[1]->) { __EXCEPTION{IN_USE_NODE_ERR:: pc:childNode => {$arg->[1]}, MDOMX:param-name => {$arg->[0]}, }__; } } else { __EXCEPTION{BAD_CHILD_ERR:: pc:parentNode => {$self}, pc:childNode => {$arg->[1]}, MDOMX:param-name => {$arg->[0]}, }__; } } # t/f __DEEP{ $r = $self->-> (, 'if'); $r-> ($conditionArg); $r-> ($trueArg) if $trueArg; $r-> ($falseArg) if $falseArg; $self-> ($r); }__; ##PCIf IFClsETDef: @IFQName: PerlSub @CQName: ManakaiPCSub @ETQName: pc|sub @IFISA: PerlCode @IFISA: PerlCodeStatements @CISA: ManakaiPCCodeStatements @enDesc: Perl subroutines. @Attr: @@Name: pcLocalName @@enDesc: The name of this subroutine. @@Type: DOMString @@Get: @@@nullCase: @@@@enDesc: This subroutine has no name. @@@PerlDef: __DEEP{ $r = $self->->[0]; }__; @Method: @@Name: addPerlName @@enDesc: Adds a subroutine name. @@Param: @@@Name: subName @@@Type: DOMString @@@enDesc: The name to add. @@Return: @@@PerlDef: __DEEP{ __CODE{addNameListAttr:: $node => {$self}, $attrName => 'localName', $newName => {$subName}, }__; }__; @Method: @@Name: getPerlNameList @@enDesc: Returns a list of names of the subroutine. @@Return: @@@Type: DISPerl|ARRAY||ManakaiDOM|all @@@enDesc: An unordered snapshot list of names. @@@PerlDef: __DEEP{ __CODE{getNameListAttr:: $node => {$self}, $attrName => 'localName', $result => {$r}, }__; }__; @Method: @@Name: hasPerlName @@enDesc: Returns whether the subroutine has a name or not. @@Param: @@@Name: subName @@@Type: DOMString @@@enDesc: The name. @@Return: @@@Type: idl|boolean||ManakaiDOM|all @@@PerlDef: __DEEP{ my $l; __CODE{getNameListAttr:: $node => {$self}, $attrName => 'localName', $result => {$l}, }__; F: for (@$l) { if ($_ eq $subName) { $r = true; last F; } } }__; @Method: @@Name: clearPerlName @@enDesc: Removes all Perl name associated to the . @@Return: @@@PerlDef: __DEEP{ $self-> (, 'localName'); }__; @Method: @@Name: addPerlOperator @@enDesc: Adds an operator overloaded by the method. @@Param: @@@Name: op @@@Type: DOMString @@@enDesc: The operator to add. @@Return: @@@PerlDef: __DEEP{ __CODE{addNameListAttr:: $node => {$self}, $attrName => 'operator', $newName => {$op}, }__; }__; @Method: @@Name: getPerlOperatorList @@enDesc: Returns a list of operators of the subroutine. @@Return: @@@Type: DISPerl|ARRAY||ManakaiDOM|all @@@enDesc: An unordered snapshot list of operators. @@@PerlDef: __DEEP{ __CODE{getNameListAttr:: $node => {$self}, $attrName => 'operator', $result => {$r}, }__; }__; @Method: @@Name: hasPerlOperator @@enDesc: Returns whether the subroutine has an operator or not. @@Param: @@@Name: op @@@Type: DOMString @@@enDesc: The operator. @@Return: @@@Type: idl|boolean||ManakaiDOM|all @@@PerlDef: __DEEP{ my $l; __CODE{getNameListAttr:: $node => {$self}, $attrName => 'operator', $result => {$l}, }__; F: for (@$l) { if ($_ eq $op) { $r = true; last F; } } }__; @ATTR: @@Name: prototype @@ATTRQName: pc|prototype @@enDesc: The prototype of this subroutine. @@ReflectCDATA: @@Get: @@@nullCase: @@@@enDesc: No prototype is set. @@Set: @@@nullCase: @@@@enDesc: No prototype declaration. @@Test: @@@ForCheck: ManakaiDOM|ForClass @@@enDesc: Getting value after setting empty value must return an empty string. @@@PerlDef: my $impl = ->_new; my $sub = $impl-> ("sub_name"); $test->assert_not_null ($sub); $sub-> (''); $test->assert_string (actual_value => $sub->, expected_value => ''); $test->assert_true ($sub->stringify =~ /^sub sub_name \(\)/); @ToStringMethod: @@Return: @@@Type: DOMString @@@enDesc: Perl code. @@@PerlDef: __DEEP{ $r = q; my $nm = $self->; $r .= q< > . $nm->[0] if @$nm; if ($self-> (, 'prototype')) { $r .= q< (> . $self-> . q<)>; } $r .= qq< {\n>; for my $child (@{$self->}) { $r .= $child->stringify; } $r .= qq<}\n>; }__; @NumValMethod: @@Return: @@@Type: idl|unsignedLong||ManakaiDOM|all @@@PerlDef: __DEEP{ $r = 0 + $self->; }__; ##PerlSub ElementTypeBinding: @Name: Test @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: test|StandaloneTest XParamDef: @QName: parentNode @enDesc: Parent node. XParamDef: @QName: childNode @enDesc: Child node. IFClsETDef: @IFQName: PerlUnparsedCode @CQName: ManakaiPCUnparsedCode @ETQName: pc|unparsed @IFISA: PerlCode @CISA: ManakaiPCCode @enDesc: Unparsed Perl code fragments. @ATTR: @@Name: sourceFile @@ATTRQName: pc|sourceFile @@enDesc: The source file name of this fragment. @@ReflectCDATA: @@Get: @@@enDesc: Any string identifying the source. @@@nullCase: @@@@enDesc: No source file name is set. @@Set: @@@nullCase: @@@@enDesc: No (or unknown) source file. @ATTR: @@Name: sourceLine @@ATTRQName: pc|sourceLine @@enDesc: Source file line number of the first line of this fragment. @@ReflectCDATA: @@Get: @@Set: @ToStringMethod: @@Return: @@@Type: DOMString @@@enDesc: Perl code. @@@PerlDef: __DEEP{ $r = "\x0A" . $self-> . "\x0A"; my $file = $self->; my $src_file = $file ? $file-> : $self->{}->{}; if ($self-> -> -> ()) { my $nxt_cnum = $file ? $file-> : 0; $r = sprintf qq<\n#line %d "%s [u] (Chunk #%d)"%s>. qq<#line 1 "%s [/u] (Chunk #%d)"\n>, $self-> || 1, $self-> || $src_file, $file ? $file-> : 0, $r, $src_file, $file ? $file-> : 0; } }__; ##PerlUnparsedCode IFClsETDef: @IFQName: PerlInlineUnparsedCode @CQName: ManakaiPCInlineUnparsedCode @ETQName: pc|inlineUnparsed @IFISA: PerlCode @CISA: ManakaiPCCode @enDesc: Unparsed Perl inline code fragments. @ToStringMethod: @@Return: @@@Type: DOMString @@@enDesc: Perl code. @@@disDef: @@@@DISPerl:cloneCode: DOMCore|ManakaiDOMNode.textContent.get ##PCInlineUnparsedCode IFClsETDef: @IFQName: PCNumberLiteral @CQName: ManakaiPCNumberLiteral @ETQName: pc|numberLiteral @IFISA: PerlCode @CISA: ManakaiPCCode @enDesc: A object represents a Perl number literal. The of a object is a Perl source code representation of the number for the object. @ToStringMethod: @@Return: @@@Type: DOMString @@@PerlDef: __DEEP{ $r = $self->; }__; ##PCNumberLiteral IFClsETDef: @IFQName: PerlStringLiteral @CQName: ManakaiPCPerlStringLiteral @ETQName: pc|stringLiteral @IFISA: PerlCode @CISA: ManakaiPCCode @enDesc: Perl string literal. @NumValMethod: @@Return: @@@Type: idl|unsignedLong||ManakaiDOM|all @@@enDesc: Numeric value of the Perl code. @@@PerlDef: __DEEP{ $r = 0 + $self->; }__; @ToStringMethod: @@Return: @@@Type: DOMString @@@enDesc: Perl code. @@@PerlDef: __DEEP{ $r = $self->; $r =~ s/(['\\])/\\$1/g; $r = q<'> . $r . q<'>; }__; ##PerlStringLiteral IFClsETDef: @IFQName: PCList @CQName: ManakaiPCList @ETQName: pc|list @IFISA: PerlCode @CISA: ManakaiPCCode @enDesc: A is a Perl list, i.e. separated list of values. @Method: @@Name: item @@enDesc: Returns the th item in the list. @@Param: @@@Name: index @@@Type: unsignedLong @@@enDesc: The ordinal index of the item. @@Return: @@@Type: PerlCodeInlines @@@enDesc: The th item in the list. @@@nullCase: @@@@enDesc: Either is negative or the is greater than the number of the items in the list. @@@PerlDef: __DEEP{ $r = $self->-> ($index); }__; @Attr: @@Name: length @@enDesc: The number of items in the list. @@Type: unsignedLong @@Get: @@@PerlDef: __DEEP{ $r = $self->->; }__; @ToStringMethod: @@Return: @@@Type: DOMString @@@enDesc: Perl code. @@@PerlDef: __DEEP{ my @r = map {$_->stringify} @{$self->}; $r = '(' . join (', ', @r) . ')'; }__; ##PCList IFClsETDef: @IFQName: PCArrayRefLiteral @CQName: ManakaiPCArrayRefLiteral @ETQName: pc|arrayRefLiteral @IFISA: PerlCode @CISA: ManakaiPCCode @enDesc: A is a Perl array reference literal. @Method: @@Name: item @@enDesc: Returns the th item in the list. @@Param: @@@Name: index @@@Type: unsignedLong @@@enDesc: The ordinal index of the item. @@Return: @@@Type: PerlCodeInlines @@@enDesc: The th item in the list. @@@nullCase: @@@@enDesc: Either is negative or the is greater than the number of the items in the list. @@@PerlDef: __DEEP{ $r = $self->-> ($index); }__; @Attr: @@Name: length @@enDesc: The number of items in the list. @@Type: unsignedLong @@Get: @@@PerlDef: __DEEP{ $r = $self->->; }__; @ToStringMethod: @@Return: @@@Type: DOMString @@@enDesc: Perl code. @@@PerlDef: __DEEP{ my @r = map {$_->stringify} @{$self->}; $r = '[' . join (', ', @r) . ']'; }__; ##PCArrayRefLiteral IFClsETDef: @IFQName: PCHashRefLiteral @CQName: ManakaiPCHashRefLiteral @ETQName: pc|hashRefLiteral @IFISA: PerlCode @CISA: ManakaiPCCode @enDesc: A is a Perl hash reference literal. @Method: @@Name: key @@enDesc: Returns the th key in the list. {NOTE:: Although the order of key-value pairs is preserved in the object, it is not preserved in Perl source codes and in Perl language. } @@Param: @@@Name: index @@@Type: unsignedLong @@@enDesc: The ordinal index of the key. @@Return: @@@Type: PerlCodeInlines @@@enDesc: The th key in the list. @@@nullCase: @@@@enDesc: Either is negative or the is greater than the number of the keys in the list. @@@PerlDef: __DEEP{ $r = $self->-> ($index * 2); }__; @Method: @@Name: value @@enDesc: Returns the th value in the list. {NOTE:: Although the order of key-value pairs is preserved in the object, it is not preserved in Perl source codes and in Perl language. } @@Param: @@@Name: index @@@Type: unsignedLong @@@enDesc: The ordinal index of the value. @@Return: @@@Type: PerlCodeInlines @@@enDesc: The th value in the list. @@@nullCase: @@@@enDesc: Either is negative or the is greater than the number of the values in the list. {NOTE:: - 1>th value might not be found. } @@@PerlDef: __DEEP{ $r = $self->-> ($index * 2 + 1); }__; @Attr: @@Name: length @@enDesc: The number of key-value pairs in the list. @@Type: unsignedLong @@Get: @@@PerlDef: __DEEP{ my $length = $self->->; $r = int ($length / 2) + ($length % 2); }__; @Method: @@Name: setNamedItem @@enDesc: Set a named item. @@Param: @@@Name: key @@@Type: DOMString @@@enDesc: The key. @@Param: @@@Name: value @@@Type: PerlCodeInlines @@@enDesc: The value. @@Return: @@@PerlDef: __DEEP{ my @children = @{$self->}; R: { while (@children) { my $ckey = shift @children; my $cval = shift @children; if ($ckey-> eq $key) { $self-> ($value, $cval); last R; } } $self-> ($self-> -> (, 'stringLiteral')) -> ($key); $self-> ($value); } # R }__; @ToStringMethod: @@Return: @@@Type: DOMString @@@enDesc: Perl code. @@@PerlDef: __DEEP{ my %r = map {$_->stringify} @{$self->}; ## Different values with same key are not preserved. $r = '{' . join (', ', map {$_ => $r{$_}} sort {$a cmp $b} keys %r) . '}'; }__; ##PCHashRefLiteral ResourceDef: @QName: unsignedLong @AliasFor: idl|unsignedLong||ManakaiDOM|all @For: ManakaiDOM|DOM IFClsETDef: @IFQName: PerlTokens @CQName: ManakaiPCTokens @ETQName: pc|tokens @IFISA: PerlCode @CISA: ManakaiPCCode @enDesc: Unparsed Perl inline code fragments. @ToStringMethod: @@Return: @@@Type: DOMString @@@PerlDef: __DEEP{ $r = $self->; }__; ##PCTokens IFClsETDef: @IFQName: PerlAtom @CQName: ManakaiPCAtom @ETQName: pc|atom @IFISA: PerlCode @CISA: ManakaiPCTokens @enDesc: Unparsed Perl atomic code fragments (such as numeric literal). @NumValMethod: @@Return: @@@Type: idl|unsignedLong||ManakaiDOM|all @@@enDesc: Numeric value of the Perl code. @@@PerlDef: __DEEP{ $r = 0 + $self->; }__; @ToStringMethod: @@Return: @@@Type: DOMString @@@enDesc: Perl code. @@@PerlDef: __DEEP{ $r = $self->; }__; ##PerlAtom IFClsETDef: @IFQName: PerlVariable @CQName: ManakaiPCVariable @ETQName: pc|variable @IFISA: PerlCode @CISA: ManakaiPCCode @enDesc: Unparsed Perl variable. \ {NOTE:: Future version of the implementation may support to specify array index or hash key. \ } @ATTR: @@Name: variableType @@ATTRQName: pc|variableType @@enDesc: Perl variable type (, , , or empty string). @@ReflectCDATA: @@Get: @@Set: @ATTR: @@Name: packageName @@ATTRQName: pc|packageName @@enDesc: The name of the package to which this variable belongs. @@ReflectCDATA: @@Get: @@@nullCase: @@@@enDesc: This package belongs to the current package or does not belong to any package. @@Set: @@@nullCase: @@@@enDesc: This package belongs to the current package or does not belong to any package. @ATTR: @@Name: pcLocalName @@ATTRQName: pc|localName @@enDesc: The local variable name. @@ReflectCDATA: @@Get: @@Set: @ATTR: @@Name: variableScope @@ATTRQName: pc|variableScope @@enDesc: Scope modifier ( or or ). @@ReflectCDATA: @@Get: @@@nullCase: @@@@enDesc: This variable does not have scope modifier. @@Set: @@@nullCase: @@@@enDesc: This variable does not have scope modifier. @ToStringMethod: @@Return: @@@Type: DOMString @@@enDesc: Perl code. @@@PerlDef: __DEEP{ my $t = $self->; $r .= $t . ' ' if length $t; $r .= $self->; my $v = $self->; $r .= $v . '::' if length $v; $r .= $self->; $v = $self->; if ($t eq '$' and length $v) { $v =~ s/(['\\])/\\$1/g; $r .= q<{'> . $v . q<'}>; } }__; @ATTR: @@Name: hashKey @@ATTRQName: pc|hashKey @@enDesc: The key for hash. \ {NOTE:: Using Perl code for key is not supported in the current version of the implementation. \ } @@ReflectCDATA: @@Get: @@@nullCase: @@@@enDesc: This variable is not for hash value access. @@Set: @@@nullCase: @@@@enDesc: This variable is not for hash value access. ##PerlVariable IFClsDef: @IFQName: PerlCodeUnits @CQName: ManakaiPCCodeUnits @CISA: ManakaiPCCode @enDesc: A base class implemented by both inline container and block-level container. @Attr: @@Name: length @@enDesc: The number of child code fragments. @@Type: idl|unsignedLong||ManakaiDOM|all @@Get: @@@PerlDef: __DEEP{ $r = @{$self->}; }__; @Method: @@Name: appendStringLiteral @@enDesc: Appends a Perl string literal (). @@Param: @@@Name: stringArg @@@Type: DOMString @@@enDesc: A string. @@Return: @@@Type: PerlStringLiteral @@@enDesc: The newly created Perl string literal object. @@@PerlDef: __DEEP{ $r = $self->-> (, 'stringLiteral'); $r-> ($stringArg); $self-> ($r); }__; @Method: @@Name: appendNewPCLiteral @@enDesc: Creates a object and appends it to the node. @@Param: @@@Name: value @@@Type: DISPerl|Any @@@enDesc: The value. @@Return: @@@Type: PerlCode @@@enDesc: The newly created object. @@@PerlDef: __DEEP{ $r = $self-> -> ($value); $self-> ($r); }__; @Method: @@Name: appendNewPCNumberLiteral @@enDesc: Creates a object and appends it to the node. @@Param: @@@Name: value @@@Type: DISPerl|NumberValue @@@enDesc: The value. @@Return: @@@Type: PCNumberLiteral @@@enDesc: The newly created node. @@@PerlDef: __DEEP{ $r = $self-> -> ($value); $self-> ($r); }__; @Method: @@Name: appendAtom @@enDesc: Appends a Perl atomic code fragment. @@Param: @@@Name: codeArg @@@Type: DOMString @@@enDesc: An atom. @@Return: @@@Type: PerlAtom @@@enDesc: The newly created Perl code object. @@@PerlDef: __DEEP{ $r = $self->-> (, 'atom'); $r-> ($codeArg); $self-> ($r); }__; @Method: @@Name: appendBare @@enDesc: Appends a Perl bare code fragment. @@Param: @@@Name: codeArg @@@Type: DOMString @@@enDesc: An bare code. @@Return: @@@Type: PerlBare @@@enDesc: The newly created Perl code object. @@@PerlDef: __DEEP{ $r = $self->-> (, 'tokens'); $r-> ($codeArg); $self-> ($r); }__; @Method: @@Name: appendNewPCVariable @@enDesc: Creates a variable object and appends it to the children list of the node. @@Param: @@@Name: variableTypeArg @@@Type: DOMString @@@enDesc: The variable type prefix such as , if any, or an empty string. @@Param: @@@Name: packageNameArg @@@Type: DOMString @@@enDesc: The name of the package to which the variable belongs. @@@nullCase: @@@@enDesc: The variable does not belong to any package or belongs to the current package. @@Param: @@@Name: localNameArg @@@Type: DOMString @@@enDesc: The local part of the variable name. @@Return: @@@Type: PerlVariable @@@enDesc: The newly created variable object. @@@PerlDef: __DEEP{ $r = $self-> -> ($variableTypeArg, $packageNameArg, $localNameArg); $self-> ($r); }__; @Method: @@Name: appendNewPCDereference @@enDesc: Creates a object and appends it to the child node list of the node. @@Param: @@@Name: variableTypeArg @@@Type: DOMString @@@enDesc: The type of the referenced value, such as . @@Return: @@@Type: PCDereference @@@enDesc: The newly created element node. @@@PerlDef: __DEEP{ $r = $self-> -> ($variableTypeArg); $self-> ($r); }__; @Method: @@Name: appendNewPCExpression @@enDesc: Appends a newly created node. @@Param: @@@Name: operatorArg @@@Type: DOMString @@@enDesc: The operator of the expression. @@Return: @@@Type: PCExpression @@@enDesc: The newly created expression object. @@@PerlDef: __DEEP{ $r = $self-> -> ($operatorArg); $self-> ($r); }__; @Method: @@Name: appendNewAssignment @@enDesc: Appends a newly created object. @@Param: @@@Name: leftArg @@@Type: PerlCode @@@enDesc: A left hand side code fragment object. @@Param: @@@Name: rightArg @@@Type: PerlCode @@@enDesc: A right hand side code fragment object. @@Return: @@@Type: PerlAssignment @@@RaiseException: @@@@@:BAD_CHILD_ERR @@@@enDesc: An attempt is made to append a child that is not valid type. @@@RaiseException: @@@@@:IN_USE_NODE_ERR @@@@enDesc: An attempt is made to append a node that is already used elsewhere. @@@PerlDef: for my $arg ([leftArg => $leftArg], [rightArg => $rightArg]) { if ({ atom => 1, tokens => 1, inlineContainer => 1, assignment => true, inlineUnparsed => 1, variable => 1, stringLiteral => true, list => true, arrayRefLiteral => true, hashRefLiteral => true, }->{$arg->[1]->}) { if ($arg->[1]->) { __EXCEPTION{IN_USE_NODE_ERR:: pc:childNode => {$arg->[1]}, MDOMX:param-name => {$arg->[0]}, }__; } } else { __EXCEPTION{BAD_CHILD_ERR:: pc:parentNode => {$self}, pc:childNode => {$arg->[1]}, MDOMX:param-name => {$arg->[0]}, }__; } } # left/right __DEEP{ $r = $self->-> (, 'assignment'); $r-> ($leftArg); $r-> ($rightArg); $self-> ($r); }__; @Method: @@Name: appendNewPCApply @@enDesc: Creates a object and appends it to the children list of the node. @@Return: @@@Type: PCApply @@@enDesc: The newly created node. @@@PerlDef: __DEEP{ $r = $self->->; $self-> ($r); }__; @Method: @@Name: appendNewPCFunctionCall @@enDesc: Appends a newly created node. @@Param: @@@Name: packageArg @@@Type: DOMString @@@enDesc: The package name of the function. @@@nullCase: @@@@enDesc: No package name. @@Param: @@@Name: localNameArg @@@Type: DOMString @@@enDesc: The local part of the function name. @@Return: @@@Type: PCFunctionCall @@@enDesc: The newly created functin call object. @@@PerlDef: __DEEP{ $r = $self-> -> ($packageArg, $localNameArg); $self-> ($r); }__; ##PCCodeUnits IFClsETDef: @IFQName: PerlStatement @CQName: ManakaiPCStatement @ETQName: pc|statement @IFISA: PerlCode @IFISA: PerlCodeInlines @CISA: ManakaiPCCodeInlines @enDesc: Perl statements. @ToStringMethod: @@Return: @@@Type: DOMString @@@enDesc: Perl code. @@@PerlDef: $r = $self->SUPER::stringify; $r .= ";\n" if length $r; ##PerlStatement IFClsETDef: @IFQName: PerlCodeInlines @CQName: ManakaiPCCodeInlines @ETQName: pc|inlineContainer @CISA: ManakaiPCCodeUnits @enDesc: Perl inline code block. @Method: @@Name: appendCodeFragment @@enDesc: Appends a object. @@Param: @@@Name: codeArg @@@Type: PerlCode @@@enDesc: A code fragment object. @@Return: @@@RaiseException: @@@@@:BAD_CHILD_ERR @@@@enDesc: An attempt is made to append a child that is not a . @@@RaiseException: @@@@@:IN_USE_NODE_ERR @@@@enDesc: An attempt is made to append a node that is already used elsewhere. @@@PerlDef: if ({ atom => 1, tokens => 1, inlineContainer => 1, assignment => true, inlineUnparsed => 1, variable => 1, stringLiteral => true, list => true, arrayRefLiteral => true, hashRefLiteral => true, }->{$codeArg->}) { if ($codeArg->) { __EXCEPTION{IN_USE_NODE_ERR:: pc:childNode => {$codeArg}, }__; } __DEEP{ $self-> -> ($codeArg); $self-> ($codeArg); }__; } else { __EXCEPTION{BAD_CHILD_ERR:: pc:parentNode => {$self}, pc:childNode => {$codeArg}, }__; } @Method: @@Name: appendCode @@enDesc: Appends an unparsed Perl code fragment. @@Param: @@@Name: codeArg @@@Type: DOMString @@@enDesc: An unparsed Perl code fragment. @@Return: @@@Type: PerlInlineUnparsedCode @@@enDesc: The newly created Perl code object. @@@PerlDef: __DEEP{ $r = $self->-> (, 'inlineUnparsed'); $r-> ($codeArg); $self-> ($r); }__; @ToStringMethod: @@Return: @@@Type: DOMString @@@enDesc: Perl code. @@@PerlDef: __DEEP{ my @child = @{$self->}; for my $child (@child) { if ($child-> eq and $child-> eq 'inlineContainer' and 1 == @child) { $r .= '(' . $child->stringify . ')'; } else { $r .= $child->stringify; } } }__; ##PCCodeInlines IFClsETDef: @IFQName: PerlBlock @CQName: ManakaiPerlBlock @ETQName: pc|block @IFISA: PerlCode @IFISA: PerlCodeStatements @CISA: ManakaiPCCodeStatements @enDesc: Perl block-level code block. @ToStringMethod: @@Return: @@@Type: DOMString @@@enDesc: Perl code. @@@PerlDef: __DEEP{ my @child = @{$self->}; my $label = $self->; if (not $label and @child == 1 and $child[0]-> eq 'block') { $r = "\x0A" . $child[0]->stringify . "\x0A"; } elsif (not $label and @child == 1 and $child[0]-> eq 'unparsed' and $child[0]-> =~ /^\s*$/) { # } else { $r = "\x0A"; for my $child (@child) { if ($child-> eq 'inlineContainer' and 1 == @child) { $r .= '(' . $child->stringify . ')'; } else { $r .= $child->stringify; } } $r .= "\x0A"; if ($self-> -> -> ()) { my $file = $self->; my $sfile = $file ? $file-> : $self->{}->{}; $r = sprintf qq<\n{\n#line %d "%s [b] (Chunk #%d)"%s>. qq<#line 1 "%s [/b] (Chunk #%d)"\n;}\n>, $self-> || 1, $self-> || $sfile, $file ? $file-> : 0, $r, $sfile, $file ? $file-> : 0 if 2 < length $r; } else { $r = "\n{\n$r\n;}\n" if 2 < length $r; } $r = "\n" . $label . ':' . $r if $label; } }__; ##PerlBlock IFClsETDef: @IFQName: PerlCodeBlocks @CQName: ManakaiPCCodeBlocks @ETQName: pc|blockContainer @IFISA: PerlCodeStatements @CISA: ManakaiPCCodeStatements @enDesc: Perl block-level code container whose content may or may not semantically be self-contained. @ToStringMethod: @@Return: @@@Type: DOMString @@@enDesc: Perl code. @@@PerlDef: my @child = @{$self->}; if (@child == 1 and { block => true, blockContainer => true, }->{$child[0]->}) { $r = $child[0]->stringify; } else { for my $child (@child) { if ($child-> eq 'inlineContainer' and 1 == @child) { $r .= '(' . $child->stringify . ')'; } else { $r .= $child->stringify; } } __DEEP{ if ($self-> -> -> ()) { my $file = $self->; my $sfile = $file ? $file-> : $self->{}->{}; $r = sprintf qq<\n#line %d "%s [bc] (Chunk #%d)"\n%s>. qq<\n#line 1 "%s [/bc] (Chunk #%d)"\n>, $self-> || 1, $self-> || $sfile, $file ? $file-> : 0, $r, $sfile, $file ? $file-> : 0; } }__; } ##PCCodeBlocks IFClsETDef: @IFQName: PCDereference @CQName: ManakaiPCDereference @ETQName: pc|dereference @IFISA: PerlCode @IFISA: PerlCodeInlines @CISA: ManakaiPCCodeInlines @enDesc: A object represents a dereference. @ATTR: @@Name: variableType @@ATTRQName: pc|variableType @@enDesc: The type of the value, such as . @@ReflectCDATA: @@Get: @@Set: @ToStringMethod: @@Return: @@@Type: DOMString @@@PerlDef: __DEEP{ $r = $self-> . '{'; A: for my $child (@{$self->}) { next A unless $child-> == ; $r .= $child; } $r .= '}'; }__; ##PCDereference IFClsETDef: @IFQName: PCApply @CQName: ManakaiPCApply @ETQName: pc|apply @IFISA: PerlCode @IFISA: PerlCodeInlines @CISA: ManakaiPCCodeInlines @enDesc: A object represents a function call. The first child element must be an expression results in a function name (such as bare function or operator name represented as a object or an with operator > whose last operand is a method name. The second child element, if any, is an expression intended to be an argument for the function. It is possible to specify more than one arguments by with operator . The third child element, if any, is an expression that is put into the indirect object slot. @Attr: @@Name: function @@enDesc: The function child element of the element. @@Type: PerlCode @@Get: @@@nullCase: @@@@enDesc: There is no child element. @@@PerlDef: __DEEP{ A: for my $child (@{$self->}) { next A unless $child-> == ; $r = $child; last A; } }__; @Attr: @@Name: argument @@enDesc: The argument child element of the element. @@Type: PerlCode @@Get: @@@nullCase: @@@@enDesc: There is no argument element. @@@PerlDef: __DEEP{ my $x; A: for my $child (@{$self->}) { next A unless $child-> == ; if ($x) { $r = $child; last A; } else { $x = true; } } }__; @Attr: @@Name: indirect @@enDesc: The indirect object slot child element of the element. @@Type: PerlCode @@Get: @@@nullCase: @@@@enDesc: There is no indirect object element. @@@PerlDef: __DEEP{ my $x = 0; A: for my $child (@{$self->}) { next A unless $child-> == ; if ($x++ == 2) { $r = $child; last A; } } }__; @ToStringMethod: @@Return: @@@Type: DOMString @@@PerlDef: __DEEP{ my $f; my $arg; my $obj; no warnings 'uninitialized'; A: for my $child (@{$self->}) { next A unless $child-> == ; if (not defined $f) { $f = ''.$child; } elsif (not defined $arg) { $arg = ''.$child; } else { $obj = ''.$child; last A; } } $r = $f; $r .= ' ' . $obj if defined $obj; if ({ 'die' => true, 'last' => true, 'next' => true, 'redo' => true, 'return' => true, 'warn' => true, }->{$r}) { $r .= ' ' . $arg; } else { $r .= ' (' . $arg . ')'; } }__; ##PCApply IFClsETDef: @IFQName: PCExpression @CQName: ManakaiPCExpression @ETQName: pc|expression @IFISA: PerlCode @IFISA: PerlCodeInlines @CISA: ManakaiPCCodeInlines @enDesc: A object represents a sequence of one or more expression fragments (operands) separated by the same operator. @ATTR: @@Name: operator @@ATTRQName: pc|operator @@enDesc: The operator. @@ReflectCDATA: @@Get: @@Set: @Attr: @@Name: operandNumber @@enDesc: The number of operands. @@Type: idl|unsignedLong||ManakaiDOM|all @@Get: @@@PerlDef: __DEEP{ $r = @{$self->}; }__; @ToStringMethod: @@Return: @@@Type: DOMString @@@PerlDef: __DEEP{ my @r; no warnings 'uninitialized'; A: for my $child (@{$self->}) { next A unless $child-> == ; my $xuri = $child-> . $child->; push @r, [$child.'', $child, $xuri]; } if (@r > 1) { my $op = $self->; for (@r) { if ($_->[2] ne and not { => true, => true, => true, => true, => true, => true, => true, => true, => true, }->{$_->[2]}) { $_ = '(' . $_->[0] . ')'; } elsif ($_->[2] eq and (not { '**' => {'->' => true}, '=~' => {'->' => true}, '!~' => {'->' => true}, '*' => {'->' => true, '*' => true}, '/' => {'->' => true}, '%' => {'->' => true}, 'x' => {'->' => true}, '+' => {'->' => true, '*' => true, '+' => true, '-' => true}, '-' => {'->' => true, '*' => true}, '.' => {'->' => true}, '<' => {'->' => true}, '>' => {'->' => true}, '<=' => {'->' => true}, '>=' => {'->' => true}, 'lt' => {'->' => true}, 'gt' => {'->' => true}, 'le' => {'->' => true}, 'gr' => {'->' => true}, '==' => {'->' => true}, '!=' => {'->' => true}, '<=>' => {'->' => true}, 'eq' => {'->' => true}, 'ne' => {'->' => true}, 'cmp' => {'->' => true}, '&&' => {'->' => true, '&&' => true}, '||' => {'->' => true, '||' => true}, '..' => {'->' => true}, '=' => {'->' => true}, ',' => {'->' => true, ',' => true, '=>' => true}, '=>' => {'->' => true, ',' => true, '=>' => true}, 'and' => {'->' => true, 'and' => true}, 'or' => {'->' => true, 'or' => true}, }->{$op}->{$_->[1]->}) and $_->[1]-> > 1) { $_ = '(' . $_->[0] . ')'; } else { $_ = $_->[0]; } } $op = ' '.$op unless { ',' => true, '->' => true, '..' => true, '...' => true, }->{$op}; $op = $op.' ' unless { '->' => true, '..' => true, '...' => true, }->{$op}; $r = join $op, @r; } elsif (@r) { $r = $r[0]->[0]; } else { $r = 'undef'; } }__; ##PCExpression IFClsETDef: @IFQName: PerlAssignment @CQName: ManakaiPCAssignment @ETQName: pc|assignment @IFISA: PerlCode @CISA: ManakaiPCCode @enDesc: Perl variable assignment. @ToStringMethod: @@Return: @@@Type: DOMString @@@enDesc: Perl code. @@@PerlDef: __DEEP{ $r = $self->->stringify . ' = ' . $self->->stringify; }__; @Attr: @@Name: leftCode @@enDesc: Left-hand expression. @@Type: PerlCodeInlines @@Get: @@@nullCase: @@@@enDesc: Left-hand code not yet specified. @@@PerlDef: __DEEP{ F: for my $child (@{$self->}) { if ($child-> eq and $child-> eq 'left') { $r = $child->; last F; } } }__; @@Set: @@@PerlDef: __DEEP{ $self->-> ($given); F: { for my $child (@{$self->}) { if ($child-> eq and $child-> eq 'left') { $child-> (''); $child-> ($given); last F; } } my $node = $self-> -> (, 'left'); $node-> ($given); $self-> ($node); } }__; @Attr: @@Name: rightCode @@enDesc: Right-hand expression. @@Type: PerlCodeInlines @@Get: @@@nullCase: @@@@enDesc: Right-hand code not yet specified. @@@PerlDef: __DEEP{ F: for my $child (@{$self->}) { if ($child-> eq and $child-> eq 'right') { $r = $child->; last F; } } }__; @@Set: @@@PerlDef: __DEEP{ $self->-> ($given); F: { for my $child (@{$self->}) { if ($child-> eq and $child-> eq 'right') { $child-> (''); $child-> ($given); last F; } } my $node = $self-> -> (, 'right'); $node-> ($given); $self-> ($node); } }__; ##PerlAssignment IFClsETDef: @IFQName: PCCondition @CQName: ManakaiPCCondition @ETQName: pc2|condition @IFISA: PerlCode @IFISA: PerlCodeInlines @CISA: ManakaiPCCodeInlines @enDesc: A object represents a condition expression part of an or statement. @ToStringMethod: @@Return: @@@Type: DOMString @@@PerlDef: __DEEP{ A: for my $child (@{$self->}) { next A unless $child-> == ; $r .= $child; } }__; ##PCCondition IFClsETDef: @IFQName: PCBlock @CQName: ManakaiPCBlock @ETQName: pc2|block @IFISA: PerlCode @IFISA: PerlCodeStatements @CISA: ManakaiPCCodeStatements @enDesc: A object represents a Perl code block, i.e. a set of statements enclosed by and pair. @ToStringMethod: @@Return: @@@Type: DOMString @@@PerlDef: __DEEP{ my @child = @{$self->}; my $label = $self->; $r = "\x0A"; for my $child (@child) { if ($child-> eq 'inlineContainer' and 1 == @child) { $r .= '(' . $child->stringify . ')'; } else { $r .= $child->stringify; } } $r .= "\x0A"; $r .= ';' unless @child; if ($self-> -> -> ()) { my $file = $self->; my $sfile = $file ? $file-> : $self->{}->{}; $r = sprintf qq<\n{\n#line %d "%s [b] (Chunk #%d)"%s>. qq<#line 1 "%s [/b] (Chunk #%d)"\n}\n>, $self-> || 1, $self-> || $sfile, $file ? $file-> : 0, $r, $sfile, $file ? $file-> : 0; } else { $r = "\n{\n$r\n}\n"; } $r = "\n" . $label . ':' . $r . '# ' . $label . "\n" if length $label; }__; ##PCBlock IFClsETDef: @IFQName: PCWhile @CQName: ManakaiPCWhile @ETQName: pc|while @IFISA: PerlCode @CISA: ManakaiPCCode @enDesc: A object represents a statement. It can contain two child elements: and , each represents the condition expression and the block of the statement. @ATTR: @@Name: label @@ATTRQName: pc|label @@enDesc: Label for this block. @@ReflectCDATA: @@Get: @@@nullCase: @@@@enDesc: No label. @@Set: @@@nullCase: @@@@enDesc: No label. @Attr: @@Name: condition @@enDesc: The condition object. @@Type: PCCondition @@Get: @@@nullCase: @@@@enDesc: There is no condition element. @@@PerlDef: __CODE{getChildElementByType:: $namespaceURI => {}, $localName => {'condition'}, $parent => $self, $result => $r, }__; @Attr: @@Name: block @@enDesc: The code block that is executed while the met. @@Type: PCBlock @@Get: @@@nullCase: @@@@enDesc: There is no child element. @@@PerlDef: __CODE{getChildElementByType:: $namespaceURI => {}, $localName => {'block'}, $parent => $self, $result => $r, }__; @ToStringMethod: @@Return: @@@Type: DOMString @@@PerlDef: __DEEP{ $r = 'while ('; my $cond = $self->; if ($cond) { $r .= $cond->stringify; } else { $r .= '0'; } $r .= ') '; my $block = $self->; if ($block) { $r .= $block->stringify; } else { $r .= "{ }\n"; } my $label = $self->; $r = "\n" . $label . ': ' . $r . ' # ' . $label . "\n" if length $label; }__; ##PCWhile IFClsETDef: @IFQName: PCChoose @CQName: ManakaiPCChoose @ETQName: pc|choose @IFISA: PerlCode @CISA: ManakaiPCCode @enDesc: A object, or a element, represents a set of , , and statements. @Method: @@Name: getWhen @@enDesc: Returns a by its ordinal index. @@Param: @@@Name: index @@@Type: idl|unsignedLong||ManakaiDOM|all @@@enDesc: The ordinal index of the element. @@Return: @@@Type: PCWhen @@@enDesc: The th object. @@@nullCase: @@@@enDesc: There is no th element. @@@PerlDef: __DEEP{ my $i = 0; no warnings 'uninitialized'; A: for my $child (@{$self->}) { if ($child-> == and $child-> eq and $child-> eq 'when' and ++$i == $index) { $r = $child; last A; } } }__; @Method: @@Name: appendNewPCWhen @@enDesc: Appends a new element. @@Return: @@@Type: PCWhen @@@enDesc: The newly created element. @@@PerlDef: __DEEP{ my $od = $self->; $r = $od-> (, 'when'); my $cond = $od-> (, 'condition'); $r-> ($cond); my $block = $od-> (, 'block'); $r-> ($block); $self-> ($r, $self->); }__; @Attr: @@Name: otherwise @@enDesc: Returns the by its ordinal index. @@Type: PCOtherwise @@Get: @@@enDesc: The object. @@@nullCase: @@@@enDesc: There is no element. @@@PerlDef: __CODE{getChildElementByType:: $namespaceURI => {}, $localName => {'otherwise'}, $parent => $self, $result => $r, }__; @Method: @@Name: appendNewPCOtherwise @@enDesc: Appends a new element. If there is already the element, then no element is created and the element is returned. @@Return: @@@Type: PCOtherwise @@@enDesc: The element. @@@PerlDef: __DEEP{ $r = $self->; unless ($r) { my $od = $self->; $r = $od-> (, 'otherwise'); my $block = $od-> (, 'block'); $r-> ($block); $self-> ($r); } }__; @ToStringMethod: @@Return: @@@Type: DOMString @@@PerlDef: __DEEP{ S: for my $child (@{$self->}) { next S unless $child-> == ; next S unless $child-> eq ; my $ln = $child->; if ($ln eq 'when') { $r .= 'els' if length $r; $r .= $child->stringify; } elsif ($ln eq 'otherwise') { $r .= $child->stringify; last S; } } # S }__; ##PCChoose IFClsETDef: @IFQName: PCWhen @CQName: ManakaiPCWhen @ETQName: pc|when @IFISA: PerlCode @CISA: ManakaiPCCode @enDesc: A object, or a element, represents an or block. @Attr: @@Name: condition @@enDesc: The condition object. @@Type: PCCondition @@Get: @@@nullCase: @@@@enDesc: There is no condition element. @@@PerlDef: __CODE{getChildElementByType:: $namespaceURI => {}, $localName => {'condition'}, $parent => $self, $result => $r, }__; @Attr: @@Name: block @@enDesc: The code block that is executed when the met. @@Type: PCBlock @@Get: @@@nullCase: @@@@enDesc: There is no child element. @@@PerlDef: __CODE{getChildElementByType:: $namespaceURI => {}, $localName => {'block'}, $parent => $self, $result => $r, }__; @ToStringMethod: @@Return: @@@Type: DOMString @@@PerlDef: __DEEP{ $r = 'if ('; my $cond = $self->; if ($cond) { $r .= $cond->stringify; } else { $r .= '0'; } $r .= ') '; my $block = $self->; if ($block) { $r .= $block->stringify; } else { $r .= "{ }\n"; } }__; ##PCWhen IFClsETDef: @IFQName: PCOtherwise @CQName: ManakaiPCOtherwise @ETQName: pc|otherwise @IFISA: PerlCode @CISA: ManakaiPCCode @enDesc: A object, or a element, represents an clause. @Attr: @@Name: block @@enDesc: The code block that is executed. @@Type: PCBlock @@Get: @@@nullCase: @@@@enDesc: There is no child element. @@@PerlDef: __CODE{getChildElementByType:: $namespaceURI => {}, $localName => {'block'}, $parent => $self, $result => $r, }__; @ToStringMethod: @@Return: @@@Type: DOMString @@@PerlDef: __DEEP{ my $block = $self->; if ($block) { $r = 'else ' . $block->stringify; } }__; ##PCOtherwise ResourceDef: @For: ManakaiDOM|ManakaiDOM @QName: getChildElementByType @rdf:type: DISPerl|BlockCode @enDesc: Returns the first element of a type. @PerlCDef: __DEEP{ no warnings 'uninitialized'; A: for my $__child (@{$parent->}) { if ($__child-> == and $__child-> eq $namespaceURI and $__child-> eq $localName) { $result = $__child; last A; } } }__; IFClsETDef: @IFQName: PerlIf @CQName: ManakaiPCIf @ETQName: pc|if @IFISA: PerlCode @CISA: ManakaiPCCode @enDesc: Perl variable assignment. @ToStringMethod: @@Return: @@@Type: DOMString @@@enDesc: Perl code. @@@PerlDef: __DEEP{ my $tcode = $self->; my $fcode = $self->; my $ccode = $self->; if (defined $tcode) { if (defined $fcode) { $r = q . $ccode->stringify . q<) {> . $tcode->stringify . q<} else {> . $fcode->stringify . qq<}\n>; } else { $r = q . $ccode->stringify . q<) {> . $tcode->stringify . qq<}\n>; } } else { $r = q . $ccode->stringify . q<) {> . $fcode->stringify . qq<}\n>; } }__; @Attr: @@Name: condition @@enDesc: Condition expression. @@Type: PerlCodeInlines @@Get: @@@nullCase: @@@@enDesc: Condition code not yet specified. @@@PerlDef: __DEEP{ F: for my $child (@{$self->}) { if ($child-> eq and $child-> eq 'condition') { $r = $child->; last F; } } }__; @@Set: @@@PerlDef: __DEEP{ $self->-> ($given); F: { for my $child (@{$self->}) { if ($child-> eq and $child-> eq 'condition') { $child-> (''); $child-> ($given); last F; } } my $node = $self-> -> (, 'condition'); $node-> ($given); $self-> ($node); } }__; @Attr: @@Name: trueCode @@enDesc: True-case code. @@Type: PerlCodeBlocks @@Get: @@@nullCase: @@@@enDesc: True-case code not yet specified. @@@PerlDef: __DEEP{ F: for my $child (@{$self->}) { if ($child-> eq and $child-> eq 'tr'.'ue') { $r = $child->; last F; } } }__; @@Set: @@@PerlDef: __DEEP{ $self->-> ($given); F: { for my $child (@{$self->}) { if ($child-> eq and $child-> eq 'tr'.'ue') { $child-> (''); $child-> ($given); last F; } } my $node = $self-> -> (, 'tr'.'ue'); $node-> ($given); $self-> ($node); } }__; @Attr: @@Name: falseCode @@enDesc: False-case code. @@Type: PerlCodeBlocks @@Get: @@@nullCase: @@@@enDesc: True-case code not yet specified. @@@PerlDef: __DEEP{ F: for my $child (@{$self->}) { if ($child-> eq and $child-> eq 'fal'.'se') { $r = $child->; last F; } } }__; @@Set: @@@PerlDef: __DEEP{ $self->-> ($given); F: { for my $child (@{$self->}) { if ($child-> eq and $child-> eq 'fal'.'se') { $child-> (''); $child-> ($given); last F; } } my $node = $self-> -> (, 'fal'.'se'); $node-> ($given); $self-> ($node); } }__; ##PerlIf PropDef: @QName:condition @enDesc: Condition. PropDef: @QName:true @enDesc: If true. PropDef: @QName:false @enDesc: If false. PropDef: @QName:left @FullName: @@lang:en @@@: Left hand side PropDef: @QName:right @FullName: @@lang:en @@@: Right hand side PropDef: @QName:label @enDesc: Perl statement / block label. IFClsETDef: @IFQName: PCFunctionCall @CQName: ManakaiPCFunctionCall @ETQName: pc|call @IFISA: PerlCode @IFISA: PerlCodeInlines @CISA: ManakaiPCCodeInlines @enDesc: A object represents a function call or function-like statement such as . @ATTR: @@Name: variableType @@ATTRQName: pc|variableType @@enDesc: The value of the attribute be , which introduces a subroutine name. @@ReflectCDATA: @@Get: @@Set: @ATTR: @@Name: packageName @@ATTRQName: pc|packageName @@enDesc: The name of the package to which the subroutine belongs. @@ReflectCDATA: @@Get: @@@nullCase: @@@@enDesc: The object belongs to the current package or does not belong to any package. @@Set: @@@nullCase: @@@@enDesc: The object belongs to the current package or does not belong to any package. @ATTR: @@Name: pcLocalName @@ATTRQName: pc|localName @@enDesc: The local part of the subroutine name. @@ReflectCDATA: @@Get: @@Set: @ToStringMethod: @@Return: @@@Type: DOMString @@@PerlDef: __DEEP{ $r .= $self->; my $v = $self->; $r .= $v . '::' if length $v; $r .= $self->; my @arg; no warnings 'uninitialized'; A: for my $child (@{$self->}) { next A unless $child-> == ; push @arg, ''.$child; } my $arg = join ', ', @arg; if ({ 'die' => true, 'last' => true, 'next' => true, 'redo' => true, 'return' => true, 'warn' => true, }->{$r}) { $r .= ' ' . $arg; } else { $r .= ' (' . $arg . ')'; } }__; ##PCFunctionCall ElementTypeBinding: @Name: RaiseException @ElementType: dx:raises ## -- Configuration Parameters boolCParam: @QName: pc|line @nodeProp: pcline @IsSupportRequired:1 @DOMCore:targetType: DOMCore|Document @TrueCase: @@DOMCore:isSupported:1 @@enDesc: Inserts directives. @FalseCase: @@DOMCore:isSupported:1 @@IsSupportRequired:1 @@IsDefault:1 Does not insert any directive. CParam: @QName: pc|split-resolver @nodeProp: pcsres @IsSupportRequired:1 @DOMCore:targetType: DOMCore|Document @Type: DISPerl|CODE||ManakaiDOM|all @enDesc: Splits module file. The parameter value be a Perl code reference. The serializer would invoke the code with arguments: a reserved parameter, a whose serialization is being split, and a string that identifies the split part. The code is expected to return a object to which the module part is written. Note that splitting serialized module file does not affect to the tree. @nullCase: @@enDesc: Does not split module file. ElementTypeBinding: @Name: nodeProp @ElementType: DOMCore:nodeProp @ShadowContent: @@For: =ManakaiDOM|all ElementTypeBinding: @Name: CParam @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: @@@@: DOMCore|DOMConfigurationParameter @@@For: ManakaiDOM|DOM @@rdf:type: @@@@: DISCore|Property @@@For: =ManakaiDOM|all @@For: ManakaiDOM|DOM3 @@For: =ManakaiDOM|all ElementTypeBinding: @Name: boolCParam @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: @@@@: DOMCore|DOMConfigurationParameter @@@For: ManakaiDOM|DOM @@rdf:type: @@@@: DISCore|Property @@@For: =ManakaiDOM|all @@For: ManakaiDOM|DOM3 @@For: =ManakaiDOM|all @@Type: idl|boolean||ManakaiDOM|all ## -- PCDocument IFClsDef: @IFQName: PCDocument @CQName: ManakaiPCDocument @IFISA: Document @CISA: DOMCore|ManakaiDOMDocument @enDesc: A is a that represents a Perl code. @s:rootElementType: pc|file @Method: @@Name: createPCLiteral @@enDesc: Creates a literal object. {NOTE:: If a member of is a object, then it is appended to the tree as is, except when the object comes from different document than the document, in which case the object is being adopted to the document by method. If that method fails, then the result is undefined. } @@Param: @@@Name: value @@@Type: DISPerl|Any @@@enDesc: The value. @@@InCase: @@@@Type: DISPerl|StringValue @@@@enDesc: A whose value is is created. @@@InCase: @@@@Type: DISPerl|ARRAY @@@@enDesc: A is created. If has items, then objects are recursively created. @@@InCase: @@@@Type: DISPerl|HASH @@@@enDesc: A is created. If has key-value pairs, then objects are recursively created. @@Return: @@@Type: PerlCode @@@enDesc: The newly created value object. @@@PerlDef: __DEEP{ if (ref $value eq 'HASH' or ref $value eq 'ARRAY') { $r = $self-> (, ref $value eq 'HASH' ? 'hashRefLiteral' : 'arrayRefLiteral'); for my $v (ref $value eq 'HASH' ? %$value : @$value) { my $vo; if (UNIVERSAL::isa ($v, )) { $vo = $self-> ($v); } else { $vo = $self-> ($v); } $r-> ($vo); } } else { $r = $self-> (, 'stringLiteral'); $r-> ($value); } }__; @Method: @@Name: createPCNumberLiteral @@enDesc: Creates a number literal object. @@Param: @@@Name: value @@@Type: DISPerl|NumberValue @@@enDesc: The value. @@Return: @@@Type: PCNumberValue @@@enDesc: The newly created value object. @@@PerlDef: __DEEP{ $r = $self-> (, 'numberLiteral'); $r-> ($value); }__; @Method: @@Name: createPCVariable @@enDesc: Creates a new object. @@Param: @@@Name: variableType @@@Type: DOMString @@@enDesc: Variable prefix. @@@nullCase: @@@@enDesc: If the is , then the is detected by the prefix of . Otherwise, it is an unprefixed variable such as file handle. @@Param: @@@Name: packageName @@@Type: DOMString @@@enDesc: Package name. @@@nullCase: @@@@enDesc: The variable belongs to the current package or a lexical-scoped variable. @@Param: @@@Name: localName @@@Type: DOMString @@@enDesc: Variable name. If both and is , the value may be prefixed by any possible value. @@Return: @@@Type: PerlVariable @@@enDesc: Newly created Perl variable object. @@@PerlDef: __DEEP{ $r = $self-> (, 'variable'); if (not $variableType and not $packageName and $localName =~ s/^(\\?[\$\@%&*])//) { $variableType = $1; } $r-> ($variableType) if defined $variableType; $r-> ($packageName) if defined $packageName; $r-> ($localName); }__; @Method: @@Name: createPCDereference @@enDesc: Creates a object. @@Param: @@@Name: variableType @@@Type: DOMString @@@enDesc: The type of the referenced value, such as . @@Return: @@@Type: PCDereference @@@enDesc: The newly created element node. @@@PerlDef: __DEEP{ $r = $self-> (, 'dereference'); $r-> ($variableType); }__; @Method: @@Name: createPCExpression @@enDesc: Creates a element node. @@Param: @@@Name: operator @@@Type: DOMString @@@enDesc: The operator of the expression. @@Return: @@@Type: PCExpression @@@enDesc: The newly created expression object. @@@PerlDef: __DEEP{ $r = $self-> (, 'expression'); $r-> ($operator); }__; @Method: @@Name: createPCApply @@enDesc: Creates a element node. @@Return: @@@Type: PCApply @@@enDesc: The newly created element node. @@@PerlDef: __DEEP{ $r = $self-> (, 'apply'); }__; @Method: @@Name: createPCFunctionCall @@enDesc: Creates a function call element node. @@Param: @@@Name: package @@@Type: DOMString @@@enDesc: The package to which the function belongs. @@@nullCase: @@@@enDesc: No package name. @@Param: @@@Name: localName @@@Type: DOMString @@@enDesc: The local part of the function name. @@Return: @@@Type: PCApply @@@enDesc: The newly created function object. @@@PerlDef: __DEEP{ $r = $self-> (, 'apply'); my $func = $self-> ('', $package, $localName); $r-> ($func); }__; @Method: @@Name: createPCStatement @@enDesc: Creates a statement object. @@Return: @@@Type: PerlStatement @@@enDesc: The newly created statement element node. @@@PerlDef: __DEEP{ $r = $self-> (, 'statement'); }__; @Method: @@Name: createPCBlock @@enDesc: Creates a element node. @@Return: @@@Type: PCBlock @@@enDesc: The newly created element. @@@PerlDef: __DEEP{ $r = $self-> (, 'block'); }__; @Method: @@Name: createPCChoose @@enDesc: Creates a element node. @@Return: @@@Type: PCChoose @@@enDesc: The newly created element. @@@PerlDef: __DEEP{ $r = $self-> (, 'choose'); }__; @Method: @@Name: createPCWhile @@enDesc: Creates a element node. @@Return: @@@Type: PCWhile @@@enDesc: The newly created element. @@@PerlDef: __DEEP{ $r = $self-> (, 'while'); $r-> ($self-> (, 'condition')); $r-> ($self-> (, 'block')); }__; @Method: @@Name: createPerlSub @@enDesc: Creates a new object. @@Param: @@@Name: subName @@@Type: DOMString @@@enDesc: The name of the subroutine to create. @@@nullCase: @@@@enDesc: The subroutine created has no name. @@Return: @@@Type: PerlSub @@@enDesc: Newly created Perl subroutine object. @@@PerlDef: __DEEP{ $r = $self-> (, 'sub'); $r-> ($subName) if defined $subName; }__; ##PCDocument ## -- Implementation IFClsDef: @IFQName: PCImplementation @CQName: ManakaiPCImplementation @enDesc: The class that provides factory methods. @CISA: DOMCore|ManakaiDOMImplementation||ManakaiDOM|ManakaiDOMLatest @CISA: dx|ManakaiDefaultExceptionHandler||ManakaiDOM|Perl @f:provides: pc|CoreFeature10 @Method: @@Name: createPerlFile @@enDesc: Creates a Perl code file. @@Return: @@@Type: PerlFile @@@enDesc: A newly created Perl source file object. @@@PerlDef: __DEEP{ $r = $self-> (, 'file') ->; }__; @Method: @@Name: createPerlPackage @@enDesc: Creates a new package scope block. @@Param: @@@Name: packageName @@@Type: DOMString @@@enDesc: The fully-qualified name of the package to create. @@Return: @@@Type: PerlPackage @@@enDesc: The newly created package scope object. @@@PerlDef: __DEEP{ $r = $self-> (, 'file') -> (, 'package'); $r-> ($packageName); }__; @IntMethod: @@ForCheck: ManakaiDOM|ForClass @@Name: perlComment @@ManakaiDOM:isStatic:1 @@enDesc: Generates a Perl comment string. @@Param: @@@Name: str @@@Type: DOMString @@@enDesc: A comment text. @@Return: @@@Type: DOMString @@@enDesc: A Perl comment string. @@@PerlDef: $r = $str; $r =~ s/\n/\n## /g; $r =~ s/\n## $/\n/s; $r .= "\n" unless $r =~ /\n$/; $r = q<## > . $r; @IntMethod: @@ForCheck: ManakaiDOM|ForClass @@Name: rfc3339DateTime @@ManakaiDOM:isStatic:1 @@enDesc: Returns RFC 3339 representation of a date. @@Param: @@@Name: perlDate @@@Type: idl|unsignedLong||ManakaiDOM|all @@@enDesc: A Perl representation of date. @@Return: @@@Type: DOMString @@@enDesc: RFC 3339 date string. @@@PerlDef: my @time = gmtime $perlDate; $r = sprintf q<%04d-%02d-%02dT%02d:%02d:%02d+00:00>, $time[5] + 1900, $time[4] + 1, @time[3,2,1,0]; @IntMethod: @@ForCheck: ManakaiDOM|ForClass @@Name: versionDateTime @@ManakaiDOM:isStatic:1 @@enDesc: Returns date for version. @@Param: @@@Name: perlDate @@@Type: idl|unsignedLong||ManakaiDOM|all @@@enDesc: A Perl representation of date. @@Return: @@@Type: DOMString @@@enDesc: A Perl number literal. @@@PerlDef: my @time = gmtime $perlDate; $r = sprintf q<%04d%02d%02d.%02d%02d>, $time[5] + 1900, $time[4] + 1, @time[3,2,1]; @Method: @@Name: perlLiteral @@enDesc: Perl code representation. @@Param: @@@Name: val @@@Type: DISPerl|Any||ManakaiDOM|all @@@enDesc: A Perl value. @@Return: @@@Type: DOMString @@@enDesc: A Perl lexical representation of . @@@PerlDef: unless (defined $val) { $r = q; } elsif (ref $val eq 'ARRAY') { __DEEP{ $r = q<[> . ($val) . q<]>; }__; } elsif (ref $val eq 'HASH') { __DEEP{ $r = q<{> . ([map {$_ => $val->{$_}} sort {$a cmp $b} keys %$val]) . q<}>; }__; } elsif (ref $val eq 'manakai::code') { $r = $$val; } else { $val =~ s/(['\\])/\\$1/g; $r = q<'> . $val . q<'>; } @Method: @@Name: perlList @@enDesc: Perl code representation of a list. @@Param: @@@Name: val @@@Type: DISPerl|ARRAY||ManakaiDOM|all @@@enDesc: A Perl array reference. @@Return: @@@Type: DOMString @@@enDesc: A Perl lexical representation of . @@@PerlDef: __DEEP{ $r = join (q<, >, map { ($_)} @{$val}); }__; @Method: @@Name: createPerlSub @@enDesc: Creates a new object. @@Param: @@@Name: subName @@@Type: DOMString @@@enDesc: The name of the subroutine to create. @@@nullCase: @@@@enDesc: The subroutine created has no name. @@Return: @@@Type: PerlSub @@@enDesc: Newly created Perl subroutine object. @@@PerlDef: __DEEP{ $r = $self-> (, 'file') -> (, 'sub'); $r-> ($subName) if defined $subName; }__; @Method: @@Name: createPerlUnparsedCode @@enDesc: Creates a new object. @@Param: @@@Name: codeArg @@@Type: DOMString @@@enDesc: The code fragment. @@@nullCase: @@@@enDesc: The fragment initially has no code. @@Return: @@@Type: PerlUnparsedCode @@@enDesc: Newly created Perl code object. @@@PerlDef: __DEEP{ $r = $self-> (, 'file') -> (, 'unparsed'); $r-> ($codeArg) if defined $codeArg; }__; @Method: @@Name: createPerlInlineContainer @@enDesc: Creates a new object. @@Return: @@@Type: PerlCodeInlines @@@enDesc: Newly created Perl code object. @@@PerlDef: __DEEP{ $r = $self-> (, 'file') -> (, 'inlineContainer'); }__; @Method: @@Name: createPerlInlineUnparsedCode @@enDesc: Creates a new object. @@Param: @@@Name: codeArg @@@Type: DOMString @@@enDesc: The code fragment. @@@nullCase: @@@@enDesc: The fragment initially has no code. @@Return: @@@Type: PerlInlineUnparsedCode @@@enDesc: Newly created Perl code object. @@@PerlDef: __DEEP{ $r = $self-> (, 'file') -> (, 'inlineUnparsed'); $r-> ($codeArg) if defined $codeArg; }__; @Method: @@Name: createPerlBare @@enDesc: Creates a new object. @@Param: @@@Name: codeArg @@@Type: DOMString @@@enDesc: The code fragment. @@Return: @@@Type: PerlTokens @@@enDesc: Newly created Perl code object. @@@PerlDef: __DEEP{ $r = $self-> (, 'file') -> (, 'tokens'); $r-> ($codeArg) if defined $codeArg; }__; @Method: @@Name: createPerlAtom @@enDesc: Creates a new object. @@Param: @@@Name: codeArg @@@Type: DOMString @@@enDesc: The code fragment. @@Return: @@@Type: PerlAtom @@@enDesc: Newly created Perl code object. @@@PerlDef: __DEEP{ $r = $self-> (, 'file') -> (, 'atom'); $r-> ($codeArg) if defined $codeArg; }__; @Method: @@Name: createPerlStringLiteral @@enDesc: Creates a new object. @@Param: @@@Name: stringArg @@@Type: DOMString @@@enDesc: A string. @@Return: @@@Type: PerlStringLiteral @@@enDesc: Newly created Perl code object. @@@PerlDef: __DEEP{ $r = $self-> (, 'file') -> (, 'stringLiteral'); $r-> ($stringArg); }__; @Method: @@Name: createPerlVariable @@enDesc: Creates a new object. @@Param: @@@Name: variableType @@@Type: DOMString @@@enDesc: Variable prefix. @@@nullCase: @@@@enDesc: If the is , then the is detected by the prefix of . Otherwise, it is an unprefixed variable such as file handle. @@Param: @@@Name: packageName @@@Type: DOMString @@@enDesc: Package name. @@@nullCase: @@@@enDesc: The variable belongs to the current package or a lexical-scoped variable. @@Param: @@@Name: localName @@@Type: DOMString @@@enDesc: Variable name. If both and is , the value may be prefixed by any possible value. @@Return: @@@Type: PerlVariable @@@enDesc: Newly created Perl variable object. @@@PerlDef: __DEEP{ $r = $self-> (, 'file') -> (, 'variable'); if (not $variableType and not $packageName and $localName =~ s/^(\\?[\$\@%&*])//) { $variableType = $1; } $r-> ($variableType) if defined $variableType; $r-> ($packageName) if defined $packageName; $r-> ($localName); }__; @Method: @@Name: createPerlBlock @@enDesc: Creates a new object. @@Return: @@@Type: PerlBlock @@@enDesc: Newly created Perl code object. @@@PerlDef: __DEEP{ $r = $self-> (, 'file') -> (, 'block'); }__; @Method: @@Name: createPerlBlockContainer @@enDesc: Creates a new object. @@Return: @@@Type: PerlCodeBlocks @@@enDesc: Newly created Perl code object. @@@PerlDef: __DEEP{ $r = $self-> (, 'file') -> (, 'blockContainer'); }__; @Method: @@Name: createPerlStatement @@enDesc: Creates a new Perl statement. @@Param: @@@Name: codeArg @@@Type: DOMString @@@enDesc: A Perl statement without terminating . @@@nullCase: @@@@enDesc: No initial content. @@Return: @@@Type: PerlStatement @@@enDesc: The newly created Perl code object. @@@PerlDef: __DEEP{ $r = $self-> (, 'file') -> (, 'statement'); if (defined $codeArg) { $r-> ($codeArg); } }__; @Method: @@Name: createPerlIf @@enDesc: Creates a object. @@Param: @@@Name: conditionArg @@@Type: PerlCodeInlines @@@enDesc: Conditoon code fragment object. @@Param: @@@Name: trueArg @@@Type: PerlCodeBlocks @@@enDesc: A true code fragment object. @@@nullCase: @@@@enDesc: No true code. @@Param: @@@Name: falseArg @@@Type: PerlCodeBlocks @@@enDesc: A false code fragment object. @@@nullCase: @@@@enDesc: No false code. @@Return: @@@Type: PerlIf @@@RaiseException: @@@@@:BAD_CHILD_ERR @@@@enDesc: An attempt is made to append a child that is not valid type. @@@RaiseException: @@@@@:IN_USE_NODE_ERR @@@@enDesc: An attempt is made to append a node that is already used elsewhere. @@@PerlDef: for my $arg ([conditionArg => $conditionArg]) { if ({ atom => 1, tokens => 1, inlineContainer => 1, assignment => true, inlineUnparsed => 1, variable => 1, stringLiteral => true, list => true, arrayRefLiteral => true, hashRefLiteral => true, }->{$arg->[1]->}) { if ($arg->[1]->) { __EXCEPTION{IN_USE_NODE_ERR:: pc:childNode => {$arg->[1]}, MDOMX:param-name => {$arg->[0]}, }__; } } else { __EXCEPTION{BAD_CHILD_ERR:: pc:parentNode => {$self}, pc:childNode => {$arg->[1]}, MDOMX:param-name => {$arg->[0]}, }__; } } # c for my $arg ([trueArg => $trueArg], [falseArg => $falseArg]) { next unless $arg->[1]; if ({ blockContainer => true, }->{$arg->[1]->}) { if ($arg->[1]->) { __EXCEPTION{IN_USE_NODE_ERR:: pc:childNode => {$arg->[1]}, MDOMX:param-name => {$arg->[0]}, }__; } } else { __EXCEPTION{BAD_CHILD_ERR:: pc:parentNode => {$self}, pc:childNode => {$arg->[1]}, MDOMX:param-name => {$arg->[0]}, }__; } } # t/f __DEEP{ $r = $self-> (, 'file') -> (, 'if'); $r-> ($conditionArg) if $conditionArg; $r-> ($trueArg) if $trueArg; $r-> ($falseArg) if $falseArg; }__; ##PCImplementation ResourceDef: @QName: DOMImpl @AliasFor: DOMCore|DOMImplementation @For: ManakaiDOM|DOM ResourceDef: @QName: NodeList @AliasFor: DOMCore|NodeList @For: ManakaiDOM|DOM ResourceDef: @QName: Node @AliasFor: DOMCore|Node @For: ManakaiDOM|DOM ResourceDef: @QName: Element @AliasFor: DOMCore|Element @For: ManakaiDOM|DOM ResourceDef: @QName: Document @AliasFor: DOMCore|Document @For: ManakaiDOM|DOM ## -- Exceptions ResourceDef: @rdf:type: @@@: dis|MultipleResource @@ForCheck: !ManakaiDOM|ForIF !ManakaiDOM|ForClass @resourceFor: ManakaiDOM|ForIF @resourceFor: ManakaiDOM|ForClass @For: ManakaiDOM|Perl @rdf:type: @@@: dx|Interface @@ForCheck: ManakaiDOM|ForIF @rdf:type: @@@: dx|Class @@ForCheck: ManakaiDOM|ForClass @Implement: @@@: ||ManakaiDOM|ManakaiDOM|ManakaiDOM||ManakaiDOM|ForIF @@ContentType: DISCore|TFPQNames @@ForCheck: ManakaiDOM|ForClass @Implement: @@@: ||ManakaiDOM|ManakaiDOM|ManakaiDOMLatest||ManakaiDOM|ForIF @@ContentType: DISCore|TFPQNames @@ForCheck: ManakaiDOM|ForClass @dx:implementedBy: ||ManakaiDOM|ManakaiDOMLatest||ManakaiDOM|ForClass @f:implements: pc|CoreFeature10 @ISA: @@@: dx|Exception||ManakaiDOM|Perl @@ForCheck: ManakaiDOM|ForClass @IFQName: PCException @QName: @@@: ManakaiPCException @@ForCheck: ManakaiDOM|ForClass @enDesc: Exceptions for the module. @ResourceDef: @@ForCheck: ManakaiDOM|ForIF @@rdf:type: DISLang|ConstGroup @@IFQName: PCExceptionCode @@enDesc: Exception codes for . @@Type: idl|unsignedShort||ManakaiDOM|all @@rdfs:subClassOf: idl|unsignedShort||ManakaiDOM|all @@XConstDef: @@@Name: HIERARCHY_REQUEST_ERR @@@Value: @@@@@:3 @@@@ContentType: DISCore|Integer @@@enDesc: An attempt is made to break the hierarchy. @@@XSubTypeDef: @@@@QName: BAD_CHILD_ERR @@@@enDesc: An attempt is made to append a node as a child whose type is not allowed. @@@@XParam: @@@@@QName: childNode @@@@@enDesc: The node attempted to append. @@@@XParam: @@@@@QName: parentNode @@@@@enDesc: The node to whose child list an attempt to append is made. @@@XSubTypeDef: @@@@QName: IN_USE_NODE_ERR @@@@enDesc: An attempt is made to append a node that has already been used elsewhere. @@@@XParam: @@@@@QName: childNode @@@@@enDesc: The node attempted to append. @@@@XParam: @@@@@QName: parentNode @@@@@enDesc: The parent node of the . @@XConstDef: @@@Name: NOT_SUPPORTED_ERR @@@Value: @@@@@:9 @@@@ContentType: DISCore|Integer @@@enDesc: An attempt is made to do something the implementation does not support. @@@XSubTypeDef: @@@@QName: UNSUPPORTED_OPERATOR_ERR @@@@enDesc: The implementation does not support the specified operator. @@@@XParam: @@@@@QName: operator @@@@@enDesc: The operator that is not supported. @@@@enMufDef: Operator "%p (name => {});" is not supported ##PCException ElementTypeBinding: @Name: XConstDef @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: dx|ErrorCode ElementTypeBinding: @Name: XSubTypeDef @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: dx|ErrorSubCode ElementTypeBinding: @Name: XParam @ElementType: ecore:hasParameter ElementTypeBinding: @Name: XParamDef @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: ecore|Parameter @@For: =ManakaiDOM|all ElementTypeBinding: @Name: enMufDef @ElementType: ecore:defaultMessage @ShadowContent: @@ContentType: lang:muf @@lang:en ElementTypeBinding: @Name: Method @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: DISLang:Method ElementTypeBinding: @Name: ToStringMethod @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: DISLang:Method @@Operator: @@@@: DISPerl:AsStringMethod @@@ContentType: DISCore|QName @@Description: @@@lang:en @@@@: Returns the textual Perl source code representation of this object. ElementTypeBinding: @Name: NumValMethod @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: DISLang:Method @@Operator: @@@@: 0+ @@@ContentType: lang:Perl @@Description: @@@lang:en @@@@: Returns the numeric value of this object. ElementTypeBinding: @Name: IntMethod @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: DISLang:Method @@ManakaiDOM:isForInternal:1 ElementTypeBinding: @Name: Attr @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: DISLang:Attribute ElementTypeBinding: @Name: Return @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: DISLang:MethodReturn ElementTypeBinding: @Name: Get @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: DISLang:AttributeGet ElementTypeBinding: @Name: Set @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: DISLang:AttributeSet ElementTypeBinding: @Name: Param @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: DISLang:MethodParameter ElementTypeBinding: @Name: PerlDef @ElementType: dis:Def @ShadowContent: @@ContentType: lang:Perl @@ForCheck: ManakaiDOM|ForClass ElementTypeBinding: @Name: PerlCDef @ElementType: dis:Def @ShadowContent: @@ContentType: lang:Perl ElementTypeBinding: @Name: disDef @ElementType: dis:Def @ShadowContent: @@ContentType: lang:dis @@ForCheck: ManakaiDOM|ForClass ElementTypeBinding: @Name: InCase @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: ManakaiDOM:InCase ElementTypeBinding: @Name: nullCase @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: ManakaiDOM:InCase @@Value: @@@is-null:1 ElementTypeBinding: @Name: TrueCase @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: ManakaiDOM:InCase @@Value: @@@@:1 @@@ContentType: DISCore|Boolean @@Type: DOMMain:boolean::ManakaiDOM:all ElementTypeBinding: @Name: FalseCase @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: ManakaiDOM:InCase @@Value: @@@@:0 @@@ContentType: DISCore|Boolean @@Type: DOMMain:boolean::ManakaiDOM:all ElementTypeBinding: @Name: enDesc @ElementType: dis:Description @ShadowContent: @@lang:en ElementTypeBinding: @Name: PropDef @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: rdf:Property @@For: =ManakaiDOM|all ElementTypeBinding: @Name: NamedParam @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: DISLang:MethodParameter @@DISPerl:isNamedParameter:1