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/19 07:55:46 $

  @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 the node bag to which the node stem referenced by
      a node reference belongs.
    @@PerlDef:
      $ref->{<H::mg|nodeBag>}

  @Code:
    @@QName: mg|getNodeID
    @@enDesc:
      Returns the identifier of the node referenced by a node reference.
    @@PerlDef:
      $ref->{<H::mg|nodeIDReference>}

  @Code:
    @@QName: mg|getNodeStem
    @@enDesc:
      Returns the node stem referenced by a node reference.
    @@PerlDef:
      $ref->{<H::mg|nodeBag>}->{${$ref->{<H::mg|nodeIDReference>}}}

  @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;
            next GTARGET if $grove{$$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 keys %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};
            }

            $grove{$$gtarget} = true;
          } # GTARGET

          for (keys %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|getNodeStemPropValueRef
    @@enDesc:
      Obtains the reference to 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|get++NodeStemPropValue
    @@enDesc:
      Obtains a property value set to the node stem associated
      to the node reference and then increments the value.
    @@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|orSetNodeStemPropValue
    @@enDesc:
      Sets a property value to the node stem associated
      to the node reference by <Perl::||=> operator.
    @@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 => {{}},
        }__;
      }

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

  @CODE:
    @@QName: mg|deleteNodeStemPropValue
    @@enDesc:
      Deletes a property value node from the node stem associated
      to the node reference.
    @@PerlDef:
      CORE::delete $ref->{<H::mg|nodeBag>}->{${$ref->{<H::mg|nodeIDReference>}}}
                       ->{$prop};

  @Code:
    @@QName: mg|nodeIDMatch
    @@enDesc:
      Whether a node reference references the same node
      as a reference to a node identifier.
    @@PerlDef:
      (${$noderef->{<H::mg|nodeIDReference>}} eq ${$nodeid})
##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.4	$Date: 2006/03/19 07:55:46 $
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	wakaba	1.3	$ref = ${$bag->{${$stemid}}->{<H::mg\|nodeClass>}}->___create_node_ref ({
386	wakaba	1.2	<H::mg\|nodeIDReference> => $stemid,
387			<H::mg\|nodeBag> => $bag,
388			}, $opt);
389	wakaba	1.3	$bag->{${$stemid}}->{<H::mg\|references>}++;
390	wakaba	1.2
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	wakaba	1.3	Returns the node bag to which the node stem referenced by
411			a node reference belongs.
412	wakaba	1.1	@@PerlDef:
413			$ref->{<H::mg\|nodeBag>}
414
415	wakaba	1.3	@Code:
416			@@QName: mg\|getNodeID
417			@@enDesc:
418			Returns the identifier of the node referenced by a node reference.
419			@@PerlDef:
420			$ref->{<H::mg\|nodeIDReference>}
421
422			@Code:
423			@@QName: mg\|getNodeStem
424			@@enDesc:
425			Returns the node stem referenced by a node reference.
426			@@PerlDef:
427			$ref->{<H::mg\|nodeBag>}->{${$ref->{<H::mg\|nodeIDReference>}}}
428
429	wakaba	1.1	@Method:
430			@@Name: destroy
431			@@Return:
432			@@@PerlDef:
433			my $id = $self->{<H::mg\|nodeIDReference>};
434			my $bag = $self->{<H::mg\|nodeBag>};
435			if (--$bag->{$$id}->{<H::mg\|references>} < 1) {
436			push @{$bag->{<H::mg\|mutations>}}, $id;
437			if (@{$bag->{<H::mg\|mutations>}}
438			> ($Message::Util::Grove::GCLatency or 0)) {
439			__CODE{mg\|collectGarbage:: $ref => $self}__;
440			}
441			}
442
443			@CODE:
444			@@QName: mg\|collectGarbage
445			@@enDesc:
446			Garbage collection.
447			@@Param:
448			@@@Name: ref
449			@@@Type: HASH
450			@@@enDesc:
451			The node reference object.
452			@@PerlDef:
453			my $bag = $ref->{<H::mg\|nodeBag>};
454			my @target = @{$bag->{<H::mg\|mutations>}};
455			my %done;
456			my %has_xref;
457			TARGET: while (@target) {
458			my $target = shift @target;
459
460			next TARGET if $has_xref{$$target} or $done{$$target};
461
462			unless (defined $bag->{$$target}) {
463			$done{$$target} = true;
464			next TARGET;
465			}
466
467	wakaba	1.3	my %grove;
468	wakaba	1.1	my @gtarget = ($target);
469			my @gwreferred;
470			GTARGET: while (@gtarget) {
471			my $gtarget = shift @gtarget;
472	wakaba	1.3	next GTARGET if $grove{$$gtarget};
473
474	wakaba	1.1	my $gtstem = $bag->{$$gtarget};
475			unless (defined $gtstem) {
476			$done{$$gtarget} = true;
477			next GTARGET;
478			}
479
480			if ($has_xref{$$gtarget} or $gtstem->{<H::mg\|references>}) {
481			$has_xref{$$gtarget} = true;
482	wakaba	1.3	$has_xref{$_} = true for keys %grove;
483	wakaba	1.1	for (@gtarget) {
484			$has_xref{$$_} = defined $bag->{$$_};
485			$done{$$_} = true;
486			}
487			next TARGET;
488			} elsif ($done{$$gtarget}) {
489			next GTARGET;
490			}
491
492			my $clsprop = $Message::Util::Grove::ClassProp{
493	wakaba	1.2	${$gtstem->{<H::mg\|nodeClass>}}
494	wakaba	1.1	};
495
496			for my $key (@{$clsprop->{<H::mg\|origin0>}}) {
497			push @gtarget, $gtstem->{$key} if ref $gtstem->{$key};
498			}
499
500			A: for my $key ((@{$clsprop->{<H::mg\|ownee1h>}}),
501			(@{$clsprop->{<H::mg\|subnode1h>}})) {
502			next A unless ref $gtstem->{$key};
503			push @gtarget, grep {ref $_} values %{$gtstem->{$key}};
504			}
505
506			A: for my $key (@{$clsprop->{<H::mg\|subnode1a>}}) {
507			next A unless ref $gtstem->{$key};
508			push @gtarget, grep {ref $_} @{$gtstem->{$key}};
509			}
510
511			A: for my $key (@{$clsprop->{<H::mg\|subnode2hh>}}) {
512			next A unless ref $gtstem->{$key};
513			B: for my $key2 (keys %{$gtstem->{$key}}) {
514			next B unless ref $gtstem->{$key}->{$key2};
515			push @gtarget, grep {ref $_} values %{$gtstem->{$key}->{$key2}};
516			}
517			}
518
519			for my $key (@{$clsprop->{<H::mg\|owner0>}}) {
520			push @gwreferred, $gtstem->{$key} if ref $gtstem->{$key};
521			}
522
523	wakaba	1.3	$grove{$$gtarget} = true;
524	wakaba	1.1	} # GTARGET
525
526	wakaba	1.3	for (keys %grove) {
527			$done{$_} = true;
528			delete $bag->{$_};
529	wakaba	1.1	}
530			push @target, @gwreferred;
531			} # TARGET
532			$bag->{<H::mg\|mutations>} = [];
533	wakaba	1.2
534			@CODE:
535			@@QName: mg\|getNodeStemPropValue
536			@@enDesc:
537			Obtains a property value set to the node stem associated
538			to the node reference.
539			@@PerlDef:
540			$r = $ref->{<H::mg\|nodeBag>}->{${$ref->{<H::mg\|nodeIDReference>}}}
541			->{$prop};
542
543			@CODE:
544	wakaba	1.3	@@QName: mg\|getNodeStemPropValueRef
545			@@enDesc:
546			Obtains the reference to a property value set to the node stem associated
547			to the node reference.
548			@@PerlDef:
549			$r = \$ref->{<H::mg\|nodeBag>}->{${$ref->{<H::mg\|nodeIDReference>}}}
550			->{$prop};
551
552			@CODE:
553	wakaba	1.4	@@QName: mg\|get++NodeStemPropValue
554			@@enDesc:
555			Obtains a property value set to the node stem associated
556			to the node reference and then increments the value.
557			@@PerlDef:
558			$r = $ref->{<H::mg\|nodeBag>}->{${$ref->{<H::mg\|nodeIDReference>}}}
559			->{$prop}++;
560
561			@CODE:
562	wakaba	1.2	@@QName: mg\|setNodeStemPropValue
563			@@enDesc:
564			Sets a property value to the node stem associated
565			to the node reference.
566			@@PerlDef:
567			$ref->{<H::mg\|nodeBag>}->{${$ref->{<H::mg\|nodeIDReference>}}}
568			->{$prop} = $given;
569	wakaba	1.4
570			@CODE:
571			@@QName: mg\|orSetNodeStemPropValue
572			@@enDesc:
573			Sets a property value to the node stem associated
574			to the node reference by <Perl::\|\|=> operator.
575			@@PerlDef:
576			$ref->{<H::mg\|nodeBag>}->{${$ref->{<H::mg\|nodeIDReference>}}}
577			->{$prop} \|\|= $given;
578	wakaba	1.2
579			@CODE:
580			@@QName: mg\|getNodeStemProp0Node
581			@@enDesc:
582			Obtains a property value node reference set to the node stem associated
583			to the node reference.
584			@@PerlDef:
585			my $__v = $ref->{<H::mg\|nodeBag>}->{${$ref->{<H::mg\|nodeIDReference>}}}
586			->{$prop};
587			if (defined $__v) {
588			__CODE{mg\|createNodeRefFromID\|\|ManakaiDOM\|all::
589			$bag => {$ref->{<H::mg\|nodeBag>}},
590			$stemid => $__v,
591			$ref => $r,
592			$opt => {{}},
593			}__;
594			}
595	wakaba	1.3
596			@CODE:
597			@@QName: mg\|setNodeStemProp0Node
598			@@enDesc:
599			Sets a property value node to the node stem associated
600			to the node reference.
601			@@PerlDef:
602			$ref->{<H::mg\|nodeBag>}->{${$ref->{<H::mg\|nodeIDReference>}}}
603			->{$prop} = $given->{<H::mg\|nodeIDReference>};
604
605			@CODE:
606			@@QName: mg\|deleteNodeStemPropValue
607			@@enDesc:
608			Deletes a property value node from the node stem associated
609			to the node reference.
610			@@PerlDef:
611			CORE::delete $ref->{<H::mg\|nodeBag>}->{${$ref->{<H::mg\|nodeIDReference>}}}
612			->{$prop};
613
614			@Code:
615			@@QName: mg\|nodeIDMatch
616			@@enDesc:
617			Whether a node reference references the same node
618			as a reference to a node identifier.
619			@@PerlDef:
620			(${$noderef->{<H::mg\|nodeIDReference>}} eq ${$nodeid})
621	wakaba	1.1	##NodeRef
622
623			## -- Reference Internal Properties
624
625			RPropDef:
626			@QName: mg\|nodeRefKey
627			@subsetOf: DISPerl\|propHashKey
628			@multipleProperties: DISCore\|Single
629			@dataType: DISCore\|String
630
631			IntPropDef:
632			@QName: mg\|nodeIDReference
633			@enDesc:
634			The <Q::mg\|nodeID> of the node referenced by the node reference object.
635			@Type: DISPerl\|SCALAR
636			@mg:nodeRefKey: id
637
638			IntPropDef:
639			@QName: mg\|nodeBag
640			@enDesc:
641			The node bag object referenced by the node reference object.
642			@Type: DISPerl\|Ref
643			@mg:nodeRefKey: b