Message/Util/Grove.dis

Module:
  @QName: Util|Grove
  @enFN:
    Manakai Grove Module

  @Namespace:
    http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Grove/

  @DISCore:author: DISCore|Wakaba
  @License: license|Perl+MPL
  @Date:
    $Date: 2006/03/17 08:06:21 $

  @Require:
    @@Module:
      @@@QName: DISlib|DISPerl
  @DefaultFor: ManakaiDOM|all

Namespace:
  @dis:
    http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--
  @DISlib:
    http://suika.fam.cx/~wakaba/archive/2004/dis/
  @f:
    http://suika.fam.cx/~wakaba/archive/2004/dom/feature#
  @fe:
    http://suika.fam.cx/www/2006/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#
  @mg:
    http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Grove/
  @test:
    http://suika.fam.cx/~wakaba/archive/2004/dis/Test#
  @Util:
    http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/

ElementTypeBinding:
  @Name: ClsDef
  @ElementType:
    dis:ResourceDef
  @ShadowContent:
    @@DISCore:resourceType: DISLang|Class

ElementTypeBinding:
  @Name: CODE
  @ElementType:
    dis:ResourceDef
  @ShadowContent:
    @@DISCore:resourceType: DISPerl|BlockCode

ElementTypeBinding:
  @Name: Method
  @ElementType:
    dis:ResourceDef
  @ShadowContent:
    @@DISCore:resourceType: DISLang|Method

ElementTypeBinding:
  @Name: Param
  @ElementType:
    dis:ResourceDef
  @ShadowContent:
    @@DISCore:resourceType: DISLang|MethodParameter

ElementTypeBinding:
  @Name: Return
  @ElementType:
    dis:ResourceDef
  @ShadowContent:
    @@DISCore:resourceType: DISLang|MethodReturn

ElementTypeBinding:
  @Name: nullCase
  @ElementType:
    dis:ResourceDef
  @ShadowContent:
    @@DISCore:resourceType:
      ManakaiDOM:InCase
    @@Value:
      @@@is-null:1

ElementTypeBinding:
  @Name: PerlDef
  @ElementType:
    dis:Def
  @ShadowContent:
    @@ContentType:
      lang:Perl

ElementTypeBinding:
  @Name: enDesc
  @ElementType:
    dis:Description
  @ShadowContent:
    @@lang:en

ElementTypeBinding:
  @Name: enImplNote
  @ElementType:
    dis:ImplNote
  @ShadowContent:
    @@lang:en

ElementTypeBinding:
  @Name: enFN
  @ElementType:
    dis:FullName
  @ShadowContent:
    @@lang:en

ElementTypeBinding:
  @Name: ClsQName
  @ElementType:
    dis:QName

ElementTypeBinding:
  @Name: Code
  @ElementType:
    dis:ResourceDef
  @ShadowContent:
    @@DISCore:resourceType: DISPerl|InlineCode

ElementTypeBinding:
  @Name: IntPropDef
  @ElementType:
    dis:ResourceDef
  @ShadowContent:
    @@DISCore:resourceType: DISCore|Property

ElementTypeBinding:
  @Name: RPropDef
  @ElementType:
    dis:ResourceDef
  @ShadowContent:
    @@DISCore:resourceType: DISSource|ResourceProperty

ElementTypeBinding:
  @Name: Test
  @ElementType:
    dis:ResourceDef
  @ShadowContent:
    @@DISCore:resourceType: test|StandaloneTest

ResourceDef:
  @QName: HASH
  @AliasFor: DISPerl|HASH||ManakaiDOM|all

## --------------------------------
## --- Node Bag

ClsDef:
  @ClsQName: NodeBag

  @CODE:
    @@QName: mg|createNodeBag
    @@enDesc:
      Creates a new node bag.
    @@PerlDef:
      $bag = {
        <H::mg|mutations> => [],
      };
##NodeBag

## -- Bag Internal Properties

RPropDef:
  @QName: mg|nodeBagKey
  @subsetOf: DISPerl|propHashKey
  @multipleProperties: DISCore|Single
  @dataType: DISCore|String

IntPropDef:
  @QName: mg|mutations
  @mg:nodeBagKey: m
  @enDesc:
    The <Q::mg|mutations> property of a node bag contains
    a reference to the array that contains references to
    the node identifiers.  They should be identifiers 
    of nodes that might be no longer referenced from anywhere
    other than bag and when garbage collection procedure is 
    invoked they are really no longer referenced or not.

## --------------------------------
## --- Node Stem

ClsDef:
  @ClsQName: NodeStem

  @CODE:
    @@QName: mg|createNodeStem
    @@enDesc:
      Creates a new node stem.
    @@PerlDef:
      $stem = $class->___create_node_stem ($bag, {
        <H::mg|references> => 0,
        <H::mg|nodeID> => \<Code::mg|generateUniqueID>,
      }, $opt);
      __CODE{DISPerl|HashStringRef||ManakaiDOM|all::
        $result => {$stem->{<H::mg|nodeClass>}},
        $given => {$class},
      }__;
      $bag->{${$stem->{<H::mg|nodeID>}}} = $stem;

  @Code:
    @@QName: mg|generateUniqueID
    @@PerlDef:
      (
        'tag:suika.fam.cx,2005-09:' . time . ':' . $$ . ':' .
        ($Message::Util::ManakaiNode::UniqueIDR ||=
          [qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
              a b c d e f g h i j k l m n o p q r s t u v w x y z
              0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
          [qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
              a b c d e f g h i j k l m n o p q r s t u v w x y z
              0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
          [qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
              a b c d e f g h i j k l m n o p q r s t u v w x y z
              0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
          [qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
              a b c d e f g h i j k l m n o p q r s t u v w x y z
              0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
          [qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
              a b c d e f g h i j k l m n o p q r s t u v w x y z
              0 1 2 3 4 5 6 7 8 9/]->[rand 62]) .
        (++$Message::Util::ManakaiNode::UniqueIDN)
      )

  @CODE:
    @@QName: mg|setOwnerProp
    @@enDesc:
      Setting <Q::mg|owner0> and <Q::mg|ownee1h> property values.
    @@PerlDef:
      $ownee->{$owner0prop} = $ownerref->{<H::mg|nodeIDReference>};
      $bag->{${$ownerref->{<H::mg|nodeIDReference>}}}
          ->{$ownee1hprop}->{${$ownee->{<H::mg|nodeID>}}}
        = $ownee->{<H::mg|nodeID>};
##NodeStem


## -- Stem Internal Property Types

RPropDef:
  @QName: mg|propertyTypeKey
  @subsetOf: DISPerl|propHashKey

PTPropDef:
  @QName: mg|subnode0
  @enDesc:
    A subnode property.
  @mg:propertyTypeKey: s0

PTPropDef:
  @QName: mg|subnode1a
  @enDesc:
    A subnode property containing an array reference.
  @mg:propertyTypeKey: s1a

PTPropDef:
  @QName: mg|subnode1h
  @enDesc:
    A subnode property containing a hash reference.
  @mg:propertyTypeKey: s1h

PTPropDef:
  @QName: mg|subnode2hh
  @enDesc:
    A subnode property containing a hash reference 
    containing hash references.
  @mg:propertyTypeKey: s2hh

PTPropDef:
  @QName: mg|origin0
  @enDesc:
    An origin property.
  @mg:propertyTypeKey: o0

PTPropDef:
  @QName: mg|owner0
  @enDesc:
    An owner property.  It is <EM::not> traversed when garbage collection is
    done.
  @mg:propertyTypeKey: w0

PTPropDef:
  @QName: mg|ownee1h
  @enDesc:
    An ownee property.  It <EM::is> traversed when garvage collection is done.
  @mg:propertyTypeKey: v1h

ElementTypeBinding:
  @Name: PTPropDef
  @ElementType:
    dis:ResourceDef
  @ShadowContent:
    @@DISCore:resourceType: DISSource|ResourceProperty
    @@multipleProperties: DISCore|UnorderedList
    @@dataType: DISCore|QName

## -- Stem Internal Properties

RPropDef:
  @QName: mg|nodeStemKey
  @subsetOf: DISPerl|propHashKey
  @multipleProperties: DISCore|Single
  @dataType: DISCore|String

IntPropDef:
  @QName: mg|references
  @enDesc:
    The number of the external references to the node.
  @Type: DISPerl|Number
  @mg:nodeStemKey: rc

IntPropDef:
  @QName: mg|nodeClass
  @enDesc:
    The Perl fully-qualified package name of the class
    whose <CODE::___create_node_ref> method is invoked when
    a reference to the node is instantiated.
  @Type: DISPerl|String
  @mg:nodeStemKey: cls

IntPropDef:
  @QName: mg|nodeID
  @enDesc:
    The hash key string by which the node stem object can
    be retrieved from the node bag.
  @Type: DISPerl|SCALAR
  @mg:nodeStemKey: id


## --------------------------------
## --- Node Reference

ClsDef:
  @ClsQName: NodeRef

  @ResourceDef:
    @@QName: mg|NodeRefRole
    @@DISCore:resourceType: DISLang|Role
    @@enDesc:
      Any class that is used as a node reference <kwd:MUST> set
      its <Q::DISLang|role> property as <Q::mg|NodeRefRole>.

  @ResourceDef:
    @@QName: mg|CreateNodeStemMethod
    @@DISCore:resourceType: DISPerl|CommonMethod
    @@enDesc:
      The method to create a node stem.

      The method will invoked with four parameters: class name, node bag,
      node stem prototype, and a reference to hash containing
      optional parameters.  The method <kwd:MUST> return a node
      stem object.  It <kwd:MAY> create and return the node
      stem optionally by <Perl::bless>ing the node stem prototype
      parameter with any appropriate class, or <kwd:MAY> create and
      return the node stem object by its own way.   It
      <kwd:MAY> use options contained by the third parameter 
      to create the node stem object.

  @CODE:
    @@QName: mg|createNodeRef
    @@enDesc:
      Creates a new node reference for the node stem.
    @@PerlDef:
      $ref = ${$stem->{<H::mg|nodeClass>}}->___create_node_ref ({
        <H::mg|nodeIDReference> => $stem->{<H::mg|nodeID>},
        <H::mg|nodeBag> => $bag,
      }, $opt);
      $stem->{<H::mg|references>}++;

  @CODE:
    @@QName: mg|createNodeRefFromID
    @@enDesc:
      Creates a new node reference for the node stem.
    @@PerlDef:
      $ref = ${$bag->{$$stemid}->{<H::mg|nodeClass>}}->___create_node_ref ({
        <H::mg|nodeIDReference> => $stemid,
        <H::mg|nodeBag> => $bag,
      }, $opt);
      $bag->{$$stemid}->{<H::mg|references>}++;

  @ResourceDef:
    @@QName: mg|CreateNodeRefMethod
    @@DISCore:resourceType: DISPerl|CommonMethod
    @@enDesc:
      The method to create a node reference to the node.

      The method will invoked with three parameters: class name,
      node reference prototype, and a reference to hash containing
      optional parameters.  The method <kwd:MUST> return a node
      reference object.  It <kwd:MAY> create and return the node
      reference by <Perl::bless>ing the node reference prototype
      parameter with any appropriate class, or <kwd:MAY> create and
      return the node reference object by its own way.   It
      <kwd:MAY> use options contained by the third parameter 
      to create the node reference object.

  @Code:
    @@QName: mg|getNodeBag
    @@enDesc:
      Returns a node bag to which the node reference belongs.
    @@PerlDef:
      $ref->{<H::mg|nodeBag>}

  @Method:
    @@Name: destroy
    @@Return:
      @@@PerlDef:
        my $id = $self->{<H::mg|nodeIDReference>};
        my $bag = $self->{<H::mg|nodeBag>};
        if (--$bag->{$$id}->{<H::mg|references>} < 1) {
          push @{$bag->{<H::mg|mutations>}}, $id;
          if (@{$bag->{<H::mg|mutations>}}
                  > ($Message::Util::Grove::GCLatency or 0)) {
            __CODE{mg|collectGarbage:: $ref => $self}__;
          }
        }

  @CODE:
    @@QName: mg|collectGarbage
    @@enDesc:
      Garbage collection.
    @@Param:
      @@@Name: ref
      @@@Type: HASH
      @@@enDesc:
        The node reference object.
    @@PerlDef:
        my $bag = $ref->{<H::mg|nodeBag>};
        my @target = @{$bag->{<H::mg|mutations>}};
        my %done;
        my %has_xref;
        TARGET: while (@target) {
          my $target = shift @target;

          next TARGET if $has_xref{$$target} or $done{$$target};

          unless (defined $bag->{$$target}) {
            $done{$$target} = true;
            next TARGET;
          }

          my @grove;
          my @gtarget = ($target);
          my @gwreferred;
          GTARGET: while (@gtarget) {
            my $gtarget = shift @gtarget;
            my $gtstem = $bag->{$$gtarget};
            unless (defined $gtstem) {
              $done{$$gtarget} = true;
              next GTARGET;
            }

            if ($has_xref{$$gtarget} or $gtstem->{<H::mg|references>}) {
              $has_xref{$$gtarget} = true;
              $has_xref{$$_} = true for @grove;
              for (@gtarget) {
                $has_xref{$$_} = defined $bag->{$$_};
                $done{$$_} = true;
              }
              next TARGET;
            } elsif ($done{$$gtarget}) {
              next GTARGET;
            }

            my $clsprop = $Message::Util::Grove::ClassProp{
                            ${$gtstem->{<H::mg|nodeClass>}}
                          };

            for my $key (@{$clsprop->{<H::mg|origin0>}}) {
              push @gtarget, $gtstem->{$key} if ref $gtstem->{$key};
            }

            A: for my $key ((@{$clsprop->{<H::mg|ownee1h>}}),
                            (@{$clsprop->{<H::mg|subnode1h>}})) {
              next A unless ref $gtstem->{$key};
              push @gtarget, grep {ref $_} values %{$gtstem->{$key}};
            }

            A: for my $key (@{$clsprop->{<H::mg|subnode1a>}}) {
              next A unless ref $gtstem->{$key};
              push @gtarget, grep {ref $_} @{$gtstem->{$key}};
            }

            A: for my $key (@{$clsprop->{<H::mg|subnode2hh>}}) {
              next A unless ref $gtstem->{$key};
              B: for my $key2 (keys %{$gtstem->{$key}}) {
                next B unless ref $gtstem->{$key}->{$key2};
                push @gtarget, grep {ref $_} values %{$gtstem->{$key}->{$key2}};
              }
            }

            for my $key (@{$clsprop->{<H::mg|owner0>}}) {
              push @gwreferred, $gtstem->{$key} if ref $gtstem->{$key};
            }

            push @grove, $gtarget;
          } # GTARGET

          for (@grove) {
            $done{$$_} = true;
            delete $bag->{$$_};
          }
          push @target, @gwreferred;
        } # TARGET
        $bag->{<H::mg|mutations>} = [];

  @CODE:
    @@QName: mg|getNodeStemPropValue
    @@enDesc:
      Obtains a property value set to the node stem associated
      to the node reference.
    @@PerlDef:
      $r = $ref->{<H::mg|nodeBag>}->{${$ref->{<H::mg|nodeIDReference>}}}
               ->{$prop};

  @CODE:
    @@QName: mg|setNodeStemPropValue
    @@enDesc:
      Sets a property value to the node stem associated
      to the node reference.
    @@PerlDef:
      $ref->{<H::mg|nodeBag>}->{${$ref->{<H::mg|nodeIDReference>}}}
          ->{$prop} = $given;

  @CODE:
    @@QName: mg|getNodeStemProp0Node
    @@enDesc:
      Obtains a property value node reference set to the node stem associated
      to the node reference.
    @@PerlDef:
      my $__v = $ref->{<H::mg|nodeBag>}->{${$ref->{<H::mg|nodeIDReference>}}}
                    ->{$prop};
      if (defined $__v) {
        __CODE{mg|createNodeRefFromID||ManakaiDOM|all::
          $bag => {$ref->{<H::mg|nodeBag>}},
          $stemid => $__v,
          $ref => $r,
          $opt => {{}},
        }__;
      }
##NodeRef

## -- Reference Internal Properties

RPropDef:
  @QName: mg|nodeRefKey
  @subsetOf: DISPerl|propHashKey
  @multipleProperties: DISCore|Single
  @dataType: DISCore|String

IntPropDef:
  @QName: mg|nodeIDReference
  @enDesc:
    The <Q::mg|nodeID> of the node referenced by the node reference object.
  @Type: DISPerl|SCALAR
  @mg:nodeRefKey: id

IntPropDef:
  @QName: mg|nodeBag
  @enDesc:
    The node bag object referenced by the node reference object.
  @Type: DISPerl|Ref
  @mg:nodeRefKey: b
1	wakaba	1.1	Module:
2			@QName: Util\|Grove
3			@enFN:
4			Manakai Grove Module
5
6			@Namespace:
7			http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Grove/
8
9			@DISCore:author: DISCore\|Wakaba
10			@License: license\|Perl+MPL
11			@Date:
12	wakaba	1.2	$Date: 2006/03/17 08:06:21 $
13	wakaba	1.1
14			@Require:
15			@@Module:
16			@@@QName: DISlib\|DISPerl
17			@DefaultFor: ManakaiDOM\|all
18
19			Namespace:
20			@dis:
21			http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--
22			@DISlib:
23			http://suika.fam.cx/~wakaba/archive/2004/dis/
24			@f:
25			http://suika.fam.cx/~wakaba/archive/2004/dom/feature#
26			@fe:
27			http://suika.fam.cx/www/2006/feature/
28			@idl:
29			http://suika.fam.cx/~wakaba/archive/2004/dis/IDL#
30			@kwd:
31			http://suika.fam.cx/~wakaba/archive/2005/rfc2119/
32			@lang:
33			http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#
34			@license:
35			http://suika.fam.cx/~wakaba/archive/2004/8/18/license#
36			@ManakaiDOM:
37			http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#
38			@mg:
39			http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Grove/
40			@test:
41			http://suika.fam.cx/~wakaba/archive/2004/dis/Test#
42			@Util:
43			http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/
44
45			ElementTypeBinding:
46			@Name: ClsDef
47			@ElementType:
48			dis:ResourceDef
49			@ShadowContent:
50			@@DISCore:resourceType: DISLang\|Class
51
52			ElementTypeBinding:
53			@Name: CODE
54			@ElementType:
55			dis:ResourceDef
56			@ShadowContent:
57			@@DISCore:resourceType: DISPerl\|BlockCode
58
59			ElementTypeBinding:
60			@Name: Method
61			@ElementType:
62			dis:ResourceDef
63			@ShadowContent:
64			@@DISCore:resourceType: DISLang\|Method
65
66			ElementTypeBinding:
67			@Name: Param
68			@ElementType:
69			dis:ResourceDef
70			@ShadowContent:
71			@@DISCore:resourceType: DISLang\|MethodParameter
72
73			ElementTypeBinding:
74			@Name: Return
75			@ElementType:
76			dis:ResourceDef
77			@ShadowContent:
78			@@DISCore:resourceType: DISLang\|MethodReturn
79
80			ElementTypeBinding:
81			@Name: nullCase
82			@ElementType:
83			dis:ResourceDef
84			@ShadowContent:
85			@@DISCore:resourceType:
86			ManakaiDOM:InCase
87			@@Value:
88			@@@is-null:1
89
90			ElementTypeBinding:
91			@Name: PerlDef
92			@ElementType:
93			dis:Def
94			@ShadowContent:
95			@@ContentType:
96			lang:Perl
97
98			ElementTypeBinding:
99			@Name: enDesc
100			@ElementType:
101			dis:Description
102			@ShadowContent:
103			@@lang:en
104
105			ElementTypeBinding:
106			@Name: enImplNote
107			@ElementType:
108			dis:ImplNote
109			@ShadowContent:
110			@@lang:en
111
112			ElementTypeBinding:
113			@Name: enFN
114			@ElementType:
115			dis:FullName
116			@ShadowContent:
117			@@lang:en
118
119			ElementTypeBinding:
120			@Name: ClsQName
121			@ElementType:
122			dis:QName
123
124			ElementTypeBinding:
125			@Name: Code
126			@ElementType:
127			dis:ResourceDef
128			@ShadowContent:
129			@@DISCore:resourceType: DISPerl\|InlineCode
130
131			ElementTypeBinding:
132			@Name: IntPropDef
133			@ElementType:
134			dis:ResourceDef
135			@ShadowContent:
136			@@DISCore:resourceType: DISCore\|Property
137
138			ElementTypeBinding:
139			@Name: RPropDef
140			@ElementType:
141			dis:ResourceDef
142			@ShadowContent:
143			@@DISCore:resourceType: DISSource\|ResourceProperty
144
145			ElementTypeBinding:
146			@Name: Test
147			@ElementType:
148			dis:ResourceDef
149			@ShadowContent:
150			@@DISCore:resourceType: test\|StandaloneTest
151
152			ResourceDef:
153			@QName: HASH
154			@AliasFor: DISPerl\|HASH\|\|ManakaiDOM\|all
155
156			## --------------------------------
157			## --- Node Bag
158
159			ClsDef:
160			@ClsQName: NodeBag
161
162			@CODE:
163			@@QName: mg\|createNodeBag
164			@@enDesc:
165			Creates a new node bag.
166			@@PerlDef:
167			$bag = {
168			<H::mg\|mutations> => [],
169			};
170			##NodeBag
171
172			## -- Bag Internal Properties
173
174			RPropDef:
175			@QName: mg\|nodeBagKey
176			@subsetOf: DISPerl\|propHashKey
177			@multipleProperties: DISCore\|Single
178			@dataType: DISCore\|String
179
180			IntPropDef:
181			@QName: mg\|mutations
182			@mg:nodeBagKey: m
183			@enDesc:
184			The <Q::mg\|mutations> property of a node bag contains
185			a reference to the array that contains references to
186			the node identifiers. They should be identifiers
187			of nodes that might be no longer referenced from anywhere
188			other than bag and when garbage collection procedure is
189			invoked they are really no longer referenced or not.
190
191			## --------------------------------
192			## --- Node Stem
193
194			ClsDef:
195			@ClsQName: NodeStem
196
197			@CODE:
198			@@QName: mg\|createNodeStem
199			@@enDesc:
200			Creates a new node stem.
201			@@PerlDef:
202			$stem = $class->___create_node_stem ($bag, {
203			<H::mg\|references> => 0,
204			<H::mg\|nodeID> => \<Code::mg\|generateUniqueID>,
205			}, $opt);
206	wakaba	1.2	__CODE{DISPerl\|HashStringRef\|\|ManakaiDOM\|all::
207			$result => {$stem->{<H::mg\|nodeClass>}},
208			$given => {$class},
209			}__;
210	wakaba	1.1	$bag->{${$stem->{<H::mg\|nodeID>}}} = $stem;
211
212			@Code:
213			@@QName: mg\|generateUniqueID
214			@@PerlDef:
215			(
216			'tag:suika.fam.cx,2005-09:' . time . ':' . $$ . ':' .
217			($Message::Util::ManakaiNode::UniqueIDR \|\|=
218			[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
219			a b c d e f g h i j k l m n o p q r s t u v w x y z
220			0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
221			[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
222			a b c d e f g h i j k l m n o p q r s t u v w x y z
223			0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
224			[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
225			a b c d e f g h i j k l m n o p q r s t u v w x y z
226			0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
227			[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
228			a b c d e f g h i j k l m n o p q r s t u v w x y z
229			0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
230			[qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
231			a b c d e f g h i j k l m n o p q r s t u v w x y z
232			0 1 2 3 4 5 6 7 8 9/]->[rand 62]) .
233			(++$Message::Util::ManakaiNode::UniqueIDN)
234			)
235
236			@CODE:
237			@@QName: mg\|setOwnerProp
238			@@enDesc:
239			Setting <Q::mg\|owner0> and <Q::mg\|ownee1h> property values.
240			@@PerlDef:
241			$ownee->{$owner0prop} = $ownerref->{<H::mg\|nodeIDReference>};
242			$bag->{${$ownerref->{<H::mg\|nodeIDReference>}}}
243			->{$ownee1hprop}->{${$ownee->{<H::mg\|nodeID>}}}
244			= $ownee->{<H::mg\|nodeID>};
245			##NodeStem
246
247
248			## -- Stem Internal Property Types
249
250			RPropDef:
251			@QName: mg\|propertyTypeKey
252			@subsetOf: DISPerl\|propHashKey
253
254			PTPropDef:
255			@QName: mg\|subnode0
256			@enDesc:
257			A subnode property.
258			@mg:propertyTypeKey: s0
259
260			PTPropDef:
261			@QName: mg\|subnode1a
262			@enDesc:
263			A subnode property containing an array reference.
264			@mg:propertyTypeKey: s1a
265
266			PTPropDef:
267			@QName: mg\|subnode1h
268			@enDesc:
269			A subnode property containing a hash reference.
270			@mg:propertyTypeKey: s1h
271
272			PTPropDef:
273			@QName: mg\|subnode2hh
274			@enDesc:
275			A subnode property containing a hash reference
276			containing hash references.
277			@mg:propertyTypeKey: s2hh
278
279			PTPropDef:
280			@QName: mg\|origin0
281			@enDesc:
282			An origin property.
283			@mg:propertyTypeKey: o0
284
285			PTPropDef:
286			@QName: mg\|owner0
287			@enDesc:
288			An owner property. It is <EM::not> traversed when garbage collection is
289			done.
290			@mg:propertyTypeKey: w0
291
292			PTPropDef:
293			@QName: mg\|ownee1h
294			@enDesc:
295			An ownee property. It <EM::is> traversed when garvage collection is done.
296			@mg:propertyTypeKey: v1h
297
298			ElementTypeBinding:
299			@Name: PTPropDef
300			@ElementType:
301			dis:ResourceDef
302			@ShadowContent:
303			@@DISCore:resourceType: DISSource\|ResourceProperty
304			@@multipleProperties: DISCore\|UnorderedList
305			@@dataType: DISCore\|QName
306
307			## -- Stem Internal Properties
308
309			RPropDef:
310			@QName: mg\|nodeStemKey
311			@subsetOf: DISPerl\|propHashKey
312			@multipleProperties: DISCore\|Single
313			@dataType: DISCore\|String
314
315			IntPropDef:
316			@QName: mg\|references
317			@enDesc:
318			The number of the external references to the node.
319			@Type: DISPerl\|Number
320			@mg:nodeStemKey: rc
321
322			IntPropDef:
323			@QName: mg\|nodeClass
324			@enDesc:
325			The Perl fully-qualified package name of the class
326			whose <CODE::___create_node_ref> method is invoked when
327			a reference to the node is instantiated.
328			@Type: DISPerl\|String
329			@mg:nodeStemKey: cls
330
331			IntPropDef:
332			@QName: mg\|nodeID
333			@enDesc:
334			The hash key string by which the node stem object can
335			be retrieved from the node bag.
336			@Type: DISPerl\|SCALAR
337			@mg:nodeStemKey: id
338
339
340			## --------------------------------
341			## --- Node Reference
342
343			ClsDef:
344			@ClsQName: NodeRef
345
346			@ResourceDef:
347			@@QName: mg\|NodeRefRole
348			@@DISCore:resourceType: DISLang\|Role
349			@@enDesc:
350			Any class that is used as a node reference <kwd:MUST> set
351			its <Q::DISLang\|role> property as <Q::mg\|NodeRefRole>.
352
353			@ResourceDef:
354			@@QName: mg\|CreateNodeStemMethod
355			@@DISCore:resourceType: DISPerl\|CommonMethod
356			@@enDesc:
357			The method to create a node stem.
358
359			The method will invoked with four parameters: class name, node bag,
360			node stem prototype, and a reference to hash containing
361			optional parameters. The method <kwd:MUST> return a node
362			stem object. It <kwd:MAY> create and return the node
363			stem optionally by <Perl::bless>ing the node stem prototype
364			parameter with any appropriate class, or <kwd:MAY> create and
365			return the node stem object by its own way. It
366			<kwd:MAY> use options contained by the third parameter
367			to create the node stem object.
368
369			@CODE:
370			@@QName: mg\|createNodeRef
371			@@enDesc:
372			Creates a new node reference for the node stem.
373			@@PerlDef:
374	wakaba	1.2	$ref = ${$stem->{<H::mg\|nodeClass>}}->___create_node_ref ({
375	wakaba	1.1	<H::mg\|nodeIDReference> => $stem->{<H::mg\|nodeID>},
376			<H::mg\|nodeBag> => $bag,
377			}, $opt);
378			$stem->{<H::mg\|references>}++;
379
380	wakaba	1.2	@CODE:
381			@@QName: mg\|createNodeRefFromID
382			@@enDesc:
383			Creates a new node reference for the node stem.
384			@@PerlDef:
385			$ref = ${$bag->{$$stemid}->{<H::mg\|nodeClass>}}->___create_node_ref ({
386			<H::mg\|nodeIDReference> => $stemid,
387			<H::mg\|nodeBag> => $bag,
388			}, $opt);
389			$bag->{$$stemid}->{<H::mg\|references>}++;
390
391	wakaba	1.1	@ResourceDef:
392			@@QName: mg\|CreateNodeRefMethod
393			@@DISCore:resourceType: DISPerl\|CommonMethod
394			@@enDesc:
395			The method to create a node reference to the node.
396
397			The method will invoked with three parameters: class name,
398			node reference prototype, and a reference to hash containing
399			optional parameters. The method <kwd:MUST> return a node
400			reference object. It <kwd:MAY> create and return the node
401			reference by <Perl::bless>ing the node reference prototype
402			parameter with any appropriate class, or <kwd:MAY> create and
403			return the node reference object by its own way. It
404			<kwd:MAY> use options contained by the third parameter
405			to create the node reference object.
406
407			@Code:
408			@@QName: mg\|getNodeBag
409			@@enDesc:
410			Returns a node bag to which the node reference belongs.
411			@@PerlDef:
412			$ref->{<H::mg\|nodeBag>}
413
414			@Method:
415			@@Name: destroy
416			@@Return:
417			@@@PerlDef:
418			my $id = $self->{<H::mg\|nodeIDReference>};
419			my $bag = $self->{<H::mg\|nodeBag>};
420			if (--$bag->{$$id}->{<H::mg\|references>} < 1) {
421			push @{$bag->{<H::mg\|mutations>}}, $id;
422			if (@{$bag->{<H::mg\|mutations>}}
423			> ($Message::Util::Grove::GCLatency or 0)) {
424			__CODE{mg\|collectGarbage:: $ref => $self}__;
425			}
426			}
427
428			@CODE:
429			@@QName: mg\|collectGarbage
430			@@enDesc:
431			Garbage collection.
432			@@Param:
433			@@@Name: ref
434			@@@Type: HASH
435			@@@enDesc:
436			The node reference object.
437			@@PerlDef:
438			my $bag = $ref->{<H::mg\|nodeBag>};
439			my @target = @{$bag->{<H::mg\|mutations>}};
440			my %done;
441			my %has_xref;
442			TARGET: while (@target) {
443			my $target = shift @target;
444
445			next TARGET if $has_xref{$$target} or $done{$$target};
446
447			unless (defined $bag->{$$target}) {
448			$done{$$target} = true;
449			next TARGET;
450			}
451
452			my @grove;
453			my @gtarget = ($target);
454			my @gwreferred;
455			GTARGET: while (@gtarget) {
456			my $gtarget = shift @gtarget;
457			my $gtstem = $bag->{$$gtarget};
458			unless (defined $gtstem) {
459			$done{$$gtarget} = true;
460			next GTARGET;
461			}
462
463			if ($has_xref{$$gtarget} or $gtstem->{<H::mg\|references>}) {
464			$has_xref{$$gtarget} = true;
465			$has_xref{$$_} = true for @grove;
466			for (@gtarget) {
467			$has_xref{$$_} = defined $bag->{$$_};
468			$done{$$_} = true;
469			}
470			next TARGET;
471			} elsif ($done{$$gtarget}) {
472			next GTARGET;
473			}
474
475			my $clsprop = $Message::Util::Grove::ClassProp{
476	wakaba	1.2	${$gtstem->{<H::mg\|nodeClass>}}
477	wakaba	1.1	};
478
479			for my $key (@{$clsprop->{<H::mg\|origin0>}}) {
480			push @gtarget, $gtstem->{$key} if ref $gtstem->{$key};
481			}
482
483			A: for my $key ((@{$clsprop->{<H::mg\|ownee1h>}}),
484			(@{$clsprop->{<H::mg\|subnode1h>}})) {
485			next A unless ref $gtstem->{$key};
486			push @gtarget, grep {ref $_} values %{$gtstem->{$key}};
487			}
488
489			A: for my $key (@{$clsprop->{<H::mg\|subnode1a>}}) {
490			next A unless ref $gtstem->{$key};
491			push @gtarget, grep {ref $_} @{$gtstem->{$key}};
492			}
493
494			A: for my $key (@{$clsprop->{<H::mg\|subnode2hh>}}) {
495			next A unless ref $gtstem->{$key};
496			B: for my $key2 (keys %{$gtstem->{$key}}) {
497			next B unless ref $gtstem->{$key}->{$key2};
498			push @gtarget, grep {ref $_} values %{$gtstem->{$key}->{$key2}};
499			}
500			}
501
502			for my $key (@{$clsprop->{<H::mg\|owner0>}}) {
503			push @gwreferred, $gtstem->{$key} if ref $gtstem->{$key};
504			}
505
506			push @grove, $gtarget;
507			} # GTARGET
508
509			for (@grove) {
510			$done{$$_} = true;
511			delete $bag->{$$_};
512			}
513			push @target, @gwreferred;
514			} # TARGET
515			$bag->{<H::mg\|mutations>} = [];
516	wakaba	1.2
517			@CODE:
518			@@QName: mg\|getNodeStemPropValue
519			@@enDesc:
520			Obtains a property value set to the node stem associated
521			to the node reference.
522			@@PerlDef:
523			$r = $ref->{<H::mg\|nodeBag>}->{${$ref->{<H::mg\|nodeIDReference>}}}
524			->{$prop};
525
526			@CODE:
527			@@QName: mg\|setNodeStemPropValue
528			@@enDesc:
529			Sets a property value to the node stem associated
530			to the node reference.
531			@@PerlDef:
532			$ref->{<H::mg\|nodeBag>}->{${$ref->{<H::mg\|nodeIDReference>}}}
533			->{$prop} = $given;
534
535			@CODE:
536			@@QName: mg\|getNodeStemProp0Node
537			@@enDesc:
538			Obtains a property value node reference set to the node stem associated
539			to the node reference.
540			@@PerlDef:
541			my $__v = $ref->{<H::mg\|nodeBag>}->{${$ref->{<H::mg\|nodeIDReference>}}}
542			->{$prop};
543			if (defined $__v) {
544			__CODE{mg\|createNodeRefFromID\|\|ManakaiDOM\|all::
545			$bag => {$ref->{<H::mg\|nodeBag>}},
546			$stemid => $__v,
547			$ref => $r,
548			$opt => {{}},
549			}__;
550			}
551	wakaba	1.1	##NodeRef
552
553			## -- Reference Internal Properties
554
555			RPropDef:
556			@QName: mg\|nodeRefKey
557			@subsetOf: DISPerl\|propHashKey
558			@multipleProperties: DISCore\|Single
559			@dataType: DISCore\|String
560
561			IntPropDef:
562			@QName: mg\|nodeIDReference
563			@enDesc:
564			The <Q::mg\|nodeID> of the node referenced by the node reference object.
565			@Type: DISPerl\|SCALAR
566			@mg:nodeRefKey: id
567
568			IntPropDef:
569			@QName: mg\|nodeBag
570			@enDesc:
571			The node bag object referenced by the node reference object.
572			@Type: DISPerl\|Ref
573			@mg:nodeRefKey: b