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/24 12:33:11 $

  @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>};

  @CODE:
    @@QName: mg|setOwnerPropRR
    @@enDesc:
      Setting <Q::mg|owner0> and <Q::mg|ownee1h> property values
      (node reference to node reference).
    @@PerlDef:
      $bag->{${$owneeref->{<H::mg|nodeIDReference>}}}->{$owner0prop}
        = $ownerref->{<H::mg|nodeIDReference>};
      $bag->{${$ownerref->{<H::mg|nodeIDReference>}}}
          ->{$ownee1hprop}->{${$owneeref->{<H::mg|nodeIDReference>}}}
        = $owneeref->{<H::mg|nodeIDReference>};

  @CODE:
    @@QName: mg|deleteOwnerProp
    @@enDesc:
      Deletes <Q::mg|owner0> and <Q::mg|ownee1h> property values.
    @@PerlDef:
      CORE::delete $bag->{${$bag->{${$owneeref->{<H::mg|nodeIDReference>}}}
                                ->{$owner0prop} or \''}}
                       ->{$ownee1hprop};
      push @{$bag->{<H::mg|mutations>}},
           $bag->{${$owneeref->{<H::mg|nodeIDReference>}}}->{$owner0prop};
      CORE::delete $bag->{${$owneeref->{<H::mg|nodeIDReference>}}}
                       ->{$owner0prop};
##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>}++;

  @Code:
    @@QName: mg|createNodeRefHashFromID
    @@enDesc:
      Creates a node reference hash, which is a hash reference
      that can be handled as if it were a node reference,
      from a node bag by its node identifier.
    @@PerlDef:
      {
        <H::mg|nodeIDReference> => $stemid,
        <H::mg|nodeBag> => $bag,
      }

  @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})

  @CODE:
    @@QName: mg|getNodeRefPropValue
    @@enDesc:
      Obtains a property value set to the node reference.
    @@PerlDef:
      $r = $ref->{$prop};

  @CODE:
    @@QName: mg|setNodeRefPropValue
    @@enDesc:
      Sets a property value set to the node reference.
    @@PerlDef:
      $ref->{$prop} = $given; 
##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

## -- Other Property Names for Options

IntPropDef:
  @QName: mg|nodeRefClass
  @mg:nodeStemKey: nrcls
  @enDesc:
    The Perl package name of the class of the node reference.
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.6	$Date: 2006/03/24 12:33:11 $
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	wakaba	1.6
246			@CODE:
247			@@QName: mg\|setOwnerPropRR
248			@@enDesc:
249			Setting <Q::mg\|owner0> and <Q::mg\|ownee1h> property values
250			(node reference to node reference).
251			@@PerlDef:
252			$bag->{${$owneeref->{<H::mg\|nodeIDReference>}}}->{$owner0prop}
253			= $ownerref->{<H::mg\|nodeIDReference>};
254			$bag->{${$ownerref->{<H::mg\|nodeIDReference>}}}
255			->{$ownee1hprop}->{${$owneeref->{<H::mg\|nodeIDReference>}}}
256			= $owneeref->{<H::mg\|nodeIDReference>};
257
258			@CODE:
259			@@QName: mg\|deleteOwnerProp
260			@@enDesc:
261			Deletes <Q::mg\|owner0> and <Q::mg\|ownee1h> property values.
262			@@PerlDef:
263			CORE::delete $bag->{${$bag->{${$owneeref->{<H::mg\|nodeIDReference>}}}
264			->{$owner0prop} or \''}}
265			->{$ownee1hprop};
266			push @{$bag->{<H::mg\|mutations>}},
267			$bag->{${$owneeref->{<H::mg\|nodeIDReference>}}}->{$owner0prop};
268			CORE::delete $bag->{${$owneeref->{<H::mg\|nodeIDReference>}}}
269			->{$owner0prop};
270	wakaba	1.1	##NodeStem
271
272
273			## -- Stem Internal Property Types
274
275			RPropDef:
276			@QName: mg\|propertyTypeKey
277			@subsetOf: DISPerl\|propHashKey
278
279			PTPropDef:
280			@QName: mg\|subnode0
281			@enDesc:
282			A subnode property.
283			@mg:propertyTypeKey: s0
284
285			PTPropDef:
286			@QName: mg\|subnode1a
287			@enDesc:
288			A subnode property containing an array reference.
289			@mg:propertyTypeKey: s1a
290
291			PTPropDef:
292			@QName: mg\|subnode1h
293			@enDesc:
294			A subnode property containing a hash reference.
295			@mg:propertyTypeKey: s1h
296
297			PTPropDef:
298			@QName: mg\|subnode2hh
299			@enDesc:
300			A subnode property containing a hash reference
301			containing hash references.
302			@mg:propertyTypeKey: s2hh
303
304			PTPropDef:
305			@QName: mg\|origin0
306			@enDesc:
307			An origin property.
308			@mg:propertyTypeKey: o0
309
310			PTPropDef:
311			@QName: mg\|owner0
312			@enDesc:
313			An owner property. It is <EM::not> traversed when garbage collection is
314			done.
315			@mg:propertyTypeKey: w0
316
317			PTPropDef:
318			@QName: mg\|ownee1h
319			@enDesc:
320			An ownee property. It <EM::is> traversed when garvage collection is done.
321			@mg:propertyTypeKey: v1h
322
323			ElementTypeBinding:
324			@Name: PTPropDef
325			@ElementType:
326			dis:ResourceDef
327			@ShadowContent:
328			@@DISCore:resourceType: DISSource\|ResourceProperty
329			@@multipleProperties: DISCore\|UnorderedList
330			@@dataType: DISCore\|QName
331
332			## -- Stem Internal Properties
333
334			RPropDef:
335			@QName: mg\|nodeStemKey
336			@subsetOf: DISPerl\|propHashKey
337			@multipleProperties: DISCore\|Single
338			@dataType: DISCore\|String
339
340			IntPropDef:
341			@QName: mg\|references
342			@enDesc:
343			The number of the external references to the node.
344			@Type: DISPerl\|Number
345			@mg:nodeStemKey: rc
346
347			IntPropDef:
348			@QName: mg\|nodeClass
349			@enDesc:
350			The Perl fully-qualified package name of the class
351			whose <CODE::___create_node_ref> method is invoked when
352			a reference to the node is instantiated.
353			@Type: DISPerl\|String
354			@mg:nodeStemKey: cls
355
356			IntPropDef:
357			@QName: mg\|nodeID
358			@enDesc:
359			The hash key string by which the node stem object can
360			be retrieved from the node bag.
361			@Type: DISPerl\|SCALAR
362			@mg:nodeStemKey: id
363
364
365			## --------------------------------
366			## --- Node Reference
367
368			ClsDef:
369			@ClsQName: NodeRef
370
371			@ResourceDef:
372			@@QName: mg\|NodeRefRole
373			@@DISCore:resourceType: DISLang\|Role
374			@@enDesc:
375			Any class that is used as a node reference <kwd:MUST> set
376			its <Q::DISLang\|role> property as <Q::mg\|NodeRefRole>.
377
378			@ResourceDef:
379			@@QName: mg\|CreateNodeStemMethod
380			@@DISCore:resourceType: DISPerl\|CommonMethod
381			@@enDesc:
382			The method to create a node stem.
383
384			The method will invoked with four parameters: class name, node bag,
385			node stem prototype, and a reference to hash containing
386			optional parameters. The method <kwd:MUST> return a node
387			stem object. It <kwd:MAY> create and return the node
388			stem optionally by <Perl::bless>ing the node stem prototype
389			parameter with any appropriate class, or <kwd:MAY> create and
390			return the node stem object by its own way. It
391			<kwd:MAY> use options contained by the third parameter
392			to create the node stem object.
393
394			@CODE:
395			@@QName: mg\|createNodeRef
396			@@enDesc:
397			Creates a new node reference for the node stem.
398			@@PerlDef:
399	wakaba	1.2	$ref = ${$stem->{<H::mg\|nodeClass>}}->___create_node_ref ({
400	wakaba	1.1	<H::mg\|nodeIDReference> => $stem->{<H::mg\|nodeID>},
401			<H::mg\|nodeBag> => $bag,
402			}, $opt);
403			$stem->{<H::mg\|references>}++;
404
405	wakaba	1.2	@CODE:
406			@@QName: mg\|createNodeRefFromID
407			@@enDesc:
408			Creates a new node reference for the node stem.
409			@@PerlDef:
410	wakaba	1.3	$ref = ${$bag->{${$stemid}}->{<H::mg\|nodeClass>}}->___create_node_ref ({
411	wakaba	1.2	<H::mg\|nodeIDReference> => $stemid,
412			<H::mg\|nodeBag> => $bag,
413			}, $opt);
414	wakaba	1.3	$bag->{${$stemid}}->{<H::mg\|references>}++;
415	wakaba	1.2
416	wakaba	1.6	@Code:
417			@@QName: mg\|createNodeRefHashFromID
418			@@enDesc:
419			Creates a node reference hash, which is a hash reference
420			that can be handled as if it were a node reference,
421			from a node bag by its node identifier.
422			@@PerlDef:
423			{
424			<H::mg\|nodeIDReference> => $stemid,
425			<H::mg\|nodeBag> => $bag,
426			}
427
428	wakaba	1.1	@ResourceDef:
429			@@QName: mg\|CreateNodeRefMethod
430			@@DISCore:resourceType: DISPerl\|CommonMethod
431			@@enDesc:
432			The method to create a node reference to the node.
433
434			The method will invoked with three parameters: class name,
435			node reference prototype, and a reference to hash containing
436			optional parameters. The method <kwd:MUST> return a node
437			reference object. It <kwd:MAY> create and return the node
438			reference by <Perl::bless>ing the node reference prototype
439			parameter with any appropriate class, or <kwd:MAY> create and
440			return the node reference object by its own way. It
441			<kwd:MAY> use options contained by the third parameter
442			to create the node reference object.
443
444			@Code:
445			@@QName: mg\|getNodeBag
446			@@enDesc:
447	wakaba	1.3	Returns the node bag to which the node stem referenced by
448			a node reference belongs.
449	wakaba	1.1	@@PerlDef:
450			$ref->{<H::mg\|nodeBag>}
451
452	wakaba	1.3	@Code:
453			@@QName: mg\|getNodeID
454			@@enDesc:
455			Returns the identifier of the node referenced by a node reference.
456			@@PerlDef:
457			$ref->{<H::mg\|nodeIDReference>}
458
459			@Code:
460			@@QName: mg\|getNodeStem
461			@@enDesc:
462			Returns the node stem referenced by a node reference.
463			@@PerlDef:
464			$ref->{<H::mg\|nodeBag>}->{${$ref->{<H::mg\|nodeIDReference>}}}
465
466	wakaba	1.1	@Method:
467			@@Name: destroy
468			@@Return:
469			@@@PerlDef:
470			my $id = $self->{<H::mg\|nodeIDReference>};
471			my $bag = $self->{<H::mg\|nodeBag>};
472			if (--$bag->{$$id}->{<H::mg\|references>} < 1) {
473			push @{$bag->{<H::mg\|mutations>}}, $id;
474			if (@{$bag->{<H::mg\|mutations>}}
475			> ($Message::Util::Grove::GCLatency or 0)) {
476			__CODE{mg\|collectGarbage:: $ref => $self}__;
477			}
478			}
479
480			@CODE:
481			@@QName: mg\|collectGarbage
482			@@enDesc:
483			Garbage collection.
484			@@Param:
485			@@@Name: ref
486			@@@Type: HASH
487			@@@enDesc:
488			The node reference object.
489			@@PerlDef:
490			my $bag = $ref->{<H::mg\|nodeBag>};
491			my @target = @{$bag->{<H::mg\|mutations>}};
492			my %done;
493			my %has_xref;
494			TARGET: while (@target) {
495			my $target = shift @target;
496
497			next TARGET if $has_xref{$$target} or $done{$$target};
498
499			unless (defined $bag->{$$target}) {
500			$done{$$target} = true;
501			next TARGET;
502			}
503
504	wakaba	1.3	my %grove;
505	wakaba	1.1	my @gtarget = ($target);
506			my @gwreferred;
507			GTARGET: while (@gtarget) {
508			my $gtarget = shift @gtarget;
509	wakaba	1.3	next GTARGET if $grove{$$gtarget};
510
511	wakaba	1.1	my $gtstem = $bag->{$$gtarget};
512			unless (defined $gtstem) {
513			$done{$$gtarget} = true;
514			next GTARGET;
515			}
516
517			if ($has_xref{$$gtarget} or $gtstem->{<H::mg\|references>}) {
518			$has_xref{$$gtarget} = true;
519	wakaba	1.3	$has_xref{$_} = true for keys %grove;
520	wakaba	1.1	for (@gtarget) {
521			$has_xref{$$_} = defined $bag->{$$_};
522			$done{$$_} = true;
523			}
524			next TARGET;
525			} elsif ($done{$$gtarget}) {
526			next GTARGET;
527			}
528
529			my $clsprop = $Message::Util::Grove::ClassProp{
530	wakaba	1.2	${$gtstem->{<H::mg\|nodeClass>}}
531	wakaba	1.1	};
532
533			for my $key (@{$clsprop->{<H::mg\|origin0>}}) {
534			push @gtarget, $gtstem->{$key} if ref $gtstem->{$key};
535			}
536
537			A: for my $key ((@{$clsprop->{<H::mg\|ownee1h>}}),
538			(@{$clsprop->{<H::mg\|subnode1h>}})) {
539			next A unless ref $gtstem->{$key};
540			push @gtarget, grep {ref $_} values %{$gtstem->{$key}};
541			}
542
543			A: for my $key (@{$clsprop->{<H::mg\|subnode1a>}}) {
544			next A unless ref $gtstem->{$key};
545			push @gtarget, grep {ref $_} @{$gtstem->{$key}};
546			}
547
548			A: for my $key (@{$clsprop->{<H::mg\|subnode2hh>}}) {
549			next A unless ref $gtstem->{$key};
550			B: for my $key2 (keys %{$gtstem->{$key}}) {
551			next B unless ref $gtstem->{$key}->{$key2};
552			push @gtarget, grep {ref $_} values %{$gtstem->{$key}->{$key2}};
553			}
554			}
555
556			for my $key (@{$clsprop->{<H::mg\|owner0>}}) {
557			push @gwreferred, $gtstem->{$key} if ref $gtstem->{$key};
558			}
559
560	wakaba	1.3	$grove{$$gtarget} = true;
561	wakaba	1.1	} # GTARGET
562
563	wakaba	1.3	for (keys %grove) {
564			$done{$_} = true;
565			delete $bag->{$_};
566	wakaba	1.1	}
567			push @target, @gwreferred;
568			} # TARGET
569			$bag->{<H::mg\|mutations>} = [];
570	wakaba	1.2
571			@CODE:
572			@@QName: mg\|getNodeStemPropValue
573			@@enDesc:
574			Obtains a property value set to the node stem associated
575			to the node reference.
576			@@PerlDef:
577			$r = $ref->{<H::mg\|nodeBag>}->{${$ref->{<H::mg\|nodeIDReference>}}}
578			->{$prop};
579
580			@CODE:
581	wakaba	1.3	@@QName: mg\|getNodeStemPropValueRef
582			@@enDesc:
583			Obtains the reference to a property value set to the node stem associated
584			to the node reference.
585			@@PerlDef:
586			$r = \$ref->{<H::mg\|nodeBag>}->{${$ref->{<H::mg\|nodeIDReference>}}}
587			->{$prop};
588
589			@CODE:
590	wakaba	1.4	@@QName: mg\|get++NodeStemPropValue
591			@@enDesc:
592			Obtains a property value set to the node stem associated
593			to the node reference and then increments the value.
594			@@PerlDef:
595			$r = $ref->{<H::mg\|nodeBag>}->{${$ref->{<H::mg\|nodeIDReference>}}}
596			->{$prop}++;
597
598			@CODE:
599	wakaba	1.2	@@QName: mg\|setNodeStemPropValue
600			@@enDesc:
601			Sets a property value to the node stem associated
602			to the node reference.
603			@@PerlDef:
604			$ref->{<H::mg\|nodeBag>}->{${$ref->{<H::mg\|nodeIDReference>}}}
605			->{$prop} = $given;
606	wakaba	1.4
607			@CODE:
608			@@QName: mg\|orSetNodeStemPropValue
609			@@enDesc:
610			Sets a property value to the node stem associated
611			to the node reference by <Perl::\|\|=> operator.
612			@@PerlDef:
613			$ref->{<H::mg\|nodeBag>}->{${$ref->{<H::mg\|nodeIDReference>}}}
614			->{$prop} \|\|= $given;
615	wakaba	1.2
616			@CODE:
617			@@QName: mg\|getNodeStemProp0Node
618			@@enDesc:
619			Obtains a property value node reference set to the node stem associated
620			to the node reference.
621			@@PerlDef:
622			my $__v = $ref->{<H::mg\|nodeBag>}->{${$ref->{<H::mg\|nodeIDReference>}}}
623			->{$prop};
624			if (defined $__v) {
625			__CODE{mg\|createNodeRefFromID\|\|ManakaiDOM\|all::
626			$bag => {$ref->{<H::mg\|nodeBag>}},
627			$stemid => $__v,
628			$ref => $r,
629			$opt => {{}},
630			}__;
631			}
632	wakaba	1.3
633			@CODE:
634			@@QName: mg\|setNodeStemProp0Node
635			@@enDesc:
636			Sets a property value node to the node stem associated
637			to the node reference.
638			@@PerlDef:
639			$ref->{<H::mg\|nodeBag>}->{${$ref->{<H::mg\|nodeIDReference>}}}
640			->{$prop} = $given->{<H::mg\|nodeIDReference>};
641
642			@CODE:
643			@@QName: mg\|deleteNodeStemPropValue
644			@@enDesc:
645			Deletes a property value node from the node stem associated
646			to the node reference.
647			@@PerlDef:
648			CORE::delete $ref->{<H::mg\|nodeBag>}->{${$ref->{<H::mg\|nodeIDReference>}}}
649			->{$prop};
650
651			@Code:
652			@@QName: mg\|nodeIDMatch
653			@@enDesc:
654			Whether a node reference references the same node
655			as a reference to a node identifier.
656			@@PerlDef:
657			(${$noderef->{<H::mg\|nodeIDReference>}} eq ${$nodeid})
658	wakaba	1.5
659			@CODE:
660			@@QName: mg\|getNodeRefPropValue
661			@@enDesc:
662			Obtains a property value set to the node reference.
663			@@PerlDef:
664			$r = $ref->{$prop};
665
666			@CODE:
667			@@QName: mg\|setNodeRefPropValue
668			@@enDesc:
669			Sets a property value set to the node reference.
670			@@PerlDef:
671			$ref->{$prop} = $given;
672	wakaba	1.1	##NodeRef
673
674			## -- Reference Internal Properties
675
676			RPropDef:
677			@QName: mg\|nodeRefKey
678			@subsetOf: DISPerl\|propHashKey
679			@multipleProperties: DISCore\|Single
680			@dataType: DISCore\|String
681
682			IntPropDef:
683			@QName: mg\|nodeIDReference
684			@enDesc:
685			The <Q::mg\|nodeID> of the node referenced by the node reference object.
686			@Type: DISPerl\|SCALAR
687			@mg:nodeRefKey: id
688
689			IntPropDef:
690			@QName: mg\|nodeBag
691			@enDesc:
692			The node bag object referenced by the node reference object.
693			@Type: DISPerl\|Ref
694			@mg:nodeRefKey: b
695	wakaba	1.6
696			## -- Other Property Names for Options
697
698			IntPropDef:
699			@QName: mg\|nodeRefClass
700			@mg:nodeStemKey: nrcls
701			@enDesc:
702			The Perl package name of the class of the node reference.