/[suikacvs]/messaging/manakai/bin/idl2dis.pl
Suika

Contents of /messaging/manakai/bin/idl2dis.pl

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.3 - (hide annotations) (download)
Sat Dec 30 08:27:43 2006 UTC (17 years, 10 months ago) by wakaba
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +1 -1 lines
File MIME type: text/plain
FILE REMOVED 
++ manakai/bin/ChangeLog	30 Dec 2006 06:47:17 -0000
2006-12-30  Wakaba  <wakaba@suika.fam.cx>

	* idl2dis.pl: Removed.

++ manakai/lib/Message/Markup/ChangeLog	30 Dec 2006 08:26:03 -0000
	* Atom.dis, SuikaWiki.dis, H2H.dis: |WithFor|
	and |DefaultFor| properties are removed.

2006-12-30  Wakaba  <wakaba@suika.fam.cx>

++ manakai/lib/Message/Util/ChangeLog	30 Dec 2006 08:26:59 -0000
	* PerlCode.dis: |WithFor| and |DefaultFor| are removed.

2006-12-30  Wakaba  <wakaba@suika.fam.cx>

++ manakai/lib/Message/DOM/ChangeLog	30 Dec 2006 08:25:38 -0000
        GenericLS.dis, TreeCore.dis, DOMString.dis,
        XML.dis, Element.dis, Document.dis, TreeStore,dis,
        Traversal.dis, XDoctype.dis, XMLParser.dis, DOMLS.dis,
        SimpleLS.dis, DOMMain.dis, XDP.dis: |WithFor| specifications
	and |DefaultFor|s are removed.

2006-12-30  Wakaba  <wakaba@suika.fam.cx>

	* CharacterData.dis, DOMCore.dis, DOMFeature.dis,
++ manakai/lib/Message/URI/ChangeLog	30 Dec 2006 08:26:32 -0000
	* Generic.dis: |WithFor| and |DefaultFor| are removed.

2006-12-30  Wakaba  <wakaba@suika.fam.cx>

++ manakai/lib/Message/Charset/ChangeLog	30 Dec 2006 08:24:04 -0000
	* Encode.dis (Require): |WithFor| specifications are removed.
	(DefaultFor): Removed.

2006-12-30  Wakaba  <wakaba@suika.fam.cx>

++ manakai/lib/manakai/ChangeLog	30 Dec 2006 07:46:56 -0000
2006-12-30  Wakaba  <wakaba@suika.fam.cx>

	* dis.pl: Removed.
1 wakaba 1.1 #!/usr/bin/perl -w
2     use strict;
3     use Message::Markup::SuikaWikiConfig20::Node;
4    
5     my $LastCategory = '';
6     my $LastComment = '';
7     my $LastAttr;
8     my $NAME = qr/[\w:.]+/;
9     my $Status;
10     sub err ($);
11     sub level ($);
12     sub raises ($$$);
13    
14     my $tree = Message::Markup::SuikaWikiConfig20::Node->new (type => '#document');
15 wakaba 1.2 my $etUsed;
16 wakaba 1.1
17     sub fws ($) {
18     my $s = shift;
19     while ($$s =~ m{\G(?=[#\s]|/[/\*])}gc) {
20     if ($$s =~ /\G\s+/gc) {
21     #
22     } elsif ($$s =~ /\G\#(.+)(?:\n|$)/gc) {
23     my $l = $1;
24     my $m = $tree->get_attribute ('Module');
25     if ($l =~ /^include\s+"([^"]+)"/) {
26     my $f = $1;
27     my $c = $m->get_attribute ('Require', make_new_node => 1)
28     ->append_new_node (type => '#element',
29     local_name => 'Module');
30     $f =~ s/\.idl$//;
31     $c->set_attribute (Name => $f);
32     } elsif ($l =~ /^pragma\s+prefix\s+"([^"]+)"/) {
33     $m->get_element_by (sub {
34     my ($me, $you) = @_;
35 wakaba 1.2 $you->local_name eq 'AppName' and
36     $you->get_attribute_value ('ContentType',
37     default => '')
38 wakaba 1.1 eq 'lang:IDL-DOM'
39     }, make_new_node => sub {
40     my ($me, $you) = @_;
41 wakaba 1.2 $you->local_name ('AppName');
42     $you->set_attribute (ContentType =>'lang:IDL-DOM');
43 wakaba 1.1 })
44     ->set_attribute (prefix => $1);
45     } else {
46     $tree->append_new_node (type => '#comment', value => ' #'.$l);
47     }
48     } elsif ($$s =~ m#\G//\s*(\w+)\s*\n#gc) {
49     $LastComment = $LastCategory = $1;
50     } elsif ($$s =~ m#\G//(.+\n(?:\s*//.+\n)*)#gc) {
51     $LastComment = $1;
52     $LastComment =~ s#\n\s*//\s*# #g;
53     $LastComment =~ s/^\s+//;
54     $LastComment =~ s/\s+$//;
55     if ($LastComment =~ /raises\s*(\([^()]+\)|[^()\s]+)\s+on\s+setting/) {
56     my ($x, $t) = ($1, $2);
57     if ($LastAttr) {
58     raises \$x => $LastAttr, 'Set';
59     } else {
60     warn "Unassociated attribute exception comment found: $LastComment";
61     }
62     }
63     if ($LastComment =~ /raises\s*(\([^()]+\)|[^()\s]+)\s+on\s+retrieval/) {
64     my ($x, $t) = ($1, $2);
65     if ($LastAttr) {
66     raises \$x => $LastAttr, 'Get';
67     } else {
68     warn "Unassociated attribute exception comment found: $LastComment";
69     }
70     }
71     } elsif ($$s =~ m#\G(/\*(?>(?!\*/).)*\*/)#gcs) {
72     $tree->append_new_node (type => '#comment', value => $1);
73     } else {
74     err $s;
75     }
76     }
77     }
78    
79     sub type ($) {
80     my $s = shift;
81     $$s =~ /\G($NAME)/gc or return 0;
82     my $type = $1;
83     if ($type eq 'unsigned' or $type eq 'signed') {
84     fws $s;
85     $$s =~ /\G($NAME)/gc or err $s;
86     $type .= '-' . $1;
87     if ($1 eq 'long' and $$s =~ /\G\s+long\b/gc) {
88     $type .= '-long';
89     }
90     }
91     if ($type =~ /:/) {
92     $type =~ s/::/:/;
93     if ($type =~ /^([^:]+):/) {
94     register_required_module (Name => $1);
95     }
96     }
97     if ($type !~ /[^a-z-]/ and
98     not {qw/attribute 1 readonly 1 in 1 const 1 void 1/}->{$type}) {
99     $type = 'DOMMain:' . $type;
100     } elsif ({DOMString => 1, Object => 1}->{$type}) {
101     unless ($Status->{datatype_defined}->{$type}) {
102     $type = 'DOMMain:' . $type;
103     }
104     }
105     return $type;
106     }
107    
108     my $CONST = qr/^Constants|Types$|[oe]rs$|Values$|Options$|^Exception/;
109    
110     sub const ($$) {
111     my ($s, $parent) = @_;
112     if ($LastCategory or $LastComment =~ /$CONST/) {
113     if ($parent->child_nodes->[-1] and
114     $parent->child_nodes->[-1]->local_name eq 'ConstGroup' and
115 wakaba 1.2 ($parent->child_nodes->[-1]->get_attribute_value ('QName', default => ' ')
116 wakaba 1.1 eq $LastCategory or
117     $parent->child_nodes->[-1]->get_attribute_value ('FullName',
118     default => ' ')
119     eq $LastComment)) {
120     $parent = $parent->child_nodes->[-1];
121     } elsif ($parent->child_nodes->[-1] and
122     $parent->child_nodes->[-1]->local_name eq 'Exception') {
123     $parent = $parent->child_nodes->[-1];
124     if ($parent->child_nodes->[-1] and
125     $parent->child_nodes->[-1]->local_name eq 'ConstGroup' and
126 wakaba 1.2 ($parent->child_nodes->[-1]->get_attribute_value ('QName',
127     default => ' ')
128 wakaba 1.1 eq $LastCategory or
129     $parent->child_nodes->[-1]->get_attribute_value ('FullName',
130     default => ' ')
131     eq $LastComment)) {
132     $parent = $parent->child_nodes->[-1];
133     } else {
134 wakaba 1.2 $parent = $parent->append_new_node (type => '#element',
135     local_name => 'ConstGroup');
136 wakaba 1.1 if ($LastCategory) {
137 wakaba 1.2 $parent->append_new_node (type => '#element', local_name => 'QName',
138     value => $LastCategory)
139     ->set_attribute (ForCheck => q<ManakaiDOM:ForIF>);
140     $parent->append_new_node (type => '#element', local_name => 'QName',
141     value => "** $LastCategory")
142     ->set_attribute (ForCheck => q<ManakaiDOM:ForClass>);
143 wakaba 1.1 } else {
144     $parent->set_attribute (FullName => $LastComment)
145     ->set_attribute (lang => 'en');
146     }
147     }
148     } else {
149 wakaba 1.2 $parent = $parent->append_new_node (type => '#element',
150     local_name => 'ConstGroup');
151 wakaba 1.1 if ($LastCategory) {
152 wakaba 1.2 $parent->append_new_node (type => '#element', local_name => 'QName',
153     value => $LastCategory)
154     ->set_attribute (ForCheck => q<ManakaiDOM:ForIF>);
155     $parent->append_new_node (type => '#element', local_name => 'QName',
156     value => "** $LastCategory")
157     ->set_attribute (ForCheck => q<ManakaiDOM:ForClass>);
158 wakaba 1.1 } else {
159     $parent->set_attribute (FullName => $LastComment)
160     ->set_attribute (lang => 'en');
161     }
162     }
163     }
164    
165 wakaba 1.2 fws $s;
166     my $type = type $s or err $s;
167     fws $s;
168 wakaba 1.1 if ($parent->node_type eq '#element' and
169     $parent->local_name eq 'ConstGroup' and
170     not $parent->get_attribute ('Type')) {
171     $parent->set_attribute (Type => $type);
172 wakaba 1.2 $parent->set_attribute (ISA => $type)
173     ->set_attribute (ForCheck => q<ManakaiDOM:ForClass>);
174 wakaba 1.1 }
175 wakaba 1.2
176     my $const = $parent->append_new_node (type => '#element',
177     local_name => 'Const');
178 wakaba 1.1 $$s =~ /\G($NAME)/gc or err $s;
179     $const->set_attribute (Name => $1);
180     $const->set_attribute (Type => $type);
181     fws $s;
182     $$s =~ /\G=/gc or err $s;
183     fws $s;
184     $$s =~ /\G([^\s;]+)/gc or err $s;
185     $const->set_attribute (Value => $1);
186     level $const;
187     }
188    
189     sub idlname2name ($) {
190     my $s = shift;
191     $s =~ s/^_//;
192     $s;
193     }
194    
195     sub semicolon ($) {
196     my $s = shift;
197     $$s =~ /\G;/gc or return 0;
198     $LastComment = '' unless $LastComment =~ /$CONST/;
199     return 1;
200     }
201    
202     sub clear_comment () {
203     $LastComment = '';
204     $LastCategory = '';
205     }
206    
207     sub level ($) {
208     my $n = shift;
209     if ($LastComment =~ /Introduced in DOM Level (\d+)/) {
210     my $l = $1;
211     my $p = $n->get_attribute_value ('Level', default => [], as_array => 1);
212     $n->set_attribute (Level => [@$p, $l]);
213 wakaba 1.2 $n->set_attribute (For => q<ManakaiDOM:DOM>.$l);
214 wakaba 1.1 } elsif ($LastComment =~ /Modified in DOM Level (\d+)/) {
215     my $l = $1;
216     my $p = $n->get_attribute_value ('Level', default => [':: TBD ::'],
217     as_array => 1);
218     $n->set_attribute (Level => [@$p, $l]);
219     }
220     }
221    
222     sub raises ($$$) {
223     my ($s, $n, $nm) = @_;
224     $$s =~ /\G\(/gc;
225     fws $s;
226     my $p = $n->get_attribute ($nm, make_new_node => 1);
227     while ($$s =~ /\G($NAME)/gc) {
228     my $name = $1;
229     $name =~ s/::/:/g;
230 wakaba 1.2 $name = 'DOMMain:'.$name if $name eq 'DOMException' and
231 wakaba 1.1 not $Status->{datatype_defined}->{$name};
232     if ($name =~ /^([^:]+):/) {
233     register_required_module (Name => $1);
234     }
235     for my $except ($p->append_new_node (type => '#element',
236     local_name => 'Exception')) {
237     $except->set_attribute (Name => '** TBD **');
238     $except->set_attribute (Type => $name);
239     }
240     fws $s;
241     $$s =~ /\G,/gc;
242     fws $s;
243     }
244     $$s =~ /\G\)/gc;
245     return 1;
246     }
247    
248     sub err ($) {
249     use Carp;
250     my $s = shift;
251     print $tree->stringify;
252     Carp::croak "Invalid input (either input is broken or struct not implemented found): ",
253     substr $$s, pos $$s, 100;
254     }
255    
256     sub register_required_module (%) {
257     my %opt = @_;
258     my $mod = $tree->get_attribute ('Module')
259     ->get_attribute ('Require', make_new_node => 1)
260     ->get_element_by (sub {
261     my ($me, $you) = @_;
262     $you->local_name eq 'Module' and
263     $you->get_attribute_value ('Name', default => '') eq $opt{Name};
264     }, make_new_node => sub {
265     my ($me, $you) = @_;
266     $you->local_name ('Module');
267     $you->set_attribute (Name => $opt{Name});
268     });
269     }
270    
271     sub supply_incase ($$) {
272     my ($type, $node) = @_;
273     if ($type eq 'DOMMain:boolean') {
274     for my $b ('true', 'false') {
275     for ($node->append_new_node (type => '#element',
276     local_name => 'InCase')) {
277     $_->set_attribute (Value => $b);
278     }
279     }
280 wakaba 1.2 $etUsed->{InCase} = 1;
281 wakaba 1.1 }
282     } # supply_incase
283    
284     my $s;
285     {
286     local $/ = undef;
287     $s = \(<> or die "$0: $ARGV: $!");
288     }
289    
290     pos $$s = 0;
291    
292 wakaba 1.2 ## -- Module attribute
293 wakaba 1.1 for my $module ($tree->append_new_node (type => '#element',
294     local_name => 'Module')) {
295 wakaba 1.2 $module->set_attribute (QName => q<:: TBD:TBD ::>);
296     for ($module->set_attribute (AppName => q<** TBD **>)) {
297     $_->set_attribute (ContentType => q<lang:IDL-DOM>);
298     $_->set_attribute (For => q<ManakaiDOM:IDL>);
299     }
300     for ($module->set_attribute (FullName => q<:: TBD Module ::>)) {
301     $_->set_attribute (lang => q<en>);
302     }
303 wakaba 1.1 $module->set_attribute (Namespace => q<:: TBD ::>);
304 wakaba 1.2
305     $module->set_attribute (Description => q<This module is :::>)
306     ->set_attribute (lang => q<en>);
307    
308 wakaba 1.1 for ($module->set_attribute (Author => undef)) {
309     $_->set_attribute (FullName => q<** TBD **>);
310 wakaba 1.2 $_->set_attribute (Mail => q<** TBD@TBD **>);
311 wakaba 1.1 }
312     $module->set_attribute (License => q<license:Perl+MPL>);
313 wakaba 1.3 $module->set_attribute (Date => q<$Date: 2005/01/05 12:19:38 $>)
314 wakaba 1.2 ->set_attribute (ContentType => 'dis:Date.RCS');
315    
316     $module->set_attribute (DefaultFor => q<ManakaiDOM:ManakaiDOMLatest>);
317    
318     for ($module->set_attribute (Require => undef)) {
319     $_->append_new_node (type => '#element',
320     local_name => 'Module')
321     ->set_attribute (Name => 'DOMCore');
322     for ($_->append_new_node (type => '#element',
323     local_name => 'Module')) {
324     $_->set_attribute (Name => '** MYSELF **');
325     $_->set_attribute (WithFor => q<ManakaiDOM:ManakaiDOM>);
326     }
327     for ($_->append_new_node (type => '#element',
328     local_name => 'Module')) {
329     $_->set_attribute (Name => '** MYSELF **');
330     $_->set_attribute (WithFor => q<ManakaiDOM:ManakaiDOM1>);
331     }
332     for ($_->append_new_node (type => '#element',
333     local_name => 'Module')) {
334     $_->set_attribute (Name => '** MYSELF **');
335     $_->set_attribute (WithFor => q<ManakaiDOM:ManakaiDOM2>);
336     }
337     for ($_->append_new_node (type => '#element',
338     local_name => 'Module')) {
339     $_->set_attribute (Name => '** MYSELF **');
340     $_->set_attribute (WithFor => q<ManakaiDOM:ManakaiDOM3>);
341     }
342     for ($_->append_new_node (type => '#element',
343     local_name => 'Module')) {
344     $_->set_attribute (Name => '** MYSELF **');
345     $_->set_attribute (WithFor => q<ManakaiDOM:ManakaiDOMLatest>);
346     }
347     }
348 wakaba 1.1 }
349    
350 wakaba 1.2 ## -- Namespace attribute
351     for my $ns ($tree->get_attribute ('Namespace', make_new_node => 1)) {
352     for (
353     [dis => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis-->],
354     [DOMMain => q<http://suika.fam.cx/~wakaba/archive/2004/dom/main#>],
355     [infoset => q<http://www.w3.org/2001/04/infoset#>],
356     [lang => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#>],
357     [license => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/license#>],
358     [ManakaiDOM => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#>],
359     [MDOM => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#ManakaiDOM.>],
360     [MDOMX => q<http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#>],
361     [Perl => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#Perl-->],
362     [rdf => q<http://www.w3.org/1999/02/22-rdf-syntax-ns#>],
363     [rdfs => q<http://www.w3.org/2000/01/rdf-schema#>],
364     [TreeCore => q<>],
365     ) {
366     $ns->set_attribute ($_->[0] => $_->[1]);
367     }
368     }
369    
370    
371 wakaba 1.1 fws $s;
372     if ($$s =~ /\Gpragma\s+prefix\s+"([^"]+)"\s*/gc) {
373     for ($tree->get_attribute ('Module')
374     ->get_element_by (sub {
375     my ($me, $you) = @_;
376 wakaba 1.2 $you->local_name eq 'AppName' and
377     $you->get_attribute_value ('ContentType', default => '') eq
378     'lang:IDL-DOM';
379 wakaba 1.1 }, make_new_node => sub {
380     my ($me, $you) = @_;
381 wakaba 1.2 $you->local_name ('AppName');
382     $you->set_attribute (ContentType => 'lang:IDL-DOM');
383     $you->set_attribute (For => 'ManakaiDOM:IDL');
384 wakaba 1.1 })) {
385     $_->set_attribute (prefix => $1);
386     }
387     }
388     if ($$s =~ /\Gmodule\b/gc) {
389     fws $s;
390     $$s =~ /\G($NAME)/gc or err $s;
391     for ($tree->get_attribute ('Module')) {
392     $_->get_element_by (sub {
393     my ($me, $you) = @_;
394 wakaba 1.2 $you->local_name eq 'AppName' and
395     $you->get_attribute_value ('ContentType', default => '') eq
396     'lang:IDL-DOM';
397 wakaba 1.1 }, make_new_node => sub {
398     my ($me, $you) = @_;
399 wakaba 1.2 $you->local_name ('AppName');
400     $you->set_attribute (ContentType => 'lang:IDL-DOM');
401     $you->set_attribute (For => 'ManakaiDOM:IDL');
402 wakaba 1.1 })->inner_text (new_value => $1);
403     $_->set_attribute (Name => $1);
404     }
405     fws $s;
406     $$s =~ /\G\{/gc;
407     fws $s;
408     }
409    
410    
411     while (pos $$s < length $$s) {
412     my $r = $tree;
413     if ($$s =~ /\Ginterface\b/gc) {
414     fws $s;
415     $$s =~ /\G($NAME)/gc or err $s;
416     my $name = $1;
417     my @isa;
418     fws $s;
419     if ($$s =~ /\G:/gc) {
420     fws $s;
421     while ($$s =~ /\G($NAME)/gc) {
422     my $name = $1;
423     $name =~ s/::/:/g;
424     if ($name =~ /^([^:]+):/) {
425     register_required_module (Name => $1);
426     }
427     push @isa, $name;
428     fws $s;
429     $$s =~ /\G,/gc or last;
430     fws $s;
431     }
432     }
433     if ($$s =~ /\G\{/gc) {
434     my $if = $r->append_new_node (type => '#element', local_name => 'IF');
435 wakaba 1.2 $etUsed->{IF} = 1;
436     $if->append_new_node (type => '#element', local_name => 'QName',
437     value => $name)
438     ->set_attribute (ForCheck => q<ManakaiDOM:ForIF>);
439 wakaba 1.1 for (@isa) {
440     $if->append_new_node (type => '#element',
441     local_name => 'ISA',
442 wakaba 1.2 value => $_)
443     ->set_attribute (ForCheck => q<ManakaiDOM:ForIF>);
444     }
445     $if->append_new_node (type => '#element', local_name => 'QName',
446     value => "** $name")
447     ->set_attribute (ForCheck => q<ManakaiDOM:ForClass>);
448     for (@isa) {
449     $if->append_new_node (type => '#element',
450     local_name => 'ISA',
451     value => ":: $_")
452     ->set_attribute (ForCheck => q<ManakaiDOM:ForClass>);
453 wakaba 1.1 }
454     level $if;
455     clear_comment;
456     fws $s;
457     while (my $type = type $s) {
458     fws $s;
459     if ($type eq 'attribute' or $type eq 'readonly') {
460 wakaba 1.2 my $attr = $LastAttr = $if->append_new_node (type => '#element',
461     local_name => 'Attr');
462     $etUsed->{Attr} = 1;
463 wakaba 1.1 my $readonly;
464     if ($type eq 'readonly') {
465     $$s =~ /\Gattribute\b/gc or err $s;
466     fws $s;
467     $readonly = 1;
468     }
469     $type = type $s or err $s;
470     fws $s;
471     $$s =~ /\G($NAME)/gc or err $s;
472     $attr->set_attribute (Name => idlname2name $1);
473     fws $s;
474     $attr->get_attribute ('Get', make_new_node => 1)
475     ->set_attribute (Type => $type);
476     $attr->get_attribute ('Set', make_new_node => 1)
477     ->set_attribute (Type => $type) unless $readonly;
478     supply_incase ($type => $attr->get_attribute ('Get'));
479     supply_incase ($type => $attr->get_attribute ('Set'))
480     unless $readonly;
481     level $attr;
482     } elsif ($type eq 'const') {
483     const $s => $if;
484     fws $s;
485     } else {
486     my $method = $if->append_new_node (type => '#element',
487     local_name => 'Method');
488 wakaba 1.2 $etUsed->{Method} = 1;
489 wakaba 1.1 if ($$s =~ /\G($NAME)/gc) {
490     $method->set_attribute (Name => idlname2name $1);
491     } else {
492     $method->set_attribute (Name => idlname2name $type);
493     undef $type;
494     }
495     fws $s;
496     $$s =~ /\G\(/gc or err $s;
497     {
498     fws $s;
499     my $type = type $s or last;
500     fws $s;
501     my $in;
502 wakaba 1.2 my $out;
503 wakaba 1.1 if ($type eq 'in') {
504     $in = 1;
505     $type = type $s or err $s;
506     fws $s;
507 wakaba 1.2 } elsif ($type eq 'out') {
508     $out = 1;
509     $type = type $s or err $s;
510     fws $s;
511     } elsif ($type eq 'inout') {
512     $in = 1; $out = 1;
513     $type = type $s or err $s;
514     fws $s;
515 wakaba 1.1 }
516 wakaba 1.2 my $p = $method->append_new_node (type => '#element',
517     local_name => 'Param');
518 wakaba 1.1 $$s =~ /\G($NAME)/gc or err $s;
519     $p->set_attribute (Name => idlname2name $1);
520     $p->set_attribute (Type => $type);
521     $p->set_attribute (Write => 0) unless $in;
522 wakaba 1.2 $p->set_attribute (Read => 1) if $out;
523 wakaba 1.1 supply_incase ($type => $p);
524     fws $s;
525     $$s =~ /\G,/gc or last;
526     redo;
527     }
528     $$s =~ /\G\)/gc or err $s;
529     fws $s;
530    
531     my $return = $method->get_attribute ('Return', make_new_node => 1);
532     if ($type and $type ne 'void') {
533     $return->set_attribute (Type => $type);
534     supply_incase ($type => $return);
535     }
536     if ($$s =~ /\Graises\b/gc) {
537     raises $s => $method, 'Return' or err $s;
538     fws $s;
539     }
540     level $method;
541     } # attr or method
542     semicolon $s or err $s;
543     fws $s;
544     }
545     $$s =~ /\G\}/gc or err $s;
546     } # definition
547     fws $s;
548     } elsif ($$s =~ /\Gconst\b/gc) {
549     const $s => $r;
550     fws $s;
551     } elsif ($$s =~ /\Gexception\b/gc) {
552 wakaba 1.2 my $except = $r->append_new_node (type => '#element',
553     local_name => 'ExceptionDef');
554     $etUsed->{ExceptionDef} = 1;
555 wakaba 1.1 fws $s;
556     $$s =~ /\G($NAME)/gc or err $s;
557 wakaba 1.2 $except->append_new_node (type => '#element', local_name => 'QName',
558     value => $1)
559     ->set_attribute (For => q<ManakaiDOM:ForIF>);
560     $except->append_new_node (type => '#element', local_name => 'QName',
561     value => "** $1")
562     ->set_attribute (For => q<ManakaiDOM:ForClass>);
563 wakaba 1.1 level $except;
564     fws $s;
565     $$s =~ /\G\{/gc or err $s;
566     clear_comment;
567     fws $s;
568     while (my $type = type $s) {
569     fws $s;
570 wakaba 1.2 my $attr = $except->append_new_node
571     (type => '#element', local_name => 'Attr');
572     $etUsed->{Attr} = 1;
573 wakaba 1.1 $$s =~ /\G($NAME)/gc or err $s;
574     $attr->set_attribute (Name => idlname2name $1);
575     $attr->get_attribute ('Get', make_new_node => 1)
576     ->set_attribute (Type => $type);
577 wakaba 1.2 $etUsed->{Get} = 1;
578 wakaba 1.1 fws $s;
579     semicolon $s or err $s;
580     fws $s;
581     }
582     $$s =~ /\G\}/gc or err $s;
583     fws $s;
584     } elsif ($$s =~ /\Gvaluetype\b/gc) {
585     fws $s;
586     my $valtype = $r->append_new_node (type => '#element',
587 wakaba 1.2 local_name => 'DataTypeDef');
588     $etUsed->{DataTypeDef} = 1;
589 wakaba 1.1 my $type = type $s or err $s;
590 wakaba 1.2 $valtype->set_attribute (QName => $type);
591 wakaba 1.1 fws $s;
592     $$s =~ /\G([^;]+)/gc or err $s;
593     $valtype->set_attribute (Def => $1)
594 wakaba 1.2 ->set_attribute (ContentType => q<lang:IDL-DOM>);
595 wakaba 1.1 fws $s;
596     } elsif ($$s =~ /\Gtypedef\b/gc) {
597     fws $s;
598     my $type = type $s or err $s;
599     fws $s;
600     my $valtype = $r->append_new_node (type => '#element',
601 wakaba 1.2 local_name => 'DataTypeDef');
602     $etUsed->{DataTypeDef} = 1;
603 wakaba 1.1 my $name = $$s =~ /\G($NAME)/gc ? $1 : err $s;
604 wakaba 1.2 $valtype->set_attribute (QName => $name);
605     $valtype->set_attribute (AliasFor => $type)
606     ->set_attribute (For => q<!ManakaiDOM:IDL>);
607     for ($valtype->set_attribute (Def => undef)) {
608     $_->set_attribute ('DISLang:dataTypeAliasFor' => $type);
609     $_->set_attribute (For => q<ManakaiDOM:IDL>);
610     }
611 wakaba 1.1 $Status->{datatype_defined}->{$name} = 1;
612     fws $s;
613     } else {
614     last;
615     }
616     semicolon $s ;#or err $s;
617     fws $s;
618     }
619    
620     $$s =~ /\G\}/gc; # module name {...}
621     fws $s;
622     semicolon $s;
623     fws $s;
624    
625     $$s =~ /\G./gc and err $s;
626 wakaba 1.2
627     if ($etUsed->{IF}) {
628     my $etb = $tree->append_new_node (type => '#element',
629     local_name => 'ElementTypeBinding');
630     $etb->set_attribute (Name => 'IF');
631     $etb->set_attribute (ElementType => 'dis:ResourceDef');
632     my $sc = $etb->set_attribute (ShadowContent => undef);
633     $sc->append_new_node (type => '#element',
634     local_name => 'rdf:type',
635     value => q<dis:MultipleResource>)
636     ->set_attribute (ForCheck => q<!ManakaiDOM:ForIF !ManakaiDOM:ForClass>);
637     $sc->set_attribute (ForCheck => q<ManakaiDOM:DOM>);
638    
639     $sc->append_new_node (type => '#element',
640     local_name => 'resourceFor',
641     value => q<ManakaiDOM:ForIF>);
642     $sc->append_new_node (type => '#element',
643     local_name => 'rdf:type',
644     value => 'ManakaiDOM:IF')
645     ->set_attribute (ForCheck => 'ManakaiDOM:ForIF');
646     $sc->append_new_node (type => '#element',
647     local_name => 'ISA',
648     value => '::ManakaiDOM:ManakaiDOM')
649     ->set_attribute (ForCheck => 'ManakaiDOM:ForIF ManakaiDOM:ManakaiDOM '.
650     '!=ManakaiDOM:ManakaiDOM');
651    
652     $sc->append_new_node (type => '#element',
653     local_name => 'resourceFor',
654     value => q<ManakaiDOM:ForClass>)
655     ->set_attribute (FprCheck => q<ManakaiDOM:ManakaiDOM >.
656     q<!=ManakaiDOM:ManakaiDOM>);
657     $sc->append_new_node (type => '#element',
658     local_name => 'rdf:type',
659     value => 'ManakaiDOM:Class')
660     ->set_attribute (ForCheck => 'ManakaiDOM:ForClass');
661     $sc->append_new_node (type => '#element',
662     local_name => 'ISA',
663     value => 'ManakaiDOM:ManakaiDOMObject')
664     ->set_attribute (ForCheck => 'ManakaiDOM:ForIF ManakaiDOM:ManakaiDOM '.
665     '!=ManakaiDOM:ManakaiDOM');
666     }
667    
668     if ($etUsed->{ExceptionDef}) {
669     my $etb = $tree->append_new_node (type => '#element',
670     local_name => 'ElementTypeBinding');
671     $etb->set_attribute (Name => 'ExceptionDef');
672     $etb->set_attribute (ElementType => 'dis:ResourceDef');
673     my $sc = $etb->set_attribute (ShadowContent => undef);
674     $sc->append_new_node (type => '#element',
675     local_name => 'rdf:type',
676     value => q<dis:MultipleResource>)
677     ->set_attribute (ForCheck => q<!ManakaiDOM:ForIF !ManakaiDOM:ForClass>);
678     $sc->set_attribute (ForCheck => q<ManakaiDOM:DOM>);
679    
680     $sc->append_new_node (type => '#element',
681     local_name => 'resourceFor',
682     value => q<ManakaiDOM:ForIF>);
683     $sc->append_new_node (type => '#element',
684     local_name => 'rdf:type',
685     value => 'ManakaiDOM:ExceptionIF')
686     ->set_attribute (ForCheck => 'ManakaiDOM:ForIF');
687     $sc->append_new_node (type => '#element',
688     local_name => 'ISA',
689     value => '::ManakaiDOM:ManakaiDOM')
690     ->set_attribute (ForCheck => 'ManakaiDOM:ForIF ManakaiDOM:ManakaiDOM '.
691     '!=ManakaiDOM:ManakaiDOM');
692    
693     $sc->append_new_node (type => '#element',
694     local_name => 'resourceFor',
695     value => q<ManakaiDOM:ForClass>)
696     ->set_attribute (FprCheck => q<ManakaiDOM:ManakaiDOM >.
697     q<!=ManakaiDOM:ManakaiDOM>);
698     $sc->append_new_node (type => '#element',
699     local_name => 'rdf:type',
700     value => 'ManakaiDOM:ExceptionClass')
701     ->set_attribute (ForCheck => 'ManakaiDOM:ForClass');
702     $sc->append_new_node (type => '#element',
703     local_name => 'ISA',
704     value => 'ManakaiDOM:ManakaiDOMException')
705     ->set_attribute (ForCheck => 'ManakaiDOM:ForIF ManakaiDOM:ManakaiDOM '.
706     '!=ManakaiDOM:ManakaiDOM');
707     }
708    
709     if ($etUsed->{Method}) {
710     my $etb = $tree->append_new_node (type => '#element',
711     local_name => 'ElementTypeBinding');
712     $etb->set_attribute (Name => 'Method');
713     $etb->set_attribute (ElementType => 'dis:ResourceDef');
714     my $sc = $etb->set_attribute (ShadowContent => undef);
715     $sc->set_attribute ('rdf:type' => q<ManakaiDOM:DOMMethod>);
716     $sc->set_attribute (ForCheck => q<ManakaiDOM:DOM !=ManakaiDOM:ManakaiDOM>);
717    
718     {
719     my $etb = $tree->append_new_node (type => '#element',
720     local_name => 'ElementTypeBinding');
721     $etb->set_attribute (Name => 'Param');
722     $etb->set_attribute (ElementType => 'dis:ResourceDef');
723     my $sc = $etb->set_attribute (ShadowContent => undef);
724     $sc->set_attribute ('rdf:type' => q<ManakaiDOM:DOMMethodParameter>);
725     }
726    
727     {
728     my $etb = $tree->append_new_node (type => '#element',
729     local_name => 'ElementTypeBinding');
730     $etb->set_attribute (Name => 'Return');
731     $etb->set_attribute (ElementType => 'dis:ResourceDef');
732     my $sc = $etb->set_attribute (ShadowContent => undef);
733     $sc->set_attribute ('rdf:type' => q<ManakaiDOM:DOMMethodReturn>);
734     }
735     }
736    
737     if ($etUsed->{Attr}) {
738     my $etb = $tree->append_new_node (type => '#element',
739     local_name => 'ElementTypeBinding');
740     $etb->set_attribute (Name => 'Attr');
741     $etb->set_attribute (ElementType => 'dis:ResourceDef');
742     my $sc = $etb->set_attribute (ShadowContent => undef);
743     $sc->set_attribute ('rdf:type' => q<ManakaiDOM:DOMAttribute>);
744     $sc->set_attribute (ForCheck => q<ManakaiDOM:DOM !=ManakaiDOM:ManakaiDOM>);
745    
746     {
747     my $etb = $tree->append_new_node (type => '#element',
748     local_name => 'ElementTypeBinding');
749     $etb->set_attribute (Name => 'Get');
750     $etb->set_attribute (ElementType => 'dis:ResourceDef');
751     my $sc = $etb->set_attribute (ShadowContent => undef);
752     $sc->set_attribute ('rdf:type' => q<ManakaiDOM:DOMAttrGet>);
753     }
754    
755     {
756     my $etb = $tree->append_new_node (type => '#element',
757     local_name => 'ElementTypeBinding');
758     $etb->set_attribute (Name => 'Set');
759     $etb->set_attribute (ElementType => 'dis:ResourceDef');
760     my $sc = $etb->set_attribute (ShadowContent => undef);
761     $sc->set_attribute ('rdf:type' => q<ManakaiDOM:DOMAttrSet>);
762     }
763     }
764    
765     if ($etUsed->{Exception}) {
766     my $etb = $tree->append_new_node (type => '#element',
767     local_name => 'ElementTypeBinding');
768     $etb->set_attribute (Name => 'Exception');
769     $etb->set_attribute (ElementType => 'ManakaiDOM:raises');
770     }
771    
772     if ($etUsed->{Exception} or $etUsed->{ConstGroup}) {
773     my $etb = $tree->append_new_node (type => '#element',
774     local_name => 'ElementTypeBinding');
775     $etb->set_attribute (Name => 'ConstGroup');
776     $etb->set_attribute (ElementType => 'dis:ResourceDef');
777     my $sc = $etb->set_attribute (ShadowContent => undef);
778     $sc->set_attribute ('rdf:type' => q<ManakaiDOM:ConstGroup>);
779     $sc->set_attribute (ForCheck => q<ManakaiDOM:DOM !=ManakaiDOM:ManakaiDOM>);
780     $etb->clone->set_attribute (Name => 'XConstGroup')
781     if $etUsed->{Exception};
782    
783     {
784     my $etb = $tree->append_new_node (type => '#element',
785     local_name => 'ElementTypeBinding');
786     $etb->set_attribute (Name => 'Const');
787     $etb->set_attribute (ElementType => 'dis:ResourceDef');
788     my $sc = $etb->set_attribute (ShadowContent => undef);
789     $sc->set_attribute ('rdf:type' => q<ManakaiDOM:Const>);
790     }
791    
792     {
793     my $etb = $tree->append_new_node (type => '#element',
794     local_name => 'ElementTypeBinding');
795     $etb->set_attribute (Name => 'XParam');
796     $etb->set_attribute (ElementType =>
797     'ManakaiDOM:exceptionOrWarningParameter');
798     my $sc = $etb->set_attribute (ShadowContent => undef);
799     $sc->set_attribute (ForCheck => q<ManakaiDOM:ManakaiDOM>);
800     }
801     }
802    
803     {
804     my $etb = $tree->append_new_node (type => '#element',
805     local_name => 'ElementTypeBinding');
806     $etb->set_attribute (Name => 'PerlDef');
807     $etb->set_attribute (ElementType => 'dis:Def');
808     my $sc = $etb->set_attribute (ShadowContent => undef);
809     $sc->set_attribute (ContentType => q<lang:Perl>);
810     }
811    
812     if ($etUsed->{InCase}) {
813     my $etb = $tree->append_new_node (type => '#element',
814     local_name => 'ElementTypeBinding');
815     $etb->set_attribute (Name => 'InCase');
816     $etb->set_attribute (ElementType => 'dis:ResourceDef');
817     my $sc = $etb->set_attribute (ShadowContent => undef);
818     $sc->set_attribute ('rdf:type' => q<ManakaiDOM:InCase>);
819     }
820    
821     if ($etUsed->{DataTypeDef}) {
822     my $etb = $tree->append_new_node (type => '#element',
823     local_name => 'ElementTypeBinding');
824     $etb->set_attribute (Name => 'DataTypeDef');
825     $etb->set_attribute (ElementType => 'dis:ResourceDef');
826     my $sc = $etb->set_attribute (ShadowContent => undef);
827     $sc->set_attribute ('rdf:type' => q<ManakaiDOM:DataType>);
828     }
829 wakaba 1.1
830     print $tree->stringify;
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24