/[suikacvs]/markup/html/whatpm/Whatpm/WebIDL.pm
Suika

Contents of /markup/html/whatpm/Whatpm/WebIDL.pm

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.11 - (hide annotations) (download)
Sat Aug 2 15:14:24 2008 UTC (16 years, 3 months ago) by wakaba
Branch: MAIN
Changes since 1.10: +159 -34 lines 
++ whatpm/t/ChangeLog	2 Aug 2008 15:13:47 -0000
	* WebIDL.t ($onerror): |value| argument value should be
	checked as well as other argument values.

2008-08-02  Wakaba  <wakaba@suika.fam.cx>

++ whatpm/t/webidl/ChangeLog	2 Aug 2008 15:14:12 -0000
	* webidl-defs.dat: Test result updated.

	* webidl-interface.dat: New test data for constants are added.

2008-08-02  Wakaba  <wakaba@suika.fam.cx>

++ whatpm/Whatpm/ChangeLog	2 Aug 2008 15:12:09 -0000
	* WebIDL.pm ($integer): Order of selections are changed to match
	hexadecimal numbers (the original pattern, taken from the spec,
	was not work for hexadecimal numbers, because the "0" prefix
	matches to the [0-7]* part (as an empty string) and therefore
	it does not match with remaining "x..." part of a "0x..." integer
	literal.
	($get_type): It now returns a string, not an array reference,
	for regular types and |sequence| types (i.e. it in any case
	returns a string).
	($get_next_token): The second item in the array that represents
	a integer or float token is now a Perl number value, not the
	original string representation of the number.
	(check): Support for const value consistency checking.
	No extended attribute is defined for constants.
	(Node subclasses): Use simple strings rather than array references
	for default data type values.
	($serialize_type): Type values are now simple strings.
	(value): If the new attribute value is a false value, then
	a FALSE value is set to the attribute.

2008-08-02  Wakaba  <wakaba@suika.fam.cx>
1 wakaba 1.1 package Whatpm::WebIDL;
2     use strict;
3    
4     package Whatpm::WebIDL::Parser;
5    
6 wakaba 1.11 my $integer = qr/-?0([Xx][0-9A-Fa-f]+|[0-7]*)|[1-9][0-9]*/;
7     ## ISSUE: Spec's pattern is wrong as a Perl5 regular expression.
8 wakaba 1.1 my $float = qr/-?([0-9]+\.[0-9]*|[0-9]*\.[0-9]+)([Ee][+-]?[0-9]+)?|[0-9]+[Ee][+-]?[0-9]+/;
9     my $identifier = qr/[A-Z_a-z][0-9A-Z_a-z]*/;
10     my $whitespace = qr<[\t\n\r ]+|[\t\n\r ]*((//.*|/\*.*?\*/)[\t\n\r ]*)+>;
11    
12     sub new ($) {
13     my $self = bless {
14     must_level => 'm',
15     should_level => 's',
16     warn_level => 'w',
17     info_level => 'i',
18     }, $_[0];
19     return $self;
20     } # new
21    
22     sub parse_char_string ($$;$) {
23     my $self = shift;
24     my $s = ref $_[0] ? $_[0] : \($_[0]);
25    
26     my $defs = Whatpm::WebIDL::Definitions->new;
27 wakaba 1.9 $defs->set_user_data (manakai_source_line => 1);
28     $defs->set_user_data (manakai_source_column => 1);
29 wakaba 1.1
30     pos ($$s) = 0;
31     my $line = 1;
32     my $column = 0;
33    
34     my $get_next_token = sub {
35     if (length $$s <= pos $$s) {
36     return {type => 'eof'};
37     }
38    
39     while ($$s =~ /\G($whitespace)/gc) {
40     my $v = $1;
41     while ($v =~ s/^[^\x0D\x0A]*(?>\x0D\x0A?|\x0A)//) {
42     $line++;
43     $column = 0;
44     }
45     $column += length $v;
46     }
47    
48     if (length $$s <= pos $$s) {
49     return {type => 'eof'};
50     }
51    
52     ## ISSUE: "must"s in "A. IDL grammer" are not "MUST"s.
53    
54     if ($$s =~ /\G($identifier)/gc) {
55     my $v = $1;
56     $column += length $v;
57     if ({
58     module => 1, interface => 1, exception => 1, typedef => 1,
59     valuetype => 1, DOMString => 1, sequence => 1, unsigned => 1,
60     short => 1, const => 1, TRUE => 1, FALSE => 1, readonly => 1,
61     attribute => 1, getraises => 1, setraises => 1, raises => 1, in => 1,
62     any => 1, boolean => 1, octet => 1, float => 1, Object => 1,
63     short => 1, long => 1, void => 1,
64     }->{$v}) {
65     return {type => $v};
66     } else {
67     return {type => 'identifier', value => $v};
68     }
69     } elsif ($$s =~ /\G($float)/gc) { ## ISSUE: negative number
70     $column += length $1;
71     return {type => 'float', value => $1};
72     } elsif ($$s =~ /\G($integer)/gc) { ## ISSUE: negative nmber
73     $column += length $1;
74     return {type => 'integer', value => $1};
75     } elsif ($$s =~ /\G::/gcs) {
76     $column += 2;
77     return {type => '::'};
78     } elsif ($$s =~ /\G(.)/gcs) { ## NOTE: Should never be a newline char.
79     $column++;
80     return {type => $1};
81     } else {
82     die "get_next_token: non-possible case: " . substr ($$s, pos $$s, 20);
83     }
84     }; # $get_next_token
85    
86     my $state = 'before definitions';
87     my $token = $get_next_token->();
88     my $nest_level = 0;
89     my $next_state;
90     my $xattrs;
91 wakaba 1.4 my $prev_xattrs = [];
92 wakaba 1.1 my $last_xattr;
93     my $read_only;
94     my $current_type;
95     my @current = ($defs);
96    
97     my $_onerror = $_[1] || sub {
98     my %opt = @_;
99     my $r = 'Line ' . $opt{line} . ' column ' . $opt{column} . ': ';
100    
101     if ($opt{token}) {
102     $r .= 'Token ' . (defined $opt{token}->{value} ? $opt{token}->{value} : $opt{token}->{type}) . ': ';
103     }
104    
105     $r .= $opt{type} . ';' . $opt{level};
106    
107     warn $r . "\n";
108     }; # $_onerror
109     my $onerror = sub {
110     $_onerror->(line => $line, column => $column, token => $token, @_);
111     }; # $onerror
112    
113     my $get_scoped_name = sub {
114 wakaba 1.10 ## NOTE: Convert a |ScopedName| into a "scoped name".
115    
116 wakaba 1.1 my $name = [];
117    
118     ## NOTE: "DOMString" is not a scoped name, while "::DOMString"
119     ## and "x::DOMString" are.
120    
121     if ($token->{type} eq 'identifier') {
122 wakaba 1.10 my $identifier = $token->{value};
123     $identifier =~ s/^_//;
124     push @$name, $identifier;
125 wakaba 1.1 $token = $get_next_token->();
126     while ($token->{type} eq '::') {
127 wakaba 1.2 $token = $get_next_token->();
128 wakaba 1.1 if ($token->{type} eq 'identifier') {
129 wakaba 1.10 my $identifier = $token->{value};
130     $identifier =~ s/^_//;
131     push @$name, $identifier;
132 wakaba 1.1 $token = $get_next_token->();
133     } elsif ($token->{type} eq 'DOMString') {
134 wakaba 1.10 push @$name, 'DOMString';
135 wakaba 1.1 $token = $get_next_token->();
136     last;
137     }
138     }
139     } elsif ($token->{type} eq '::') {
140     push @$name, '';
141     while ($token->{type} eq '::') {
142 wakaba 1.2 $token = $get_next_token->();
143 wakaba 1.1 if ($token->{type} eq 'identifier') {
144 wakaba 1.10 my $identifier = $token->{value};
145     $identifier =~ s/^_//;
146     push @$name, $identifier;
147 wakaba 1.1 $token = $get_next_token->();
148     } elsif ($token->{type} eq 'DOMString') {
149 wakaba 1.10 push @$name, 'DOMString';
150 wakaba 1.1 $token = $get_next_token->();
151     last;
152     } else {
153     last;
154     }
155     }
156    
157     if (@$name == 1) {
158     return undef;
159     }
160     } else {
161     # reconsume
162     return undef;
163     }
164 wakaba 1.10 return join '::', @$name;
165 wakaba 1.1 }; # $get_scoped_name
166    
167     my $get_type;
168     $get_type = sub {
169     my $r;
170     if ({
171     void => 1, any => 1, boolean => 1, octet => 1, float => 1,
172     DOMString => 1, Object => 1, short => 1,
173     }->{$token->{type}}) {
174 wakaba 1.11 $r = '::'.$token->{type}.'::';
175 wakaba 1.1 $token = $get_next_token->();
176     } elsif ($token->{type} eq 'unsigned') {
177     $token = $get_next_token->();
178     if ($token->{type} eq 'short') {
179 wakaba 1.11 $r = '::unsigned '.$token->{type}.'::';
180 wakaba 1.1 $token = $get_next_token->();
181     } elsif ($token->{type} eq 'long') {
182     $token = $get_next_token->();
183     if ($token->{type} eq 'long') {
184 wakaba 1.11 $r = '::unsigned long long::';
185 wakaba 1.1 $token = $get_next_token->();
186     } else {
187 wakaba 1.11 $r = '::unsigned long::';
188 wakaba 1.1 # reconsume
189     }
190     } else {
191     $onerror->(type => 'unsigned', level => $self->{must_level});
192     return undef;
193     }
194     } elsif ($token->{type} eq 'long') {
195     $token = $get_next_token->();
196     if ($token->{type} eq 'long') {
197 wakaba 1.11 $r = '::long long::';
198 wakaba 1.1 $token = $get_next_token->();
199     } else {
200 wakaba 1.11 $r = '::long::';
201 wakaba 1.1 # reconsume
202     }
203     } elsif ($token->{type} eq '::' or $token->{type} eq 'identifier') {
204     $r = $get_scoped_name->();
205     if (defined $r) {
206     # next token
207     } else { # "::" not followed by identifier or "DOMString"
208     $onerror->(type => 'scoped name', level => $self->{must_level});
209     return undef;
210     }
211     } elsif ($token->{type} eq 'sequence') {
212     $token = $get_next_token->();
213     if ($token->{type} eq '<') {
214     $token = $get_next_token->();
215     if ({
216     void => 1, any => 1, boolean => 1, octet => 1, float => 1,
217     DOMString => 1, Object => 1, short => 1, long => 1, unsigned => 1,
218     sequence => 1, '::' => 1, identifier => 1,
219     }->{$token->{type}}) {
220     my $type = $get_type->();
221     if (defined $type) {
222     if ($token->{type} eq '>') {
223 wakaba 1.11 $r = '::::sequence::::' . $type;
224 wakaba 1.1 $token = $get_next_token->();
225     } else {
226     $onerror->(type => 'sequence gt', level => $self->{must_level});
227     return undef;
228     }
229     } else {
230     # error reported
231     return undef;
232     }
233     } else {
234     $onerror->(type => 'sequence type', level => $self->{must_level});
235     return undef;
236     }
237     } else {
238     $onerror->(type => 'sequence lt', level => $self->{must_level});
239     return undef;
240     }
241     } else {
242     die "get_type: bad token: $token->{type}";
243     }
244    
245     return $r;
246     }; # $get_type
247    
248     while (1) {
249     if ($state eq 'before definitions') {
250 wakaba 1.4 $xattrs = [];
251 wakaba 1.1 if ($token->{type} eq '[') {
252     $token = $get_next_token->();
253     $state = 'before xattr';
254     $next_state = 'before def';
255     } elsif ({module => 1, interface => 1, exception => 1,
256     typedef => 1, valuetype => 1, const => 1}->{$token->{type}}) {
257     # reconsume
258     $state = 'before def';
259     } elsif ($token->{type} eq '}' and @current > 1) {
260     $token = $get_next_token->();
261 wakaba 1.5 $state = 'before block semicolon';
262 wakaba 1.1 } elsif ($token->{type} eq 'eof') {
263     last;
264     } else {
265     $onerror->(type => 'before definitions', level => 'm',
266     token => $token);
267     # reconsume
268     $state = 'ignore';
269     $nest_level = 0;
270     $next_state = 'before definitions';
271     }
272     } elsif ($state eq 'before xattr') {
273     if ($token->{type} eq 'identifier') {
274     ## TODO: _escape
275     ## ISSUE: Duplicate attributes
276     ## ISSUE: Unkown attributes
277 wakaba 1.4 push @current, Whatpm::WebIDL::ExtendedAttribute->new ($token->{value});
278 wakaba 1.9 $current[-1]->set_user_data (manakai_source_line => $line);
279     $current[-1]->set_user_data (manakai_source_column => $column);
280 wakaba 1.4 push @$xattrs, $current[-1];
281 wakaba 1.1 $token = $get_next_token->();
282     $state = 'after xattr';
283     } else {
284     $onerror->(type => 'before xattr', level => 'm', token => $token);
285     # reconsume
286     $state = 'ignore';
287     $nest_level = 0;
288 wakaba 1.4 $next_state = 'before definitions'; ## TODO:
289 wakaba 1.1 }
290     } elsif ($state eq 'after xattr') {
291     if ($token->{type} eq '=') {
292     $token = $get_next_token->();
293     $state = 'before xattrarg';
294 wakaba 1.4 } elsif ($token->{type} eq '(') {
295     $token = $get_next_token->();
296     if ($token->{type} eq ')') {
297     $token = $get_next_token->();
298     push @$prev_xattrs, $xattrs;
299     $state = 'after xattrarg';
300     } else {
301     push @$prev_xattrs, $xattrs;
302     # reconsume
303     $state = 'before argument';
304     }
305 wakaba 1.1 } else {
306 wakaba 1.4 push @$prev_xattrs, $xattrs;
307 wakaba 1.1 # reconsume
308     $state = 'after xattrarg';
309     }
310     } elsif ($state eq 'before xattrarg') {
311     if ($token->{type} eq 'identifier') {
312 wakaba 1.9 my $identifier = $token->{value};
313     $identifier =~ s/^_//;
314     $current[-1]->value ($identifier);
315 wakaba 1.1 $token = $get_next_token->();
316 wakaba 1.4 if ($token->{type} eq '(') {
317     $token = $get_next_token->();
318     if ($token->{type} eq ')') {
319     push @$prev_xattrs, $xattrs;
320     $token = $get_next_token->();
321     $state = 'after xattrarg';
322     } else {
323     push @$prev_xattrs, $xattrs;
324     # reconsume
325     $state = 'before argument';
326     }
327     } else {
328     push @$prev_xattrs, $xattrs;
329     # reconsume
330     $state = 'after xattrarg';
331     }
332 wakaba 1.1 } else {
333     $onerror->(type => 'after xattrarg', level => 'm', token => $token);
334     # reconsume
335     $state = 'ignore';
336     $nest_level = 0;
337     $next_state = 'before definitions';
338     }
339     } elsif ($state eq 'after xattrarg') {
340 wakaba 1.4 pop @current; # xattr
341     $xattrs = pop @$prev_xattrs;
342 wakaba 1.1 if ($token->{type} eq ',') {
343     $token = $get_next_token->();
344     $state = 'before xattr';
345     } elsif ($token->{type} eq ']') {
346     $token = $get_next_token->();
347 wakaba 1.4 if ($current[-1]->isa ('Whatpm::WebIDL::Definitions') or
348     $current[-1]->isa ('Whatpm::WebIDL::Module')) {
349 wakaba 1.9 $state = 'before def';
350 wakaba 1.4 } elsif ($current[-1]->isa ('Whatpm::WebIDL::Interface')) {
351     $state = 'before interface member';
352     } elsif ($current[-1]->isa ('Whatpm::WebIDL::Exception')) {
353     $state = 'before exception member';
354     } elsif ($current[-1]->isa ('Whatpm::WebIDL::Operation') or
355     $current[-1]->isa ('Whatpm::WebIDL::ExtendedAttribute')) {
356     $state = 'before argument in';
357     } else {
358     die "$0: Unknown xattr context: " . ref $current[-1];
359     }
360 wakaba 1.1 } else {
361     $onerror->(type => 'after xattr', level => 'm', token => $token);
362     # reconsume
363     $state = 'ignore';
364     $nest_level = 0;
365 wakaba 1.4 $next_state = 'before definitions'; ## TODO:
366 wakaba 1.1 }
367     } elsif ($state eq 'before def') {
368     if ($token->{type} eq 'module') {
369     $token = $get_next_token->();
370     if ($token->{type} eq 'identifier') {
371 wakaba 1.9 my $identifier = $token->{value};
372     $identifier =~ s/^_//;
373     push @current, Whatpm::WebIDL::Module->new ($identifier);
374     $current[-1]->set_user_data (manakai_source_line => $line);
375     $current[-1]->set_user_data (manakai_source_column => $column);
376 wakaba 1.4 $current[-1]->set_extended_attribute_node ($_) for @$xattrs;
377 wakaba 1.1 $token = $get_next_token->();
378     $state = 'before module block';
379     next;
380     } else {
381     $onerror->(type => 'module identifier',
382     level => $self->{must_level});
383     #
384     }
385     } elsif ($token->{type} eq 'interface') {
386     $token = $get_next_token->();
387     if ($token->{type} eq 'identifier') {
388 wakaba 1.9 my $identifier = $token->{value};
389     $identifier =~ s/^_//;
390     push @current, Whatpm::WebIDL::Interface->new ($identifier);
391 wakaba 1.8 $current[-1]->set_user_data (manakai_source_line => $line);
392     $current[-1]->set_user_data (manakai_source_column => $column);
393 wakaba 1.4 $current[-1]->set_extended_attribute_node ($_) for @$xattrs;
394 wakaba 1.1 $token = $get_next_token->();
395     $state = 'before interface inheritance';
396     next;
397     } else {
398     $onerror->(type => 'interface identifier',
399     level => $self->{must_level});
400     #
401     }
402     } elsif ($token->{type} eq 'exception') {
403     $token = $get_next_token->();
404     if ($token->{type} eq 'identifier') {
405 wakaba 1.9 my $identifier = $token->{value};
406     $identifier =~ s/^_//;
407     push @current, Whatpm::WebIDL::Exception->new ($identifier);
408     $current[-1]->set_user_data (manakai_source_line => $line);
409     $current[-1]->set_user_data (manakai_source_column => $column);
410 wakaba 1.4 $current[-1]->set_extended_attribute_node ($_) for @$xattrs;
411 wakaba 1.1 $token = $get_next_token->();
412     $state = 'before exception block';
413     next;
414     } else {
415     $onerror->(type => 'exception identifier',
416     level => $self->{must_level});
417     #
418     }
419     } elsif ($token->{type} eq 'typedef') {
420     $token = $get_next_token->();
421     $state = 'before typedef type';
422     next;
423     } elsif ($token->{type} eq 'valuetype') {
424     $token = $get_next_token->();
425     if ($token->{type} eq 'identifier') {
426 wakaba 1.9 my $identifier = $token->{value};
427     $identifier =~ s/^_//;
428     push @current, Whatpm::WebIDL::Valuetype->new ($identifier);
429     $current[-1]->set_user_data (manakai_source_line => $line);
430     $current[-1]->set_user_data (manakai_source_column => $column);
431 wakaba 1.4 $current[-1]->set_extended_attribute_node ($_) for @$xattrs;
432 wakaba 1.1 $token = $get_next_token->();
433     $state = 'before boxed type';
434     next;
435     } elsif ($token->{type} eq 'DOMString') {
436     push @current, Whatpm::WebIDL::Valuetype->new ('::DOMString::');
437 wakaba 1.9 $current[-1]->set_user_data (manakai_source_line => $line);
438     $current[-1]->set_user_data (manakai_source_column => $column);
439 wakaba 1.4 $current[-1]->set_extended_attribute_node ($_) for @$xattrs;
440 wakaba 1.1 $token = $get_next_token->();
441     if ($token->{type} eq 'sequence') {
442     $token = $get_next_token->();
443     if ($token->{type} eq '<') {
444     $token = $get_next_token->();
445     if ($token->{type} eq 'unsigned') {
446     $token = $get_next_token->();
447     if ($token->{type} eq 'short') {
448     $token = $get_next_token->();
449     if ($token->{type} eq '>') {
450 wakaba 1.11 $current[-1]->type ('::::sequence::::::unsigned short::');
451 wakaba 1.1 $token = $get_next_token->();
452     $state = 'before semicolon';
453     $next_state = 'before definitions';
454     next;
455     } else {
456     $onerror->(type => 'valuetype DOMString sequence lt unsigned short gt',
457     level => $self->{must_level});
458     #
459     }
460     } else {
461     $onerror->(type => 'valuetype DOMString sequence lt unsigned short',
462     level => $self->{must_level});
463     #
464     }
465     } else {
466     $onerror->(type => 'valuetype DOMString sequence lt unsigned',
467     level => $self->{must_level});
468     #
469     }
470     } else {
471     $onerror->(type => 'valuetype DOMString sequence lt',
472     level => $self->{must_level});
473     #
474     }
475     } else {
476     $onerror->(type => 'valuetype DOMString sequence',
477     level => $self->{must_level});
478     #
479     }
480 wakaba 1.8 pop @current; # valuetype
481 wakaba 1.1 #
482     } else {
483     $onerror->(type => 'valuetype identifier',
484     level => $self->{must_level});
485     #
486     }
487     } elsif ($token->{type} eq 'const') {
488     $token = $get_next_token->();
489     $state = 'before const type';
490     $next_state = 'before definitions';
491     next;
492     } else {
493     $onerror->(type => 'before definition', level => 'm',
494     token => $token);
495     # reconsume
496     #
497     }
498     $state = 'ignore';
499     $nest_level = 0;
500     $next_state = 'before definitions';
501     } elsif ($state eq 'before module block') {
502     if ($token->{type} eq '{') {
503     $token = $get_next_token->();
504     $state = 'before definitions';
505     } else {
506     $onerror->(type => 'before module block', level => 'm',
507     token => $token);
508     pop @current; # module
509     # reconsume
510     $state = 'ignore';
511     $nest_level = 0;
512     $next_state = 'before definitions';
513     }
514     } elsif ($state eq 'before interface inheritance') {
515     if ($token->{type} eq ':') {
516     $token = $get_next_token->();
517     $state = 'before parent interface name';
518 wakaba 1.8 } elsif ($token->{type} eq ';') {
519     $current[-1]->is_forward_declaration (1);
520     # reconsume
521     $state = 'before semicolon';
522     $next_state = 'before interface member';
523 wakaba 1.1 } else {
524     # reconsume
525     $state = 'before interface block';
526     }
527     } elsif ($state eq 'before parent interface name') {
528     my $name = $get_scoped_name->();
529     if (defined $name) {
530     $current[-1]->append_inheritance ($name);
531    
532     if ($token->{type} eq ',') {
533     $token = $get_next_token->();
534     # stay in the state
535     } else {
536     # reconsume
537     $state = 'before interface block';
538     }
539     } else {
540     $onerror->(type => 'scoped name', level => $self->{must_level});
541     # reconsume
542     $state = 'ignore';
543     $nest_level = 0;
544     }
545 wakaba 1.2 } elsif ($state eq 'before exception name') {
546     my $name = $get_scoped_name->();
547     if (defined $name) {
548     my $method = $next_state eq '*raises' ? 'append_raises' :
549     $next_state eq '*getraises' ? 'append_getraises' :
550     'append_setraises';
551     $current[-1]->$method ($name);
552    
553     if ($token->{type} eq ',') {
554     $token = $get_next_token->();
555     # stay in the state
556     } elsif ($token->{type} eq ')') {
557     $token = $get_next_token->();
558     if ($next_state eq '*getraises' and $token->{type} eq 'setraises') {
559     $token = $get_next_token->();
560     $state = 'after raises';
561     $next_state = '*setraises';
562     } else {
563     # reprocess
564     $state = 'before semicolon';
565     $next_state = 'before interface member';
566     }
567     } else {
568     $onerror->(type => 'after exception name',
569     level => $self->{must_level});
570     # reconsume
571     $state = 'ignore';
572     $nest_level = 0;
573     }
574     } else {
575     $onerror->(type => 'scoped name', level => $self->{must_level});
576     # reconsume
577     $state = 'ignore';
578     $nest_level = 0;
579     }
580 wakaba 1.1 } elsif ($state eq 'before interface block') {
581     if ($token->{type} eq '{') {
582     $token = $get_next_token->();
583     $state = 'before members';
584     $next_state = 'before interface member';
585     } else {
586     $onerror->(type => 'before interface block',
587     level => $self->{must_level});
588 wakaba 1.8 pop @current; # interface
589 wakaba 1.1 # reconsume
590     $state = 'ignore';
591     $nest_level = 0;
592     }
593     } elsif ($state eq 'before exception block') {
594     if ($token->{type} eq '{') {
595     $token = $get_next_token->();
596     $state = 'before members';
597     $next_state = 'before exception member';
598     } else {
599     $onerror->(type => 'before exception block',
600     level => $self->{must_level});
601     # reconsume
602     $state = 'ignore';
603     $nest_level = 0;
604     }
605     } elsif ($state eq 'before members') {
606 wakaba 1.4 $xattrs = [];
607 wakaba 1.1 if ($token->{type} eq '[') {
608     $token = $get_next_token->();
609     $state = 'before xattr';
610     #$next_state = $next_state; # 'before interface member' or ...
611     } elsif ($token->{type} eq '}') {
612     $token = $get_next_token->();
613 wakaba 1.5 $state = 'before block semicolon';
614 wakaba 1.1 } else {
615     # reconsume
616     $state = $next_state; # ... 'before exception member'
617     }
618     } elsif ($state eq 'before interface member') {
619     if ($token->{type} eq 'const') {
620     $token = $get_next_token->();
621     $state = 'before const type';
622     $next_state = 'before definitions';
623     } elsif ($token->{type} eq 'readonly') {
624     $read_only = 1;
625     $token = $get_next_token->();
626     if ($token->{type} eq 'attribute') {
627     $token = $get_next_token->();
628     $state = 'after attribute';
629     } else {
630     # reconsume
631     $state = 'ignore';
632     $nest_level = 0;
633     $next_state = 'before interface member';
634     }
635     } elsif ($token->{type} eq 'attribute') {
636     $read_only = 0;
637     $token = $get_next_token->();
638     $state = 'after attribute';
639     } elsif ({
640     void => 1, any => 1, boolean => 1, octet => 1, float => 1,
641     DOMString => 1, Object => 1, unsigned => 1, short => 1, long => 1,
642     '::' => 1, identifier => 1,
643     }->{$token->{type}}) {
644     # reconsume
645     $state = 'before operation type';
646     } elsif ($token->{type} eq '}') {
647     $token = $get_next_token->();
648     $state = 'before semicolon';
649     $next_state = 'before definitions';
650     } elsif ($token->{type} eq 'eof') {
651     last;
652     } else {
653     $onerror->(type => 'before interface member',
654     level => $self->{must_level});
655     # reconsume
656     $state = 'ignore';
657     $nest_level = 0;
658     }
659     } elsif ($state eq 'before exception member') {
660     if ({
661     void => 1, any => 1, boolean => 1, octet => 1, float => 1,
662     DOMString => 1, Object => 1, unsigned => 1, short => 1, long => 1,
663     '::' => 1, identifier => 1,
664     }->{$token->{type}}) {
665 wakaba 1.3 # reconsume
666     $state = 'before exception member type';
667 wakaba 1.1 } elsif ($token->{type} eq '}') {
668     $token = $get_next_token->();
669     $state = 'before semicolon';
670     $next_state = 'before definitions';
671     } elsif ($token->{type} eq 'eof') {
672     last;
673     } else {
674     $onerror->(type => 'before exception member',
675     level => $self->{must_level});
676     # reconsume
677     $state = 'ignore';
678     $nest_level = 0;
679     }
680     } elsif ($state eq 'before typedef type') {
681     if ({
682     void => 1, any => 1, boolean => 1, octet => 1, float => 1,
683     DOMString => 1, Object => 1, short => 1, long => 1, unsigned => 1,
684     sequence => 1, '::' => 1, identifier => 1,
685     }->{$token->{type}}) {
686     $current_type = $get_type->();
687     if (defined $current_type) {
688     # next token
689     $state = 'before typedef rest';
690     } else {
691     # reconsume
692     $state = 'ignore';
693     $nest_level = 0;
694     $next_state = 'before definitions';
695     }
696     } else {
697     $onerror->(type => 'before type', level => $self->{must_level});
698     # reconsume
699     $state = 'ignore';
700     $nest_level = 0;
701     $next_state = 'before definitions';
702     }
703     } elsif ($state eq 'before boxed type') {
704     if ({
705     boolean => 1, octet => 1, float => 1,
706     short => 1, long => 1, unsigned => 1,
707     sequence => 1, '::' => 1, identifier => 1,
708     }->{$token->{type}}) {
709     $current_type = $get_type->();
710     if (defined $current_type) {
711     $current[-1]->type ($current_type);
712     # next token
713     $state = 'before semicolon';
714     $next_state = 'before definitions';
715     } else {
716 wakaba 1.8 pop @current; # valuetype
717 wakaba 1.1 # reconsume
718     $state = 'ignore';
719     $nest_level = 0;
720     $next_state = 'before definitions';
721     }
722     } else {
723     $onerror->(type => 'before boxed type', level => $self->{must_level});
724 wakaba 1.8 pop @current; # valuetype
725 wakaba 1.1 # reconsume
726     $state = 'ignore';
727     $nest_level = 0;
728     $next_state = 'before definitions';
729     }
730     } elsif ($state eq 'before const type') {
731     if ({
732     any => 1, boolean => 1, octet => 1, float => 1,
733     DOMString => 1, Object => 1, short => 1, long => 1, unsigned => 1,
734     '::' => 1, identifier => 1,
735     }->{$token->{type}}) {
736     $current_type = $get_type->();
737     if (defined $current_type) {
738     # next token
739     $state = 'before const identifier';
740     } else {
741     # reconsume
742     $state = 'ignore';
743     $nest_level = 0;
744     #$next_state = $next_state;
745     }
746     } else {
747     $onerror->(type => 'before type', level => $self->{must_level});
748     # reconsume
749     $state = 'ignore';
750     $nest_level = 0;
751     #$next_state = $next_state;
752     }
753     } elsif ($state eq 'before typedef rest') {
754     if ($token->{type} eq 'identifier') {
755     ## TODO: unescape
756     push @current, Whatpm::WebIDL::Typedef->new ($token->{value});
757 wakaba 1.9 $current[-1]->set_user_data (manakai_source_line => $line);
758     $current[-1]->set_user_data (manakai_source_column => $column);
759 wakaba 1.1 $current[-1]->type ($current_type);
760 wakaba 1.4 $current[-1]->set_extended_attribute_node ($_) for @$xattrs;
761 wakaba 1.1 $token = $get_next_token->();
762     $state = 'before semicolon';
763     $next_state = 'before definitions';
764     } elsif ($token->{type} eq 'DOMString') {
765     push @current, Whatpm::WebIDL::Typedef->new ('::DOMString::');
766     $current[-1]->type ($current_type);
767 wakaba 1.9 $current[-1]->set_user_data (manakai_source_line => $line);
768     $current[-1]->set_user_data (manakai_source_column => $column);
769 wakaba 1.4 $current[-1]->set_extended_attribute_node ($_) for @$xattrs;
770 wakaba 1.1 $token = $get_next_token->();
771     $state = 'before semicolon';
772     $next_state = 'before defnitions';
773     } else {
774     $onerror->(type => 'before typedef rest',
775     level => $self->{must_level});
776     # reconsume
777     $state = 'ignore';
778     $nest_level = 0;
779     $next_state = 'before definitions';
780     }
781     } elsif ($state eq 'before const identifier') {
782     if ($token->{type} eq 'identifier') {
783 wakaba 1.9 my $identifier = $token->{value};
784     $identifier =~ s/^_//;
785     push @current, Whatpm::WebIDL::Const->new ($identifier);
786     $current[-1]->set_user_data (manakai_source_line => $line);
787     $current[-1]->set_user_data (manakai_source_column => $column);
788 wakaba 1.1 $current[-1]->type ($current_type);
789 wakaba 1.4 $current[-1]->set_extended_attribute_node ($_) for @$xattrs;
790 wakaba 1.1 $token = $get_next_token->();
791     if ($token->{type} eq '=') {
792     $token = $get_next_token->();
793     $state = 'before const expr';
794     next;
795     } else {
796     $onerror->(type => 'const eq', level => $self->{must_level});
797     #
798     }
799     } else {
800     $onerror->(type => 'const identifier', level => $self->{must_level});
801     #
802     }
803     # reconsume
804     $state = 'ignore';
805     $nest_level = 0;
806     #$next_state = $next_state;
807     } elsif ($state eq 'before const expr') {
808     if ($token->{type} eq 'TRUE' or $token->{type} eq 'FALSE') {
809     $current[-1]->value ([$token->{type}]);
810     #
811 wakaba 1.11 } elsif ($token->{type} eq 'integer') {
812     if ($token->{value} =~ /^0[Xx]/) {
813     $current[-1]->value ([$token->{type}, hex substr $token->{value},2]);
814     } elsif ($token->{value} =~ /^-0[Xx]/) {
815     $current[-1]->value ([$token->{type},-hex substr $token->{value},3]);
816     } elsif ($token->{value} =~ /^0/) {
817     $current[-1]->value ([$token->{type}, oct $token->{value}]);
818     } elsif ($token->{value} =~ /^-0/) {
819     $current[-1]->value ([$token->{type},-oct substr $token->{value},1]);
820     } else {
821     $current[-1]->value ([$token->{type}, 0+$token->{value}]);
822     }
823     #
824     } elsif ($token->{type} eq 'float') {
825     $current[-1]->value ([$token->{type}, 0+$token->{value}]);
826 wakaba 1.1 #
827     } else {
828     # reconsume
829     $state = 'ignore';
830     $nest_level = 0;
831     #$next_state = $next_state;
832     next;
833     }
834    
835     $token = $get_next_token->();
836     $state = 'before semicolon';
837     #$next_state = $next_state;
838     } elsif ($state eq 'after attribute') {
839     if ({
840     any => 1, boolean => 1, octet => 1, float => 1,
841     DOMString => 1, Object => 1, short => 1, long => 1, unsigned => 1,
842     '::' => 1, identifier => 1,
843     }->{$token->{type}}) {
844     $current_type = $get_type->();
845     if (defined $current_type) {
846     # next token
847     $state = 'before attribute identifier';
848     } else {
849     # reconsume
850     $state = 'ignore';
851     $nest_level = 0;
852     $next_state = 'before interface member';
853     }
854     } else {
855     $onerror->(type => 'before type', level => $self->{must_level});
856     # reconsume
857     $state = 'ignore';
858     $nest_level = 0;
859     $next_state = 'before interface member';
860     }
861 wakaba 1.3 } elsif ($state eq 'before exception member type') {
862     if ({
863     any => 1, boolean => 1, octet => 1, float => 1,
864     DOMString => 1, Object => 1, short => 1, long => 1, unsigned => 1,
865     '::' => 1, identifier => 1,
866     }->{$token->{type}}) {
867     $current_type = $get_type->();
868     if (defined $current_type) {
869     # next token
870     $state = 'before exception member identifier';
871     } else {
872     # reconsume
873     $state = 'ignore';
874     $nest_level = 0;
875     $next_state = 'before exception member';
876     }
877     } else {
878     $onerror->(type => 'before type', level => $self->{must_level});
879     # reconsume
880     $state = 'ignore';
881     $nest_level = 0;
882     $next_state = 'before exception member';
883     }
884 wakaba 1.1 } elsif ($state eq 'before operation type') {
885     if ({
886     any => 1, boolean => 1, octet => 1, float => 1,
887     DOMString => 1, Object => 1, short => 1, long => 1, unsigned => 1,
888     '::' => 1, identifier => 1,
889     void => 1,
890     }->{$token->{type}}) {
891     $current_type = $get_type->();
892     if (defined $current_type) {
893     # next token
894     $state = 'before operation identifier';
895     } else {
896     # reconsume
897     $state = 'ignore';
898     $nest_level = 0;
899     $next_state = 'before interface member';
900     }
901     } else {
902     $onerror->(type => 'before type', level => $self->{must_level});
903     # reconsume
904     $state = 'ignore';
905     $nest_level = 0;
906     $next_state = 'before interface member';
907     }
908     } elsif ($state eq 'before argument type') {
909     if ({
910     any => 1, boolean => 1, octet => 1, float => 1,
911     DOMString => 1, Object => 1, short => 1, long => 1, unsigned => 1,
912     '::' => 1, identifier => 1,
913     }->{$token->{type}}) {
914     $current_type = $get_type->();
915     if (defined $current_type) {
916     # next token
917     $state = 'before argument identifier';
918     } else {
919     # reconsume
920     $state = 'ignore';
921     $nest_level = 0;
922     }
923     } else {
924     $onerror->(type => 'before type', level => $self->{must_level});
925     # reconsume
926     $state = 'ignore';
927     $nest_level = 0;
928     }
929     } elsif ($state eq 'before attribute identifier') {
930     if ($token->{type} eq 'identifier') {
931 wakaba 1.10 my $identifier = $token->{value};
932     $identifier =~ s/^_//;
933     push @current, Whatpm::WebIDL::Attribute->new ($identifier);
934 wakaba 1.9 $current[-1]->set_user_data (manakai_source_line => $line);
935     $current[-1]->set_user_data (manakai_source_column => $column);
936 wakaba 1.1 $current[-1]->readonly ($read_only);
937     $current[-1]->type ($current_type);
938 wakaba 1.4 $current[-1]->set_extended_attribute_node ($_) for @$xattrs;
939 wakaba 1.1 $token = $get_next_token->();
940     if ($token->{type} eq 'getraises') {
941     $token = $get_next_token->();
942 wakaba 1.2 $state = 'after raises';
943     $next_state = '*getraises';
944 wakaba 1.1 next;
945     } elsif ($token->{type} eq 'setraises') {
946     $token = $get_next_token->();
947 wakaba 1.2 $state = 'after raises';
948     $next_state = '*setraises';
949 wakaba 1.1 next;
950     } else {
951     # reconsume
952     $state = 'before semicolon';
953     $next_state = 'before interface member';
954     next;
955     }
956     } else {
957     $onerror->(type => 'attribute identifier',
958     level => $self->{must_level});
959     #
960     }
961     # reconsume
962     $state = 'ignore';
963     $nest_level = 0;
964 wakaba 1.3 $next_state = 'before interface member';
965     } elsif ($state eq 'before exception member identifier') {
966     if ($token->{type} eq 'identifier') {
967     ## TODO: unescape
968     push @current, Whatpm::WebIDL::ExceptionMember->new ($token->{value});
969 wakaba 1.9 $current[-1]->set_user_data (manakai_source_line => $line);
970     $current[-1]->set_user_data (manakai_source_column => $column);
971 wakaba 1.3 $current[-1]->type ($current_type);
972 wakaba 1.4 $current[-1]->set_extended_attribute_node ($_) for @$xattrs;
973 wakaba 1.3 $token = $get_next_token->();
974     $state = 'before semicolon';
975     $next_state = 'before exception member';
976     } else {
977     $onerror->(type => 'exception member identifier',
978     level => $self->{must_level});
979     # reconsume
980     $state = 'ignore';
981     $nest_level = 0;
982     }
983 wakaba 1.1 } elsif ($state eq 'before operation identifier') {
984     if ($token->{type} eq 'identifier') {
985     ## TODO: unescape
986     push @current, Whatpm::WebIDL::Operation->new ($token->{value});
987 wakaba 1.9 $current[-1]->set_user_data (manakai_source_line => $line);
988     $current[-1]->set_user_data (manakai_source_column => $column);
989 wakaba 1.1 $current[-1]->type ($current_type);
990 wakaba 1.4 $current[-1]->set_extended_attribute_node ($_) for @$xattrs;
991 wakaba 1.1 $token = $get_next_token->();
992     if ($token->{type} eq '(') {
993     $token = $get_next_token->();
994     if ($token->{type} eq ')') {
995     $token = $get_next_token->();
996 wakaba 1.2 $state = 'before raises';
997     $next_state = '*raises';
998 wakaba 1.1 next;
999     } else {
1000     # reconsume
1001     $state = 'before argument';
1002     next;
1003     }
1004     } else {
1005     $onerror->(type => 'arguments lparen',
1006     level => $self->{must_level});
1007     #
1008     }
1009     } else {
1010     $onerror->(type => 'operation identifier',
1011     level => $self->{must_level});
1012     #
1013     }
1014     # reconsume
1015     $state = 'ignore';
1016     $nest_level = 0;
1017 wakaba 1.3 $next_state = 'before interface member';
1018 wakaba 1.1 } elsif ($state eq 'before argument identifier') {
1019     if ($token->{type} eq 'identifier') {
1020     ## TODO: unescape
1021     my $arg = Whatpm::WebIDL::Argument->new ($token->{value});
1022 wakaba 1.9 $arg->set_user_data (manakai_source_line => $line);
1023     $arg->set_user_data (manakai_source_column => $column);
1024 wakaba 1.1 $arg->type ($current_type);
1025 wakaba 1.4 $arg->set_extended_attribute_node ($_) for @$xattrs;
1026 wakaba 1.1 $current[-1]->append_child ($arg);
1027     $token = $get_next_token->();
1028     if ($token->{type} eq ')') {
1029     $token = $get_next_token->();
1030 wakaba 1.4 if ($current[-1]->isa ('Whatpm::WebIDL::Operation')) {
1031     $state = 'before raises';
1032     } else {
1033     $state = 'after xattrarg';
1034     }
1035 wakaba 1.1 next;
1036     } elsif ($token->{type} eq ',') {
1037     $token = $get_next_token->();
1038     $state = 'before argument';
1039     next;
1040     } else {
1041     $onerror->(type => 'after argument',
1042     level => $self->{must_level});
1043     #
1044     }
1045     } else {
1046     $onerror->(type => 'argument identifier',
1047     level => $self->{must_level});
1048     #
1049     }
1050     # reconsume
1051     $state = 'ignore';
1052     $nest_level = 0;
1053     } elsif ($state eq 'before argument') {
1054 wakaba 1.4 $xattrs = [];
1055 wakaba 1.1 if ($token->{type} eq '[') {
1056     $token = $get_next_token->();
1057     $state = 'before xattr';
1058     $next_state = 'before argument in';
1059     } else {
1060     # reconsume
1061     $state = 'before argument in';
1062     }
1063     } elsif ($state eq 'before argument in') {
1064     if ($token->{type} eq 'in') {
1065     $token = $get_next_token->();
1066     $state = 'before argument type';
1067     } else {
1068     $onerror->(type => 'argument in',
1069     level => $self->{must_level});
1070     $state = 'ignore';
1071     $nest_level = 0;
1072     }
1073     } elsif ($state eq 'before raises') {
1074     if ($token->{type} eq 'raises') {
1075     $token = $get_next_token->();
1076     $state = 'after raises';
1077 wakaba 1.2 $next_state = '*raises';
1078 wakaba 1.1 } else {
1079     # reconsume
1080     $state = 'before semicolon';
1081     $next_state = 'before interface member';
1082     }
1083     } elsif ($state eq 'after raises') {
1084 wakaba 1.2 if ($token->{type} eq '(') {
1085     $token = $get_next_token->();
1086     $state = 'before exception name';
1087     } else {
1088     $onerror->(type => 'raises lparen',
1089     level => $self->{must_level});
1090     $state = 'ignore';
1091     $nest_level = 0;
1092     }
1093 wakaba 1.1 } elsif ($state eq 'before semicolon') {
1094     if ($token->{type} eq ';') {
1095     $current[-2]->append_child ($current[-1]);
1096     pop @current;
1097     $token = $get_next_token->();
1098 wakaba 1.5 if ($current[-1]->isa ('Whatpm::WebIDL::Definitions') or
1099     $current[-1]->isa ('Whatpm::WebIDL::Module')) {
1100     $state = 'before definitions';
1101     } elsif ($current[-1]->isa ('Whatpm::WebIDL::Interface')) {
1102     $state = 'before members';
1103     $next_state = 'before interface member';
1104     } else {
1105     $state = 'before members';
1106     $next_state = 'before exception member';
1107     }
1108 wakaba 1.1 } else {
1109 wakaba 1.5 $onerror->(type => 'before semicolon', level => 'm',
1110     token => $token);
1111     # reconsume
1112     $state = 'ignore';
1113     $nest_level = 0;
1114     }
1115     } elsif ($state eq 'before block semicolon') {
1116     if ($token->{type} eq ';') {
1117     $current[-2]->append_child ($current[-1]);
1118 wakaba 1.1 pop @current;
1119 wakaba 1.5 $token = $get_next_token->();
1120     if ($current[-1]->isa ('Whatpm::WebIDL::Definitions') or
1121     $current[-1]->isa ('Whatpm::WebIDL::Module')) {
1122     $state = 'before definitions';
1123     } elsif ($current[-1]->isa ('Whatpm::WebIDL::Interface')) {
1124     $state = 'before members';
1125     $next_state = 'before interface member';
1126     } else {
1127     $state = 'before members';
1128     $next_state = 'before exception member';
1129     }
1130     } else {
1131 wakaba 1.1 $onerror->(type => 'before semicolon', level => 'm',
1132     token => $token);
1133 wakaba 1.5 pop @current; # avoid appended by 'ignore'
1134 wakaba 1.1 # reconsume
1135     $state = 'ignore';
1136     $nest_level = 0;
1137     }
1138     } elsif ($state eq 'ignore') {
1139 wakaba 1.5 if ($nest_level == 0 and $token->{type} eq ';') {
1140     while (@current > 1) {
1141     if ($current[-1]->isa ('Whatpm::WebIDL::Interface') or
1142     $current[-1]->isa ('Whatpm::WebIDL::Exception') or
1143     $current[-1]->isa ('Whatpm::WebIDL::Module')) {
1144     last;
1145     }
1146     pop @current;
1147     }
1148    
1149 wakaba 1.1 $token = $get_next_token->();
1150 wakaba 1.5 if ($current[-1]->isa ('Whatpm::WebIDL::Definitions') or
1151     $current[-1]->isa ('Whatpm::WebIDL::Module')) {
1152     $state = 'before definitions';
1153     } elsif ($current[-1]->isa ('Whatpm::WebIDL::Interface')) {
1154     $state = 'before members';
1155     $next_state = 'before interface member';
1156     } else {
1157     $state = 'before members';
1158     $next_state = 'before exception member';
1159     }
1160 wakaba 1.1 } elsif ($token->{type} eq '{') {
1161     $nest_level++;
1162     $token = $get_next_token->();
1163     # stay in the state
1164     } elsif ($nest_level and $token->{type} eq '}') {
1165     $nest_level--;
1166     $token = $get_next_token->();
1167     # stay in the state
1168     } elsif ($token->{type} eq 'eof') {
1169 wakaba 1.5 while (@current > 1) {
1170     if ($current[-1]->isa ('Whatpm::WebIDL::Interface') or
1171     $current[-1]->isa ('Whatpm::WebIDL::Exception') or
1172     $current[-1]->isa ('Whatpm::WebIDL::Module')) {
1173     last;
1174     }
1175     pop @current;
1176     }
1177    
1178 wakaba 1.1 last;
1179     } else {
1180     # ignore the token
1181     $token = $get_next_token->();
1182     # stay in the state
1183     }
1184     } else {
1185     die "parse_char_string: unkown state: $state";
1186     }
1187     }
1188    
1189     if (@current > 1) {
1190 wakaba 1.5 $onerror->(type => 'premature end of file', level => $self->{must_level});
1191     while (@current > 1) {
1192     $current[-2]->append_child ($current[-1]);
1193     pop @current;
1194     }
1195 wakaba 1.1 }
1196    
1197     $get_type = undef; # unlink loop
1198    
1199     return $defs;
1200     } # parse_char_string
1201    
1202 wakaba 1.8 package Whatpm::WebIDL::Node;
1203 wakaba 1.1
1204 wakaba 1.9 require Scalar::Util;
1205    
1206 wakaba 1.1 sub new ($) {
1207     return bless {child_nodes => []}, $_[0];
1208     } # new
1209    
1210     sub append_child ($$) {
1211     my $self = shift;
1212     my $child = shift;
1213    
1214     ## TODO: child type
1215     ## TODO: parent check
1216    
1217     push @{$self->{child_nodes}}, $child;
1218    
1219 wakaba 1.9 $child->{parent_node} = $self;
1220     Scalar::Util::weaken ($child->{parent_node});
1221    
1222 wakaba 1.1 return $child;
1223     } # append_child
1224    
1225 wakaba 1.8 sub child_nodes ($) {
1226     return [@{$_[0]->{child_nodes}}]; # dead list
1227     } # child_nodes
1228    
1229     sub idl_text ($) {
1230     return '[[ERROR: ' . (ref $_[0]) . '->idl_text]]';
1231     } # idl_text
1232    
1233 wakaba 1.1 sub node_name ($) {
1234 wakaba 1.8 return $_[0]->{node_name}; # may be undef
1235 wakaba 1.1 } # node_name
1236    
1237 wakaba 1.9 sub parent_node ($) {
1238     return $_[0]->{parent_node};
1239     } # parent_node
1240    
1241 wakaba 1.8 sub get_user_data ($$) {
1242     return $_[0]->{user_data}->{$_[1]};
1243     } # get_user_data
1244    
1245     sub set_user_data ($$$) {
1246     if (defined $_[2]) {
1247     $_[0]->{user_data}->{$_[1]} = ''.$_[2];
1248     } else {
1249     delete $_[0]->{user_data}->{$_[1]};
1250     }
1251     } # set_user_data
1252    
1253     package Whatpm::WebIDL::Definitions;
1254     push our @ISA, 'Whatpm::WebIDL::Node';
1255    
1256     sub idl_text ($) {
1257     return join "\x0A", map {$_->idl_text} @{$_[0]->{child_nodes}};
1258     } # idl_text
1259    
1260     sub check ($$) {
1261     my ($self, $onerror) = @_;
1262    
1263 wakaba 1.11 my $check_const_value = sub ($) {
1264     my $item = shift;
1265    
1266     my $type = $item->{node}->type;
1267     my $value = $item->{node}->value;
1268    
1269     ## NOTE: Although it is not explicitly spelled out in the spec,
1270     ## it can be assumed, imho, that "any" type accepts all of these
1271     ## constant values.
1272     ## ISSUE: Should I ask the editor to clarify the spec about this?
1273    
1274     if ($value->[0] eq 'TRUE' or $value->[0] eq 'FALSE') {
1275     if ($type eq '::boolean::') {
1276     #
1277     } elsif ($type eq '::any::') {
1278     #
1279     } else {
1280     $onerror->(type => 'const type mismatch',
1281     level => 'm',
1282     node => $item->{node},
1283     text => $item->{node}->type_text,
1284     value => $value->[0]);
1285     }
1286     } elsif ($value->[0] eq 'integer') {
1287     if ($type eq '::octet::') {
1288     if ($value->[1] < 0 or 255 < $value->[1]) {
1289     $onerror->(type => 'const value out of range',
1290     level => 'm',
1291     node => $item->{node},
1292     value => $value->[1]);
1293     }
1294     } elsif ($type eq '::short::') {
1295     if ($value->[1] < -32768 or 32767 < $value->[1]) {
1296     $onerror->(type => 'const value out of range',
1297     level => 'm',
1298     node => $item->{node},
1299     value => $value->[1]);
1300     }
1301     } elsif ($type eq '::unsigned short::') {
1302     if ($value->[1] < 0 or 65535 < $value->[1]) {
1303     $onerror->(type => 'const value out of range',
1304     level => 'm',
1305     node => $item->{node},
1306     value => $value->[1]);
1307     }
1308     } elsif ($type eq '::long::') {
1309     if ($value->[1] < -2147483648 or 2147483647 < $value->[1]) {
1310     $onerror->(type => 'const value out of range',
1311     level => 'm',
1312     node => $item->{node},
1313     value => $value->[1]);
1314     }
1315     } elsif ($type eq '::unsigned long::') {
1316     if ($value->[1] < 0 or 4294967295 < $value->[1]) {
1317     $onerror->(type => 'const value out of range',
1318     level => 'm',
1319     node => $item->{node},
1320     value => $value->[1]);
1321     }
1322     } elsif ($type eq '::long long::') {
1323     if ($value->[1] < -9223372036854775808 or
1324     9223372036854775807 < $value->[1]) {
1325     $onerror->(type => 'const value out of range',
1326     level => 'm',
1327     node => $item->{node},
1328     value => $value->[1]);
1329     }
1330     } elsif ($type eq '::unsigned long long::') {
1331     if ($value->[1] < 0 or 18446744073709551615 < $value->[1]) {
1332     $onerror->(type => 'const value out of range',
1333     level => 'm',
1334     node => $item->{node},
1335     value => $value->[1]);
1336     }
1337     } elsif ($type eq '::any::') {
1338     if ($value->[1] < -9223372036854775808 or
1339     18446744073709551615 < $value->[1]) {
1340     $onerror->(type => 'const value out of range',
1341     level => 'm',
1342     node => $item->{node},
1343     value => $value->[1]);
1344     }
1345     } else {
1346     $onerror->(type => 'const type mismatch',
1347     level => 'm',
1348     node => $item->{node},
1349     text => $item->{node}->type_text,
1350     value => $value->[1]);
1351     }
1352     } elsif ($value->[0] eq 'float') {
1353     if ($type eq '::float::' or $type eq '::any::') {
1354     #
1355     } else {
1356     $onerror->(type => 'const type mismatch',
1357     level => 'm',
1358     node => $item->{node},
1359     text => $item->{node}->type_text,
1360     value => $value->[1]);
1361     }
1362     }
1363     ## NOTE: Otherwise, an error of the implementation or the application.
1364     }; # $check_const_value
1365    
1366 wakaba 1.10 my $items = [map { {node => $_, scope => '::'} } @{$self->{child_nodes}}];
1367 wakaba 1.9
1368     my $defined_qnames = {};
1369    
1370     while (@$items) {
1371     my $item = shift @$items;
1372 wakaba 1.10 if ($item->{node}->isa ('Whatpm::WebIDL::Definition') and
1373     not $item->{defined_members}) {
1374 wakaba 1.9 if ($item->{node}->isa ('Whatpm::WebIDL::Interface')) {
1375 wakaba 1.10 for my $i_sn (@{$item->{node}->{inheritances}}) {
1376     if ($i_sn =~ /::DOMString\z/) {
1377     #
1378     } elsif ($i_sn =~ /^::/) {
1379     if ($defined_qnames->{$i_sn}) {
1380     next;
1381     }
1382     #
1383     } else {
1384     if ($defined_qnames->{$item->{scope} . $i_sn} and
1385     $defined_qnames->{$item->{scope} . $i_sn}->{node}
1386     ->isa ('Whatpm::WebIDL::Interface')) {
1387     next;
1388     } elsif ($defined_qnames->{'::' . $i_sn} and
1389     $defined_qnames->{'::' . $i_sn}->{node}
1390     ->isa ('Whatpm::WebIDL::Interface')) {
1391     next;
1392     }
1393     #
1394     }
1395    
1396     $onerror->(type => 'interface not defined',
1397     level => 'm',
1398     node => $item->{node},
1399     text => $i_sn);
1400     }
1401    
1402     my $defined_members = {};
1403 wakaba 1.9 unshift @$items,
1404 wakaba 1.10 map { {node => $_, defined_members => $defined_members} }
1405 wakaba 1.9 @{$item->{node}->{child_nodes}};
1406    
1407     unless ($item->{parent}) {
1408     $onerror->(type => 'non-module definition',
1409     level => 's',
1410     node => $item->{node});
1411     }
1412     } elsif ($item->{node}->isa ('Whatpm::WebIDL::Exception')) {
1413     unshift @$items,
1414     map { {node => $_, parent => $item->{node}} }
1415     @{$item->{node}->{child_nodes}};
1416    
1417     unless ($item->{parent}) {
1418     $onerror->(type => 'non-module definition',
1419     level => 's',
1420     node => $item->{node});
1421     }
1422     } elsif ($item->{node}->isa ('Whatpm::WebIDL::Module')) {
1423     unshift @$items,
1424 wakaba 1.10 map {
1425     {node => $_, parent => $item->{node},
1426     scope => $item->{scope} . $item->{node}->node_name . '::'}
1427     }
1428 wakaba 1.9 @{$item->{node}->{child_nodes}};
1429 wakaba 1.11 } elsif ($item->{node}->isa ('Whatpm::WebIDL::Const')) {
1430     $check_const_value->($item);
1431    
1432     unless ($item->{parent}) {
1433     $onerror->(type => 'non-module definition',
1434     level => 's',
1435     node => $item->{node});
1436     }
1437 wakaba 1.9 } else {
1438     unless ($item->{parent}) {
1439     $onerror->(type => 'non-module definition',
1440     level => 's',
1441     node => $item->{node});
1442     }
1443     }
1444    
1445     my $qname = $item->{node}->qualified_name;
1446     if ($defined_qnames->{$qname}) {
1447     ## NOTE: "The identifier of a definition MUST be locally unique":
1448     ## Redundant with another requirement below.
1449    
1450 wakaba 1.10 ## ISSUE: |interface x; interface x {};| is non-conforming
1451     ## according to the current spec text.
1452    
1453     ## ISSUE: |interface x;| with no |interface x {};| is conforming
1454     ## according to the current spec text.
1455    
1456 wakaba 1.9 $onerror->(type => 'duplicate qname',
1457     level => 'm',
1458     node => $item->{node});
1459     } else {
1460 wakaba 1.10 $defined_qnames->{$qname} = $item;
1461     ## NOTE: This flag must be turned on AFTER inheritance check is
1462     ## performed (c.f. |interface x : x {};|).
1463 wakaba 1.9 }
1464     } elsif ($item->{node}->isa ('Whatpm::WebIDL::InterfaceMember')) {
1465     if ($item->{node}->isa ('Whatpm::WebIDL::Operation')) {
1466     unshift @$items,
1467     map { {node => $_, parent => $item->{node}} }
1468     @{$item->{node}->{child_nodes}};
1469 wakaba 1.10 } else {
1470     my $name = $item->{node}->node_name;
1471     if ($item->{defined_members}->{$name}) {
1472     $onerror->(type => 'duplicate interface member',
1473     level => 'm',
1474     node => $item->{node});
1475     ## ISSUE: Whether the example below is conforming or not
1476     ## is ambigious:
1477     ## |interface a { attribute any b; any b (); };|
1478     } else {
1479     $item->{defined_members}->{$name} = 1;
1480     }
1481 wakaba 1.11
1482     if ($item->{node}->isa ('Whatpm::WebIDL::Const')) {
1483     $check_const_value->($item);
1484     }
1485 wakaba 1.9 }
1486     }
1487    
1488     my $xattrs = $item->{node}->{xattrs} || [];
1489     for my $xattr (@$xattrs) {
1490     my $xattr_name = $xattr->node_name;
1491 wakaba 1.10 if ({
1492     Constructor => 1, NamedConstructor => 1, NativeObject => 1,
1493     NoInterfaceObject => 1, Stringifies => 1,
1494     }->{$xattr_name}) {
1495     if ($item->{node}->isa ('Whatpm::WebIDL::Interface')) {
1496    
1497     next;
1498     } else {
1499     #
1500     }
1501     } elsif ($xattr_name eq 'ExceptionConsts') {
1502 wakaba 1.9 if ($item->{node}->isa ('Whatpm::WebIDL::Module')) {
1503    
1504     next;
1505     } else {
1506     #
1507     }
1508 wakaba 1.11 } elsif ($item->{node}->isa ('Whatpm::WebIDL::Const')) {
1509     #
1510 wakaba 1.9 } else {
1511     $onerror->(type => 'unknown xattr',
1512     level => 'u',
1513     node => $xattr);
1514     next;
1515     }
1516 wakaba 1.8
1517 wakaba 1.9 $onerror->(type => 'xattr not applicable',
1518     level => 'i', ## TODO: fact_level
1519     node => $xattr);
1520 wakaba 1.8 }
1521     }
1522     } # check
1523    
1524     package Whatpm::WebIDL::Definition;
1525     push our @ISA, 'Whatpm::WebIDL::Node';
1526    
1527     sub new ($$) {
1528     return bless {child_nodes => [], node_name => ''.$_[1]}, $_[0];
1529     } # new
1530    
1531 wakaba 1.4 sub set_extended_attribute_node ($$) {
1532     my $self = shift;
1533     ## TODO: check
1534     push @{$self->{xattrs} ||= []}, shift;
1535     } # set_extended_attribute_node
1536    
1537     sub _xattrs_text ($) {
1538     my $self = shift;
1539    
1540     unless ($self->{xattrs} and
1541     @{$self->{xattrs}}) {
1542     return '';
1543     }
1544    
1545     my $r = '[';
1546     $r .= join ', ', map {$_->idl_text} @{$self->{xattrs}};
1547     $r .= ']';
1548     return $r;
1549     } # _xattrs_text
1550    
1551 wakaba 1.9 sub qualified_name ($) {
1552     my $self = shift;
1553    
1554     my $parent = $self->{parent_node};
1555     if ($parent and $parent->isa ('Whatpm::WebIDL::Definition')) {
1556     return $parent->qualified_name . '::' . $self->{node_name};
1557     } else {
1558     return '::' . $self->{node_name};
1559     }
1560     } # qualified_name
1561    
1562 wakaba 1.1 sub type ($;$) {
1563     if (@_ > 1) {
1564     if (defined $_[1]) {
1565     $_[0]->{type} = $_[1];
1566     } else {
1567 wakaba 1.11 $_[0]->{type} = '::any::';
1568 wakaba 1.1 }
1569     }
1570     return $_[0]->{type};
1571     } # type
1572    
1573 wakaba 1.6 my $serialize_type;
1574     $serialize_type = sub ($) {
1575     my $type = shift;
1576 wakaba 1.11 if ($type =~ s/^::::sequence:::://) {
1577     return 'sequence<' . $serialize_type->($type) . '>';
1578     } elsif ($type =~ /\A::([^:]+)::\z/) {
1579     return $1;
1580 wakaba 1.6 } else {
1581 wakaba 1.10 return $type; ## TODO: escape identifiers...
1582 wakaba 1.6 }
1583     }; # $serialize_type
1584    
1585 wakaba 1.1 sub type_text ($) {
1586     my $type = $_[0]->{type};
1587     return undef unless defined $type;
1588 wakaba 1.6
1589     return $serialize_type->($type);
1590 wakaba 1.1 } # type_text
1591 wakaba 1.6
1592 wakaba 1.1 package Whatpm::WebIDL::Module;
1593     push our @ISA, 'Whatpm::WebIDL::Definition';
1594    
1595     sub idl_text ($) {
1596 wakaba 1.4 my $self = shift;
1597     my $r = $self->_xattrs_text;
1598     $r .= ' ' if length $r;
1599 wakaba 1.8 $r .= 'module ' . $self->node_name . " {\x0A\x0A"; ## TODO: escape
1600 wakaba 1.4 for (@{$self->{child_nodes}}) {
1601 wakaba 1.1 $r .= $_->idl_text;
1602     }
1603     $r .= "\x0A};\x0A";
1604     return $r;
1605     } # idl_text
1606    
1607     package Whatpm::WebIDL::Interface;
1608     push our @ISA, 'Whatpm::WebIDL::Definition';
1609    
1610     sub new ($$) {
1611     my $self = shift->SUPER::new (@_);
1612     $self->{inheritances} = [];
1613     return $self;
1614     } # new
1615    
1616     sub append_inheritance ($$) {
1617     my $self = shift;
1618     my $scoped_name = shift;
1619     push @{$self->{inheritances}}, $scoped_name;
1620     } # append_inheritance
1621    
1622     sub idl_text ($) {
1623 wakaba 1.3 my $self = shift;
1624 wakaba 1.4 my $r = $self->_xattrs_text;
1625     $r .= ' ' if length $r;
1626 wakaba 1.9 $r .= 'interface ' . $self->node_name;
1627 wakaba 1.8
1628     if ($self->{is_forward_declaration}) {
1629     $r .= ";\x0A";
1630     return $r;
1631     }
1632    
1633 wakaba 1.3 if (@{$self->{inheritances}}) {
1634     $r .= ' : '; ## TODO: ...
1635 wakaba 1.10 $r .= join ', ', map {$serialize_type->($_)} @{$self->{inheritances}};
1636 wakaba 1.3 }
1637     $r .= " {\x0A"; ## TODO: escape
1638     for (@{$self->{child_nodes}}) {
1639 wakaba 1.1 $r .= ' ' . $_->idl_text;
1640     }
1641     $r .= "};\x0A";
1642     return $r;
1643     } # idl_text
1644    
1645 wakaba 1.8 sub is_forward_declaration ($;$) {
1646     if (@_ > 1) {
1647     if ($_[1]) {
1648     $_[0]->{is_forward_declaration} = 1;
1649     } else {
1650     delete $_[0]->{is_forward_declaration};
1651     }
1652     }
1653    
1654     return $_[0]->{is_forward_declaration};
1655     } # is_forward_declaration
1656    
1657 wakaba 1.1 package Whatpm::WebIDL::Exception;
1658     push our @ISA, 'Whatpm::WebIDL::Definition';
1659    
1660 wakaba 1.3 sub idl_text ($) {
1661 wakaba 1.4 my $self = shift;
1662     my $r = $self->_xattrs_text;
1663     $r .= ' ' if length $r;
1664 wakaba 1.9 $r .= 'exception ' . $self->node_name . " {\x0A"; ## TODO: escape
1665 wakaba 1.4 for (@{$self->{child_nodes}}) {
1666 wakaba 1.3 $r .= ' ' . $_->idl_text;
1667     }
1668     $r .= "};\x0A";
1669     return $r;
1670     } # idl_text
1671    
1672 wakaba 1.1 package Whatpm::WebIDL::Typedef;
1673     push our @ISA, 'Whatpm::WebIDL::Definition';
1674    
1675     sub new ($$) {
1676     my $self = shift->SUPER::new (@_);
1677 wakaba 1.11 $self->{type} = '::any::';
1678 wakaba 1.1 return $self;
1679     } # new
1680    
1681     sub idl_text ($) {
1682 wakaba 1.4 my $self = shift;
1683     my $r = $self->_xattrs_text;
1684     $r .= ' ' if length $r;
1685 wakaba 1.1 ## TODO: escape
1686 wakaba 1.4 $r .= 'typedef ' . $self->type_text . ' ' . $self->node_name . ";\x0A";
1687     return $r;
1688 wakaba 1.1 } # idl_text
1689    
1690     package Whatpm::WebIDL::Valuetype;
1691     push our @ISA, 'Whatpm::WebIDL::Definition';
1692    
1693     sub new ($$) {
1694     my $self = shift->SUPER::new (@_);
1695 wakaba 1.11 $self->{type} = '::boolean::';
1696 wakaba 1.1 return $self;
1697     } # new
1698    
1699     sub idl_text ($) {
1700 wakaba 1.4 my $self = shift;
1701     my $r = $self->_xattrs_text;
1702     $r .= ' ' if length $r;
1703 wakaba 1.1 ## TODO: escape
1704 wakaba 1.4 $r .= 'valuetype ' . $self->node_name . ' ' . $self->type_text . ";\x0A";
1705     return $r;
1706 wakaba 1.1 } # idl_text
1707    
1708     package Whatpm::WebIDL::InterfaceMember;
1709 wakaba 1.8 push our @ISA, 'Whatpm::WebIDL::Node';
1710 wakaba 1.1
1711     sub new ($$) {
1712     return bless {node_name => ''.$_[1]}, $_[0];
1713     } # new
1714    
1715 wakaba 1.8 sub child_nodes ($) { return [] }
1716    
1717 wakaba 1.4 *_xattrs_text = \&Whatpm::WebIDL::Definition::_xattrs_text;
1718    
1719     *set_extended_attribute_node = \&Whatpm::WebIDL::Definition::set_extended_attribute_node;
1720    
1721 wakaba 1.1 *type = \&Whatpm::WebIDL::Definition::type;
1722    
1723     *type_text = \&Whatpm::WebIDL::Definition::type_text;
1724    
1725     package Whatpm::WebIDL::Const;
1726     push our @ISA, 'Whatpm::WebIDL::Definition', 'Whatpm::WebIDL::InterfaceMember';
1727    
1728     sub new ($$) {
1729     my $self = shift->SUPER::new (@_); # Definition->new should be called
1730 wakaba 1.11 $self->{type} = '::boolean::';
1731 wakaba 1.1 $self->{value} = ['FALSE'];
1732     return $self;
1733     } # new
1734    
1735     sub value ($;$) {
1736     if (@_ > 1) {
1737 wakaba 1.11 if (defined $_[1]) {
1738     $_[0]->{value} = $_[1];
1739     } else {
1740     $_[0]->{value} = ['FALSE'];
1741     }
1742 wakaba 1.1 }
1743    
1744     return $_[0]->{value};
1745     } # value
1746    
1747     sub value_text ($) {
1748     my $value = $_[0]->{value};
1749    
1750     if ($value->[0] eq 'TRUE' or $value->[0] eq 'FALSE') {
1751     return $value->[0];
1752     } elsif ($value->[0] eq 'integer' or $value->[0] eq 'float') {
1753     ## TODO: format
1754     return $value->[1];
1755     } else {
1756     return undef;
1757     }
1758     } # value_text
1759    
1760     sub idl_text ($) {
1761 wakaba 1.4 my $self = shift;
1762     my $r = $self->_xattrs_text;
1763     $r .= ' ' if length $r;
1764     $r .= 'const ' . $self->type_text . ' ' . $self->node_name . ' = ' . $self->value_text . ";\x0A"; ## TODO: escape
1765     return $r;
1766 wakaba 1.1 } # idl_text
1767    
1768     package Whatpm::WebIDL::Attribute;
1769     push our @ISA, 'Whatpm::WebIDL::InterfaceMember';
1770    
1771     sub new ($$) {
1772     my $self = shift->SUPER::new (@_);
1773 wakaba 1.11 $self->{type} = '::any::';
1774 wakaba 1.2 $self->{getraises} = [];
1775     $self->{setraises} = [];
1776 wakaba 1.1 return $self;
1777     } # new
1778    
1779 wakaba 1.2 sub append_getraises ($$) {
1780     ## TODO: error check, etc.
1781     push @{$_[0]->{getraises}}, $_[1];
1782     } # append_getraises
1783    
1784     sub append_setraises ($$) {
1785     ## TODO: error check, etc.
1786     push @{$_[0]->{setraises}}, $_[1];
1787     } # append_setraises
1788    
1789 wakaba 1.1 sub readonly ($;$) {
1790     if (@_ > 1) {
1791     $_[0]->{readonly} = $_[1];
1792     }
1793    
1794     return $_[0]->{readonly};
1795     } # readonly
1796    
1797     sub idl_text ($) {
1798 wakaba 1.2 my $self = shift;
1799 wakaba 1.4 my $r = $self->_xattrs_text;
1800     $r .= ' ' if length $r;
1801     $r .= ($self->readonly ? 'readonly ' : '') . 'attribute ' . $self->type_text . ' ' . $self->node_name;
1802 wakaba 1.1 ## TODO: escape
1803 wakaba 1.2 if (@{$self->{getraises}}) {
1804     $r .= ' getraises (';
1805     ## todo: ...
1806     $r .= join ', ', map {join '::', @{$_}} @{$self->{getraises}};
1807     $r .= ')';
1808     }
1809     if (@{$self->{setraises}}) {
1810     $r .= ' setraises (';
1811     ## todo: ...
1812     $r .= join ', ', map {join '::', @{$_}} @{$self->{setraises}};
1813     $r .= ')';
1814     }
1815     $r .= ";\x0A";
1816     return $r;
1817 wakaba 1.1 } # idl_text
1818    
1819     package Whatpm::WebIDL::Operation;
1820     push our @ISA, 'Whatpm::WebIDL::InterfaceMember';
1821    
1822     sub new ($$) {
1823     my $self = shift->SUPER::new (@_);
1824 wakaba 1.11 $self->{type} = '::any::';
1825 wakaba 1.1 $self->{child_nodes} = [];
1826 wakaba 1.2 $self->{raises} = [];
1827 wakaba 1.1 return $self;
1828     } # new
1829    
1830 wakaba 1.2 sub append_raises ($$) {
1831     ## TODO: error check, etc.
1832     push @{$_[0]->{raises}}, $_[1];
1833     } # append_raises
1834    
1835 wakaba 1.1 sub idl_text ($) {
1836 wakaba 1.2 my $self = shift;
1837 wakaba 1.4 my $r = $self->_xattrs_text;
1838     $r .= ' ' if length $r;
1839     $r .= $self->type_text . ' ' . $self->node_name . ' ('; ## TODO: escape
1840 wakaba 1.2 $r .= join ', ', map {$_->idl_text} @{$self->{child_nodes}};
1841     $r .= ')';
1842     if (@{$self->{raises}}) {
1843     $r .= ' raises (';
1844     ## todo: ...
1845     $r .= join ', ', map {join '::', @{$_}} @{$self->{raises}};
1846     $r .= ')';
1847     }
1848 wakaba 1.1 $r .= ";\x0A";
1849     return $r;
1850     } # idl_text
1851    
1852     package Whatpm::WebIDL::Argument;
1853 wakaba 1.8 push our @ISA, 'Whatpm::WebIDL::Node';
1854 wakaba 1.1
1855     sub new ($$) {
1856 wakaba 1.11 return bless {node_name => ''.$_[1], type => '::any::'}, $_[0];
1857 wakaba 1.1 } # new
1858    
1859     sub idl_text ($) {
1860 wakaba 1.4 my $self = shift;
1861     my $r = $self->_xattrs_text;
1862     $r .= ' ' if length $r;
1863     $r .= 'in ' . $self->type_text . ' ' . $self->node_name; ## TODO: escape
1864     return $r;
1865 wakaba 1.3 } # idl_text
1866    
1867 wakaba 1.4 *_xattrs_text = \&Whatpm::WebIDL::Definition::_xattrs_text;
1868    
1869     *set_extended_attribute_node = \&Whatpm::WebIDL::Definition::set_extended_attribute_node;
1870    
1871 wakaba 1.3 *type = \&Whatpm::WebIDL::Definition::type;
1872    
1873     *type_text = \&Whatpm::WebIDL::Definition::type_text;
1874    
1875     package Whatpm::WebIDL::ExceptionMember;
1876 wakaba 1.8 push our @ISA, 'Whatpm::WebIDL::Node';
1877 wakaba 1.3
1878     sub new ($$) {
1879 wakaba 1.11 return bless {node_name => ''.$_[1], type => '::any::'}, $_[0];
1880 wakaba 1.3 } # new
1881    
1882     sub idl_text ($) {
1883 wakaba 1.4 my $self = shift;
1884     my $r = $self->_xattrs_text;
1885     $r .= ' ' if length $r;
1886     $r .= $self->type_text . ' ' . $self->node_name . ";\x0A"; ## TODO: escape
1887     return $r;
1888 wakaba 1.1 } # idl_text
1889    
1890 wakaba 1.4 *_xattrs_text = \&Whatpm::WebIDL::Definition::_xattrs_text;
1891    
1892     *set_extended_attribute_node = \&Whatpm::WebIDL::Definition::set_extended_attribute_node;
1893    
1894 wakaba 1.1 *type = \&Whatpm::WebIDL::Definition::type;
1895    
1896     *type_text = \&Whatpm::WebIDL::Definition::type_text;
1897 wakaba 1.9
1898 wakaba 1.4 package Whatpm::WebIDL::ExtendedAttribute;
1899 wakaba 1.8 push our @ISA, 'Whatpm::WebIDL::Node';
1900 wakaba 1.4
1901     sub new ($$) {
1902     return bless {child_nodes => [], node_name => ''.$_[1]};
1903     } # new
1904    
1905     sub idl_text ($) {
1906     my $self = shift;
1907     my $r = $self->node_name; ## TODO:] esceape
1908     if (defined $self->{value}) {
1909     $r .= '=' . $self->{value}; ## TODO: escape
1910     }
1911     if (@{$self->{child_nodes}}) {
1912     $r .= ' (';
1913     $r .= join ', ', map {$_->idl_text} @{$self->{child_nodes}};
1914     $r .= ')';
1915     }
1916     return $r;
1917     } # idl_text
1918    
1919     sub value ($;$) {
1920     if (@_ > 1) {
1921     if (defined $_[1]) {
1922     $_[0]->{value} = ''.$_[1];
1923     } else {
1924     delete $_[0]->{value};
1925     }
1926     }
1927    
1928     return $_[0]->{value};
1929     } # value
1930 wakaba 1.1
1931     1;
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24