/[suikacvs]/messaging/manakai/lib/Message/Util/Grove.dis
Suika

Contents of /messaging/manakai/lib/Message/Util/Grove.dis

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations) (download)
Fri Mar 17 08:06:21 2006 UTC (19 years, 3 months ago) by wakaba
Branch: MAIN
++ manakai/t/ChangeLog	17 Mar 2006 08:06:15 -0000
2006-03-17  Wakaba  <wakaba@suika.fam.cx>

	* Makefile (t-TreeCore.t): New test.

++ manakai/bin/ChangeLog	17 Mar 2006 08:03:40 -0000
2006-03-17  Wakaba  <wakaba@suika.fam.cx>

	* daf.pl: The position of two |undef| statements was incorrect.
	(daf_generate_perl_test): Provides |--skip| option
	for test scripts.

++ manakai/lib/Message/Util/ChangeLog	17 Mar 2006 07:45:32 -0000
2006-03-17  Wakaba  <wakaba@suika.fam.cx>

	* Grove.dis: New module.

++ manakai/lib/Message/Util/DIS/ChangeLog	17 Mar 2006 08:05:33 -0000
2006-03-17  Wakaba  <wakaba@suika.fam.cx>

	* Perl.dis (method name): New methods from |Util:Grove|
	module are added.
	(role): New |mg:NodeRefRole| role support is added.

++ manakai/lib/Message/DOM/ChangeLog	17 Mar 2006 08:04:07 -0000
2006-03-17  Wakaba  <wakaba@suika.fam.cx>

	* Makefile: |TreeCore.dis| is added.

	* TreeCore.dis: New module.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24