/[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.2 - (hide annotations) (download)
Fri Mar 17 10:51:30 2006 UTC (19 years, 3 months ago) by wakaba
Branch: MAIN
Changes since 1.1: +53 -4 lines
++ manakai/lib/Message/Util/ChangeLog	17 Mar 2006 10:51:24 -0000
	* Grove.dis (createNodeStem): Set the reference
	to the |mg:nodeClass| property.
	(createNodeRefFromID): New code.
	(getNodeStemPropValue, setNodeStemPropValue, getNodeStemProp0Node):
	New codes.

2006-03-17  Wakaba  <wakaba@suika.fam.cx>

++ manakai/lib/Message/DOM/ChangeLog	17 Mar 2006 10:50:02 -0000
	* TreeCore.dis (NodeType, nodeType, localName, namespaceURI,
	prefix, isSameNode, ownerDocument, parentNode): New.
	(Element): New interface.
	(createElementNS): New method.
	(strictErrorChecking): New.

2006-03-17  Wakaba  <wakaba@suika.fam.cx>

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24