/[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.12 - (hide annotations) (download)
Sun Aug 3 05:43:11 2008 UTC (16 years, 3 months ago) by wakaba
Branch: MAIN
Changes since 1.11: +132 -35 lines 
++ whatpm/t/webidl/ChangeLog	3 Aug 2008 05:42:49 -0000
2008-08-03  Wakaba  <wakaba@suika.fam.cx>

	* webidl-defs.dat: Test result updated.

	* webidl-interface.dat: New test data for attributes
	and operations are added.

++ whatpm/Whatpm/ChangeLog	3 Aug 2008 05:42:21 -0000
2008-08-03  Wakaba  <wakaba@suika.fam.cx>

	* WebIDL.pm ($resolve): New code, based on resolve code
	for constant types in the |check| method.
	(check): Support for checking of attributes, operations, and
	arguments.
	(Attribute/Operation idl_text): Exception names in getraises,
	setraises, and raises clauses is serizlied by |$serialize_type|
	code.
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.12 my $defined_qnames = {};
1367     my $resolve = sub ($$) {
1368     my $i_sn = shift;
1369     my $scope = shift;
1370    
1371     if ($i_sn =~ /::DOMString\z/) {
1372     return undef;
1373     } elsif ($i_sn =~ /^::/) {
1374     if ($defined_qnames->{$i_sn}) {
1375     return $defined_qnames->{$i_sn};
1376     } else {
1377     return undef;
1378     }
1379     } else {
1380     if ($defined_qnames->{$scope . $i_sn}) {
1381     return $defined_qnames->{$scope . $i_sn};
1382     } elsif ($defined_qnames->{'::' . $i_sn}) {
1383     return $defined_qnames->{'::' . $i_sn};
1384     } else {
1385     return undef;
1386     }
1387     }
1388     }; # $resolve
1389    
1390 wakaba 1.10 my $items = [map { {node => $_, scope => '::'} } @{$self->{child_nodes}}];
1391 wakaba 1.9
1392     while (@$items) {
1393     my $item = shift @$items;
1394 wakaba 1.10 if ($item->{node}->isa ('Whatpm::WebIDL::Definition') and
1395     not $item->{defined_members}) {
1396 wakaba 1.9 if ($item->{node}->isa ('Whatpm::WebIDL::Interface')) {
1397 wakaba 1.10 for my $i_sn (@{$item->{node}->{inheritances}}) {
1398 wakaba 1.12 my $def = $resolve->($i_sn, $item->{scope});
1399    
1400     unless ($def and $def->{node}->isa ('Whatpm::WebIDL::Interface')) {
1401     $onerror->(type => 'interface not defined',
1402     level => 'm',
1403     node => $item->{node},
1404     text => $i_sn);
1405 wakaba 1.10 }
1406     }
1407    
1408     my $defined_members = {};
1409 wakaba 1.9 unshift @$items,
1410 wakaba 1.12 map { {node => $_, defined_members => $defined_members,
1411     scope => $item->{scope}} }
1412 wakaba 1.9 @{$item->{node}->{child_nodes}};
1413    
1414     unless ($item->{parent}) {
1415     $onerror->(type => 'non-module definition',
1416     level => 's',
1417     node => $item->{node});
1418     }
1419     } elsif ($item->{node}->isa ('Whatpm::WebIDL::Exception')) {
1420     unshift @$items,
1421 wakaba 1.12 map { {node => $_, parent => $item->{node},
1422     scope => $item->{scope}} }
1423 wakaba 1.9 @{$item->{node}->{child_nodes}};
1424    
1425     unless ($item->{parent}) {
1426     $onerror->(type => 'non-module definition',
1427     level => 's',
1428     node => $item->{node});
1429     }
1430     } elsif ($item->{node}->isa ('Whatpm::WebIDL::Module')) {
1431     unshift @$items,
1432 wakaba 1.10 map {
1433     {node => $_, parent => $item->{node},
1434     scope => $item->{scope} . $item->{node}->node_name . '::'}
1435     }
1436 wakaba 1.9 @{$item->{node}->{child_nodes}};
1437 wakaba 1.11 } elsif ($item->{node}->isa ('Whatpm::WebIDL::Const')) {
1438     $check_const_value->($item);
1439    
1440     unless ($item->{parent}) {
1441     $onerror->(type => 'non-module definition',
1442     level => 's',
1443     node => $item->{node});
1444     }
1445 wakaba 1.9 } else {
1446     unless ($item->{parent}) {
1447     $onerror->(type => 'non-module definition',
1448     level => 's',
1449     node => $item->{node});
1450     }
1451     }
1452    
1453     my $qname = $item->{node}->qualified_name;
1454     if ($defined_qnames->{$qname}) {
1455     ## NOTE: "The identifier of a definition MUST be locally unique":
1456     ## Redundant with another requirement below.
1457    
1458 wakaba 1.10 ## ISSUE: |interface x; interface x {};| is non-conforming
1459     ## according to the current spec text.
1460    
1461     ## ISSUE: |interface x;| with no |interface x {};| is conforming
1462     ## according to the current spec text.
1463    
1464 wakaba 1.9 $onerror->(type => 'duplicate qname',
1465     level => 'm',
1466     node => $item->{node});
1467     } else {
1468 wakaba 1.10 $defined_qnames->{$qname} = $item;
1469     ## NOTE: This flag must be turned on AFTER inheritance check is
1470     ## performed (c.f. |interface x : x {};|).
1471 wakaba 1.9 }
1472     } elsif ($item->{node}->isa ('Whatpm::WebIDL::InterfaceMember')) {
1473     if ($item->{node}->isa ('Whatpm::WebIDL::Operation')) {
1474 wakaba 1.12 ## NOTE: Arguments
1475 wakaba 1.9 unshift @$items,
1476 wakaba 1.12 map { {node => $_, scope => $item->{scope}} }
1477 wakaba 1.9 @{$item->{node}->{child_nodes}};
1478 wakaba 1.10 } else {
1479     my $name = $item->{node}->node_name;
1480     if ($item->{defined_members}->{$name}) {
1481     $onerror->(type => 'duplicate interface member',
1482     level => 'm',
1483     node => $item->{node});
1484     ## ISSUE: Whether the example below is conforming or not
1485     ## is ambigious:
1486     ## |interface a { attribute any b; any b (); };|
1487     } else {
1488     $item->{defined_members}->{$name} = 1;
1489     }
1490 wakaba 1.12 }
1491 wakaba 1.11
1492 wakaba 1.12 if ($item->{node}->isa ('Whatpm::WebIDL::Attribute') or
1493     $item->{node}->isa ('Whatpm::WebIDL::Operation')) {
1494     my $type = $item->{node}->type;
1495     if ($type =~ /\A::[^:]+::\z/) { # note that sequence<> not allowed
1496     #
1497     } else { # scoped name
1498     my $def = $resolve->($type, $item->{scope});
1499    
1500     unless ($def and
1501     ($def->{node}->isa ('Whatpm::WebIDL::Interface') or
1502     $def->{node}->isa ('Whatpm::WebIDL::Typedef') or
1503     $def->{node}->isa ('Whatpm::WebIDL::Valuetype'))) {
1504     $onerror->(type => 'type not defined',
1505     level => 'm',
1506     node => $item->{node},
1507     text => $item->{node}->type_text);
1508     }
1509 wakaba 1.11 }
1510 wakaba 1.12
1511     for (@{$item->{node}->{raises} or []}, # for operations
1512     @{$item->{node}->{getraises} or []}, # for attributes
1513     @{$item->{node}->{setraises} or []}) { # for attributes
1514     my $def = $resolve->($_, $item->{scope});
1515    
1516     unless ($def and
1517     $def->{node}->isa ('Whatpm::WebIDL::Exception')) {
1518     $onerror->(type => 'exception not defined',
1519     level => 'm',
1520     node => $item->{node},
1521     text => $_);
1522     }
1523     }
1524    
1525     ## ISSUE: readonly setraises is not disallowed
1526     ## ISSUE: raises (x,x) and raises (x,::x) and etc. are not disallowed
1527     } elsif ($item->{node}->isa ('Whatpm::WebIDL::Const')) {
1528     $check_const_value->($item);
1529 wakaba 1.9 }
1530 wakaba 1.12 } elsif ($item->{node}->isa ('Whatpm::WebIDL::Argument')) {
1531     ## ISSUE: No uniqueness constraints for arguments in an operation.
1532    
1533     my $type = $item->{node}->type;
1534     if ($type =~ /\A::[^:]+::\z/) { # note that sequence<> not allowed
1535     #
1536     } else { # scoped name
1537     my $def = $resolve->($type, $item->{scope});
1538    
1539     unless ($def and
1540     ($def->{node}->isa ('Whatpm::WebIDL::Interface') or
1541     $def->{node}->isa ('Whatpm::WebIDL::Typedef') or
1542     $def->{node}->isa ('Whatpm::WebIDL::Valuetype'))) {
1543     $onerror->(type => 'type not defined',
1544     level => 'm',
1545     node => $item->{node},
1546     text => $item->{node}->type_text);
1547     }
1548     }
1549 wakaba 1.9 }
1550    
1551     my $xattrs = $item->{node}->{xattrs} || [];
1552     for my $xattr (@$xattrs) {
1553     my $xattr_name = $xattr->node_name;
1554 wakaba 1.10 if ({
1555 wakaba 1.12 Null => 1, Undefined => 1,
1556 wakaba 1.10 }->{$xattr_name}) {
1557 wakaba 1.12 if ($item->{node}->isa ('Whatpm::WebIDL::Attribute') or
1558     $item->{node}->isa ('Whatpm::WebIDL::Argument')) {
1559    
1560     next;
1561     } else {
1562     #
1563     }
1564     } elsif ({
1565     IndexGetter => 1, IndexSetter => 1,
1566     NameGetter => 1, NameSetter => 1,
1567     }->{$xattr_name}) {
1568     if ($item->{node}->isa ('Whatpm::WebIDL::Operation')) {
1569    
1570     next;
1571     } else {
1572     #
1573     }
1574     } elsif ($xattr_name eq 'PutForwards') {
1575     if ($item->{node}->isa ('Whatpm::WebIDL::Attribute')) {
1576    
1577     next;
1578     } else {
1579     #
1580     }
1581     } elsif ($xattr_name eq 'Variadic') {
1582     if ($item->{node}->isa ('Whatpm::WebIDL::Operation')) {
1583    
1584     next;
1585     } else {
1586     #
1587     }
1588     } elsif ({
1589     Constructor => 1, NamedConstructor => 1, NativeObject => 1,
1590     NoInterfaceObject => 1, Stringifies => 1,
1591     }->{$xattr_name}) {
1592 wakaba 1.10 if ($item->{node}->isa ('Whatpm::WebIDL::Interface')) {
1593    
1594     next;
1595     } else {
1596     #
1597     }
1598     } elsif ($xattr_name eq 'ExceptionConsts') {
1599 wakaba 1.9 if ($item->{node}->isa ('Whatpm::WebIDL::Module')) {
1600    
1601     next;
1602     } else {
1603     #
1604     }
1605 wakaba 1.11 } elsif ($item->{node}->isa ('Whatpm::WebIDL::Const')) {
1606     #
1607 wakaba 1.9 } else {
1608     $onerror->(type => 'unknown xattr',
1609     level => 'u',
1610     node => $xattr);
1611     next;
1612     }
1613 wakaba 1.8
1614 wakaba 1.9 $onerror->(type => 'xattr not applicable',
1615     level => 'i', ## TODO: fact_level
1616     node => $xattr);
1617 wakaba 1.8 }
1618     }
1619     } # check
1620    
1621     package Whatpm::WebIDL::Definition;
1622     push our @ISA, 'Whatpm::WebIDL::Node';
1623    
1624     sub new ($$) {
1625     return bless {child_nodes => [], node_name => ''.$_[1]}, $_[0];
1626     } # new
1627    
1628 wakaba 1.4 sub set_extended_attribute_node ($$) {
1629     my $self = shift;
1630     ## TODO: check
1631     push @{$self->{xattrs} ||= []}, shift;
1632     } # set_extended_attribute_node
1633    
1634     sub _xattrs_text ($) {
1635     my $self = shift;
1636    
1637     unless ($self->{xattrs} and
1638     @{$self->{xattrs}}) {
1639     return '';
1640     }
1641    
1642     my $r = '[';
1643     $r .= join ', ', map {$_->idl_text} @{$self->{xattrs}};
1644     $r .= ']';
1645     return $r;
1646     } # _xattrs_text
1647    
1648 wakaba 1.9 sub qualified_name ($) {
1649     my $self = shift;
1650    
1651     my $parent = $self->{parent_node};
1652     if ($parent and $parent->isa ('Whatpm::WebIDL::Definition')) {
1653     return $parent->qualified_name . '::' . $self->{node_name};
1654     } else {
1655     return '::' . $self->{node_name};
1656     }
1657     } # qualified_name
1658    
1659 wakaba 1.1 sub type ($;$) {
1660     if (@_ > 1) {
1661     if (defined $_[1]) {
1662     $_[0]->{type} = $_[1];
1663     } else {
1664 wakaba 1.11 $_[0]->{type} = '::any::';
1665 wakaba 1.1 }
1666     }
1667     return $_[0]->{type};
1668     } # type
1669    
1670 wakaba 1.6 my $serialize_type;
1671     $serialize_type = sub ($) {
1672     my $type = shift;
1673 wakaba 1.11 if ($type =~ s/^::::sequence:::://) {
1674     return 'sequence<' . $serialize_type->($type) . '>';
1675     } elsif ($type =~ /\A::([^:]+)::\z/) {
1676     return $1;
1677 wakaba 1.6 } else {
1678 wakaba 1.10 return $type; ## TODO: escape identifiers...
1679 wakaba 1.6 }
1680     }; # $serialize_type
1681    
1682 wakaba 1.1 sub type_text ($) {
1683     my $type = $_[0]->{type};
1684     return undef unless defined $type;
1685 wakaba 1.6
1686     return $serialize_type->($type);
1687 wakaba 1.1 } # type_text
1688 wakaba 1.6
1689 wakaba 1.1 package Whatpm::WebIDL::Module;
1690     push our @ISA, 'Whatpm::WebIDL::Definition';
1691    
1692     sub idl_text ($) {
1693 wakaba 1.4 my $self = shift;
1694     my $r = $self->_xattrs_text;
1695     $r .= ' ' if length $r;
1696 wakaba 1.8 $r .= 'module ' . $self->node_name . " {\x0A\x0A"; ## TODO: escape
1697 wakaba 1.4 for (@{$self->{child_nodes}}) {
1698 wakaba 1.1 $r .= $_->idl_text;
1699     }
1700     $r .= "\x0A};\x0A";
1701     return $r;
1702     } # idl_text
1703    
1704     package Whatpm::WebIDL::Interface;
1705     push our @ISA, 'Whatpm::WebIDL::Definition';
1706    
1707     sub new ($$) {
1708     my $self = shift->SUPER::new (@_);
1709     $self->{inheritances} = [];
1710     return $self;
1711     } # new
1712    
1713     sub append_inheritance ($$) {
1714     my $self = shift;
1715     my $scoped_name = shift;
1716     push @{$self->{inheritances}}, $scoped_name;
1717     } # append_inheritance
1718    
1719     sub idl_text ($) {
1720 wakaba 1.3 my $self = shift;
1721 wakaba 1.4 my $r = $self->_xattrs_text;
1722     $r .= ' ' if length $r;
1723 wakaba 1.9 $r .= 'interface ' . $self->node_name;
1724 wakaba 1.8
1725     if ($self->{is_forward_declaration}) {
1726     $r .= ";\x0A";
1727     return $r;
1728     }
1729    
1730 wakaba 1.3 if (@{$self->{inheritances}}) {
1731     $r .= ' : '; ## TODO: ...
1732 wakaba 1.10 $r .= join ', ', map {$serialize_type->($_)} @{$self->{inheritances}};
1733 wakaba 1.3 }
1734     $r .= " {\x0A"; ## TODO: escape
1735     for (@{$self->{child_nodes}}) {
1736 wakaba 1.1 $r .= ' ' . $_->idl_text;
1737     }
1738     $r .= "};\x0A";
1739     return $r;
1740     } # idl_text
1741    
1742 wakaba 1.8 sub is_forward_declaration ($;$) {
1743     if (@_ > 1) {
1744     if ($_[1]) {
1745     $_[0]->{is_forward_declaration} = 1;
1746     } else {
1747     delete $_[0]->{is_forward_declaration};
1748     }
1749     }
1750    
1751     return $_[0]->{is_forward_declaration};
1752     } # is_forward_declaration
1753    
1754 wakaba 1.1 package Whatpm::WebIDL::Exception;
1755     push our @ISA, 'Whatpm::WebIDL::Definition';
1756    
1757 wakaba 1.3 sub idl_text ($) {
1758 wakaba 1.4 my $self = shift;
1759     my $r = $self->_xattrs_text;
1760     $r .= ' ' if length $r;
1761 wakaba 1.9 $r .= 'exception ' . $self->node_name . " {\x0A"; ## TODO: escape
1762 wakaba 1.4 for (@{$self->{child_nodes}}) {
1763 wakaba 1.3 $r .= ' ' . $_->idl_text;
1764     }
1765     $r .= "};\x0A";
1766     return $r;
1767     } # idl_text
1768    
1769 wakaba 1.1 package Whatpm::WebIDL::Typedef;
1770     push our @ISA, 'Whatpm::WebIDL::Definition';
1771    
1772     sub new ($$) {
1773     my $self = shift->SUPER::new (@_);
1774 wakaba 1.11 $self->{type} = '::any::';
1775 wakaba 1.1 return $self;
1776     } # new
1777    
1778     sub idl_text ($) {
1779 wakaba 1.4 my $self = shift;
1780     my $r = $self->_xattrs_text;
1781     $r .= ' ' if length $r;
1782 wakaba 1.1 ## TODO: escape
1783 wakaba 1.4 $r .= 'typedef ' . $self->type_text . ' ' . $self->node_name . ";\x0A";
1784     return $r;
1785 wakaba 1.1 } # idl_text
1786    
1787     package Whatpm::WebIDL::Valuetype;
1788     push our @ISA, 'Whatpm::WebIDL::Definition';
1789    
1790     sub new ($$) {
1791     my $self = shift->SUPER::new (@_);
1792 wakaba 1.11 $self->{type} = '::boolean::';
1793 wakaba 1.1 return $self;
1794     } # new
1795    
1796     sub idl_text ($) {
1797 wakaba 1.4 my $self = shift;
1798     my $r = $self->_xattrs_text;
1799     $r .= ' ' if length $r;
1800 wakaba 1.1 ## TODO: escape
1801 wakaba 1.4 $r .= 'valuetype ' . $self->node_name . ' ' . $self->type_text . ";\x0A";
1802     return $r;
1803 wakaba 1.1 } # idl_text
1804    
1805     package Whatpm::WebIDL::InterfaceMember;
1806 wakaba 1.8 push our @ISA, 'Whatpm::WebIDL::Node';
1807 wakaba 1.1
1808     sub new ($$) {
1809     return bless {node_name => ''.$_[1]}, $_[0];
1810     } # new
1811    
1812 wakaba 1.8 sub child_nodes ($) { return [] }
1813    
1814 wakaba 1.4 *_xattrs_text = \&Whatpm::WebIDL::Definition::_xattrs_text;
1815    
1816     *set_extended_attribute_node = \&Whatpm::WebIDL::Definition::set_extended_attribute_node;
1817    
1818 wakaba 1.1 *type = \&Whatpm::WebIDL::Definition::type;
1819    
1820     *type_text = \&Whatpm::WebIDL::Definition::type_text;
1821    
1822     package Whatpm::WebIDL::Const;
1823     push our @ISA, 'Whatpm::WebIDL::Definition', 'Whatpm::WebIDL::InterfaceMember';
1824    
1825     sub new ($$) {
1826     my $self = shift->SUPER::new (@_); # Definition->new should be called
1827 wakaba 1.11 $self->{type} = '::boolean::';
1828 wakaba 1.1 $self->{value} = ['FALSE'];
1829     return $self;
1830     } # new
1831    
1832     sub value ($;$) {
1833     if (@_ > 1) {
1834 wakaba 1.11 if (defined $_[1]) {
1835     $_[0]->{value} = $_[1];
1836     } else {
1837     $_[0]->{value} = ['FALSE'];
1838     }
1839 wakaba 1.1 }
1840    
1841     return $_[0]->{value};
1842     } # value
1843    
1844     sub value_text ($) {
1845     my $value = $_[0]->{value};
1846    
1847     if ($value->[0] eq 'TRUE' or $value->[0] eq 'FALSE') {
1848     return $value->[0];
1849     } elsif ($value->[0] eq 'integer' or $value->[0] eq 'float') {
1850     ## TODO: format
1851     return $value->[1];
1852     } else {
1853     return undef;
1854     }
1855     } # value_text
1856    
1857     sub idl_text ($) {
1858 wakaba 1.4 my $self = shift;
1859     my $r = $self->_xattrs_text;
1860     $r .= ' ' if length $r;
1861     $r .= 'const ' . $self->type_text . ' ' . $self->node_name . ' = ' . $self->value_text . ";\x0A"; ## TODO: escape
1862     return $r;
1863 wakaba 1.1 } # idl_text
1864    
1865     package Whatpm::WebIDL::Attribute;
1866     push our @ISA, 'Whatpm::WebIDL::InterfaceMember';
1867    
1868     sub new ($$) {
1869     my $self = shift->SUPER::new (@_);
1870 wakaba 1.11 $self->{type} = '::any::';
1871 wakaba 1.2 $self->{getraises} = [];
1872     $self->{setraises} = [];
1873 wakaba 1.1 return $self;
1874     } # new
1875    
1876 wakaba 1.2 sub append_getraises ($$) {
1877     ## TODO: error check, etc.
1878     push @{$_[0]->{getraises}}, $_[1];
1879     } # append_getraises
1880    
1881     sub append_setraises ($$) {
1882     ## TODO: error check, etc.
1883     push @{$_[0]->{setraises}}, $_[1];
1884     } # append_setraises
1885    
1886 wakaba 1.1 sub readonly ($;$) {
1887     if (@_ > 1) {
1888     $_[0]->{readonly} = $_[1];
1889     }
1890    
1891     return $_[0]->{readonly};
1892     } # readonly
1893    
1894     sub idl_text ($) {
1895 wakaba 1.2 my $self = shift;
1896 wakaba 1.4 my $r = $self->_xattrs_text;
1897     $r .= ' ' if length $r;
1898     $r .= ($self->readonly ? 'readonly ' : '') . 'attribute ' . $self->type_text . ' ' . $self->node_name;
1899 wakaba 1.1 ## TODO: escape
1900 wakaba 1.2 if (@{$self->{getraises}}) {
1901     $r .= ' getraises (';
1902     ## todo: ...
1903 wakaba 1.12 $r .= join ', ', map {$serialize_type->($_)} @{$self->{getraises}};
1904 wakaba 1.2 $r .= ')';
1905     }
1906     if (@{$self->{setraises}}) {
1907     $r .= ' setraises (';
1908     ## todo: ...
1909 wakaba 1.12 $r .= join ', ', map {$serialize_type->($_)} @{$self->{setraises}};
1910 wakaba 1.2 $r .= ')';
1911     }
1912     $r .= ";\x0A";
1913     return $r;
1914 wakaba 1.1 } # idl_text
1915    
1916     package Whatpm::WebIDL::Operation;
1917     push our @ISA, 'Whatpm::WebIDL::InterfaceMember';
1918    
1919     sub new ($$) {
1920     my $self = shift->SUPER::new (@_);
1921 wakaba 1.11 $self->{type} = '::any::';
1922 wakaba 1.1 $self->{child_nodes} = [];
1923 wakaba 1.2 $self->{raises} = [];
1924 wakaba 1.1 return $self;
1925     } # new
1926    
1927 wakaba 1.2 sub append_raises ($$) {
1928     ## TODO: error check, etc.
1929     push @{$_[0]->{raises}}, $_[1];
1930     } # append_raises
1931    
1932 wakaba 1.1 sub idl_text ($) {
1933 wakaba 1.2 my $self = shift;
1934 wakaba 1.4 my $r = $self->_xattrs_text;
1935     $r .= ' ' if length $r;
1936     $r .= $self->type_text . ' ' . $self->node_name . ' ('; ## TODO: escape
1937 wakaba 1.2 $r .= join ', ', map {$_->idl_text} @{$self->{child_nodes}};
1938     $r .= ')';
1939     if (@{$self->{raises}}) {
1940     $r .= ' raises (';
1941     ## todo: ...
1942 wakaba 1.12 $r .= join ', ', map {$serialize_type->($_)} @{$self->{raises}};
1943 wakaba 1.2 $r .= ')';
1944     }
1945 wakaba 1.1 $r .= ";\x0A";
1946     return $r;
1947     } # idl_text
1948    
1949     package Whatpm::WebIDL::Argument;
1950 wakaba 1.8 push our @ISA, 'Whatpm::WebIDL::Node';
1951 wakaba 1.1
1952     sub new ($$) {
1953 wakaba 1.11 return bless {node_name => ''.$_[1], type => '::any::'}, $_[0];
1954 wakaba 1.1 } # new
1955    
1956     sub idl_text ($) {
1957 wakaba 1.4 my $self = shift;
1958     my $r = $self->_xattrs_text;
1959     $r .= ' ' if length $r;
1960     $r .= 'in ' . $self->type_text . ' ' . $self->node_name; ## TODO: escape
1961     return $r;
1962 wakaba 1.3 } # idl_text
1963    
1964 wakaba 1.4 *_xattrs_text = \&Whatpm::WebIDL::Definition::_xattrs_text;
1965    
1966     *set_extended_attribute_node = \&Whatpm::WebIDL::Definition::set_extended_attribute_node;
1967    
1968 wakaba 1.3 *type = \&Whatpm::WebIDL::Definition::type;
1969    
1970     *type_text = \&Whatpm::WebIDL::Definition::type_text;
1971    
1972     package Whatpm::WebIDL::ExceptionMember;
1973 wakaba 1.8 push our @ISA, 'Whatpm::WebIDL::Node';
1974 wakaba 1.3
1975     sub new ($$) {
1976 wakaba 1.11 return bless {node_name => ''.$_[1], type => '::any::'}, $_[0];
1977 wakaba 1.3 } # new
1978    
1979     sub idl_text ($) {
1980 wakaba 1.4 my $self = shift;
1981     my $r = $self->_xattrs_text;
1982     $r .= ' ' if length $r;
1983     $r .= $self->type_text . ' ' . $self->node_name . ";\x0A"; ## TODO: escape
1984     return $r;
1985 wakaba 1.1 } # idl_text
1986    
1987 wakaba 1.4 *_xattrs_text = \&Whatpm::WebIDL::Definition::_xattrs_text;
1988    
1989     *set_extended_attribute_node = \&Whatpm::WebIDL::Definition::set_extended_attribute_node;
1990    
1991 wakaba 1.1 *type = \&Whatpm::WebIDL::Definition::type;
1992    
1993     *type_text = \&Whatpm::WebIDL::Definition::type_text;
1994 wakaba 1.9
1995 wakaba 1.4 package Whatpm::WebIDL::ExtendedAttribute;
1996 wakaba 1.8 push our @ISA, 'Whatpm::WebIDL::Node';
1997 wakaba 1.4
1998     sub new ($$) {
1999     return bless {child_nodes => [], node_name => ''.$_[1]};
2000     } # new
2001    
2002     sub idl_text ($) {
2003     my $self = shift;
2004     my $r = $self->node_name; ## TODO:] esceape
2005     if (defined $self->{value}) {
2006     $r .= '=' . $self->{value}; ## TODO: escape
2007     }
2008     if (@{$self->{child_nodes}}) {
2009     $r .= ' (';
2010     $r .= join ', ', map {$_->idl_text} @{$self->{child_nodes}};
2011     $r .= ')';
2012     }
2013     return $r;
2014     } # idl_text
2015    
2016     sub value ($;$) {
2017     if (@_ > 1) {
2018     if (defined $_[1]) {
2019     $_[0]->{value} = ''.$_[1];
2020     } else {
2021     delete $_[0]->{value};
2022     }
2023     }
2024    
2025     return $_[0]->{value};
2026     } # value
2027 wakaba 1.1
2028     1;
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24