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/16 08:52:32 $

  @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|nodeClass> => $class,
        <H::mg|nodeID> => \<Code::mg|generateUniqueID>,
      }, $opt);
      $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>}++;

  @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>} = [];
##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			$Date: 2006/03/16 08:52:32 $
13
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\|nodeClass> => $class,
205			<H::mg\|nodeID> => \<Code::mg\|generateUniqueID>,
206			}, $opt);
207			$bag->{${$stem->{<H::mg\|nodeID>}}} = $stem;
208
209			@Code:
210			@@QName: mg\|generateUniqueID
211			@@PerlDef:
212			(
213			'tag:suika.fam.cx,2005-09:' . time . ':' . $$ . ':' .
214			($Message::Util::ManakaiNode::UniqueIDR \|\|=
215			[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
216			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
217			0 1 2 3 4 5 6 7 8 9/]->[rand 62] .
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			(++$Message::Util::ManakaiNode::UniqueIDN)
231			)
232
233			@CODE:
234			@@QName: mg\|setOwnerProp
235			@@enDesc:
236			Setting <Q::mg\|owner0> and <Q::mg\|ownee1h> property values.
237			@@PerlDef:
238			$ownee->{$owner0prop} = $ownerref->{<H::mg\|nodeIDReference>};
239			$bag->{${$ownerref->{<H::mg\|nodeIDReference>}}}
240			->{$ownee1hprop}->{${$ownee->{<H::mg\|nodeID>}}}
241			= $ownee->{<H::mg\|nodeID>};
242			##NodeStem
243
244
245			## -- Stem Internal Property Types
246
247			RPropDef:
248			@QName: mg\|propertyTypeKey
249			@subsetOf: DISPerl\|propHashKey
250
251			PTPropDef:
252			@QName: mg\|subnode0
253			@enDesc:
254			A subnode property.
255			@mg:propertyTypeKey: s0
256
257			PTPropDef:
258			@QName: mg\|subnode1a
259			@enDesc:
260			A subnode property containing an array reference.
261			@mg:propertyTypeKey: s1a
262
263			PTPropDef:
264			@QName: mg\|subnode1h
265			@enDesc:
266			A subnode property containing a hash reference.
267			@mg:propertyTypeKey: s1h
268
269			PTPropDef:
270			@QName: mg\|subnode2hh
271			@enDesc:
272			A subnode property containing a hash reference
273			containing hash references.
274			@mg:propertyTypeKey: s2hh
275
276			PTPropDef:
277			@QName: mg\|origin0
278			@enDesc:
279			An origin property.
280			@mg:propertyTypeKey: o0
281
282			PTPropDef:
283			@QName: mg\|owner0
284			@enDesc:
285			An owner property. It is <EM::not> traversed when garbage collection is
286			done.
287			@mg:propertyTypeKey: w0
288
289			PTPropDef:
290			@QName: mg\|ownee1h
291			@enDesc:
292			An ownee property. It <EM::is> traversed when garvage collection is done.
293			@mg:propertyTypeKey: v1h
294
295			ElementTypeBinding:
296			@Name: PTPropDef
297			@ElementType:
298			dis:ResourceDef
299			@ShadowContent:
300			@@DISCore:resourceType: DISSource\|ResourceProperty
301			@@multipleProperties: DISCore\|UnorderedList
302			@@dataType: DISCore\|QName
303
304			## -- Stem Internal Properties
305
306			RPropDef:
307			@QName: mg\|nodeStemKey
308			@subsetOf: DISPerl\|propHashKey
309			@multipleProperties: DISCore\|Single
310			@dataType: DISCore\|String
311
312			IntPropDef:
313			@QName: mg\|references
314			@enDesc:
315			The number of the external references to the node.
316			@Type: DISPerl\|Number
317			@mg:nodeStemKey: rc
318
319			IntPropDef:
320			@QName: mg\|nodeClass
321			@enDesc:
322			The Perl fully-qualified package name of the class
323			whose <CODE::___create_node_ref> method is invoked when
324			a reference to the node is instantiated.
325			@Type: DISPerl\|String
326			@mg:nodeStemKey: cls
327
328			IntPropDef:
329			@QName: mg\|nodeID
330			@enDesc:
331			The hash key string by which the node stem object can
332			be retrieved from the node bag.
333			@Type: DISPerl\|SCALAR
334			@mg:nodeStemKey: id
335
336
337			## --------------------------------
338			## --- Node Reference
339
340			ClsDef:
341			@ClsQName: NodeRef
342
343			@ResourceDef:
344			@@QName: mg\|NodeRefRole
345			@@DISCore:resourceType: DISLang\|Role
346			@@enDesc:
347			Any class that is used as a node reference <kwd:MUST> set
348			its <Q::DISLang\|role> property as <Q::mg\|NodeRefRole>.
349
350			@ResourceDef:
351			@@QName: mg\|CreateNodeStemMethod
352			@@DISCore:resourceType: DISPerl\|CommonMethod
353			@@enDesc:
354			The method to create a node stem.
355
356			The method will invoked with four parameters: class name, node bag,
357			node stem prototype, and a reference to hash containing
358			optional parameters. The method <kwd:MUST> return a node
359			stem object. It <kwd:MAY> create and return the node
360			stem optionally by <Perl::bless>ing the node stem prototype
361			parameter with any appropriate class, or <kwd:MAY> create and
362			return the node stem object by its own way. It
363			<kwd:MAY> use options contained by the third parameter
364			to create the node stem object.
365
366			@CODE:
367			@@QName: mg\|createNodeRef
368			@@enDesc:
369			Creates a new node reference for the node stem.
370			@@PerlDef:
371			$ref = $stem->{<H::mg\|nodeClass>}->___create_node_ref ({
372			<H::mg\|nodeIDReference> => $stem->{<H::mg\|nodeID>},
373			<H::mg\|nodeBag> => $bag,
374			}, $opt);
375			$stem->{<H::mg\|references>}++;
376
377			@ResourceDef:
378			@@QName: mg\|CreateNodeRefMethod
379			@@DISCore:resourceType: DISPerl\|CommonMethod
380			@@enDesc:
381			The method to create a node reference to the node.
382
383			The method will invoked with three parameters: class name,
384			node reference prototype, and a reference to hash containing
385			optional parameters. The method <kwd:MUST> return a node
386			reference object. It <kwd:MAY> create and return the node
387			reference by <Perl::bless>ing the node reference prototype
388			parameter with any appropriate class, or <kwd:MAY> create and
389			return the node reference object by its own way. It
390			<kwd:MAY> use options contained by the third parameter
391			to create the node reference object.
392
393			@Code:
394			@@QName: mg\|getNodeBag
395			@@enDesc:
396			Returns a node bag to which the node reference belongs.
397			@@PerlDef:
398			$ref->{<H::mg\|nodeBag>}
399
400			@Method:
401			@@Name: destroy
402			@@Return:
403			@@@PerlDef:
404			my $id = $self->{<H::mg\|nodeIDReference>};
405			my $bag = $self->{<H::mg\|nodeBag>};
406			if (--$bag->{$$id}->{<H::mg\|references>} < 1) {
407			push @{$bag->{<H::mg\|mutations>}}, $id;
408			if (@{$bag->{<H::mg\|mutations>}}
409			> ($Message::Util::Grove::GCLatency or 0)) {
410			__CODE{mg\|collectGarbage:: $ref => $self}__;
411			}
412			}
413
414			@CODE:
415			@@QName: mg\|collectGarbage
416			@@enDesc:
417			Garbage collection.
418			@@Param:
419			@@@Name: ref
420			@@@Type: HASH
421			@@@enDesc:
422			The node reference object.
423			@@PerlDef:
424			my $bag = $ref->{<H::mg\|nodeBag>};
425			my @target = @{$bag->{<H::mg\|mutations>}};
426			my %done;
427			my %has_xref;
428			TARGET: while (@target) {
429			my $target = shift @target;
430
431			next TARGET if $has_xref{$$target} or $done{$$target};
432
433			unless (defined $bag->{$$target}) {
434			$done{$$target} = true;
435			next TARGET;
436			}
437
438			my @grove;
439			my @gtarget = ($target);
440			my @gwreferred;
441			GTARGET: while (@gtarget) {
442			my $gtarget = shift @gtarget;
443			my $gtstem = $bag->{$$gtarget};
444			unless (defined $gtstem) {
445			$done{$$gtarget} = true;
446			next GTARGET;
447			}
448
449			if ($has_xref{$$gtarget} or $gtstem->{<H::mg\|references>}) {
450			$has_xref{$$gtarget} = true;
451			$has_xref{$$_} = true for @grove;
452			for (@gtarget) {
453			$has_xref{$$_} = defined $bag->{$$_};
454			$done{$$_} = true;
455			}
456			next TARGET;
457			} elsif ($done{$$gtarget}) {
458			next GTARGET;
459			}
460
461			my $clsprop = $Message::Util::Grove::ClassProp{
462			$gtstem->{<H::mg\|nodeClass>}
463			};
464
465			for my $key (@{$clsprop->{<H::mg\|origin0>}}) {
466			push @gtarget, $gtstem->{$key} if ref $gtstem->{$key};
467			}
468
469			A: for my $key ((@{$clsprop->{<H::mg\|ownee1h>}}),
470			(@{$clsprop->{<H::mg\|subnode1h>}})) {
471			next A unless ref $gtstem->{$key};
472			push @gtarget, grep {ref $_} values %{$gtstem->{$key}};
473			}
474
475			A: for my $key (@{$clsprop->{<H::mg\|subnode1a>}}) {
476			next A unless ref $gtstem->{$key};
477			push @gtarget, grep {ref $_} @{$gtstem->{$key}};
478			}
479
480			A: for my $key (@{$clsprop->{<H::mg\|subnode2hh>}}) {
481			next A unless ref $gtstem->{$key};
482			B: for my $key2 (keys %{$gtstem->{$key}}) {
483			next B unless ref $gtstem->{$key}->{$key2};
484			push @gtarget, grep {ref $_} values %{$gtstem->{$key}->{$key2}};
485			}
486			}
487
488			for my $key (@{$clsprop->{<H::mg\|owner0>}}) {
489			push @gwreferred, $gtstem->{$key} if ref $gtstem->{$key};
490			}
491
492			push @grove, $gtarget;
493			} # GTARGET
494
495			for (@grove) {
496			$done{$$_} = true;
497			delete $bag->{$$_};
498			}
499			push @target, @gwreferred;
500			} # TARGET
501			$bag->{<H::mg\|mutations>} = [];
502			##NodeRef
503
504			## -- Reference Internal Properties
505
506			RPropDef:
507			@QName: mg\|nodeRefKey
508			@subsetOf: DISPerl\|propHashKey
509			@multipleProperties: DISCore\|Single
510			@dataType: DISCore\|String
511
512			IntPropDef:
513			@QName: mg\|nodeIDReference
514			@enDesc:
515			The <Q::mg\|nodeID> of the node referenced by the node reference object.
516			@Type: DISPerl\|SCALAR
517			@mg:nodeRefKey: id
518
519			IntPropDef:
520			@QName: mg\|nodeBag
521			@enDesc:
522			The node bag object referenced by the node reference object.
523			@Type: DISPerl\|Ref
524			@mg:nodeRefKey: b