636bb41484ffbd8e4fbd10f829f8c85b69d2903b
[panamaz] / src / notzed.nativez / lib / api.pm
1
2 package api;
3
4 use strict;
5
6 use File::Path qw(make_path);
7 use File::Basename;
8 use Data::Dumper;
9 use List::Util qw(first);
10
11 use config;
12
13 my %renameTable = (
14         'studly-caps' => sub { my $s = shift; $s =~ s/(?:^|_)(.)/\U$1/g; return $s; },
15         'camel-case' => sub { my $s = shift; $s =~ s/(?:_)(.)/\U$1/g; return $s; },
16         'upper-leadin' => sub { my $s = shift; $s =~ s/^([^_]+)/\U$1/; return $s; },
17         'identity' => sub {     return $_[0]; },
18         'call' => sub {
19                 my $s = shift;
20
21                 if ($s =~ m/\(/) {
22                         $s =~ s/u32:|u64:/p/g;
23                         $s =~ s/\$\{([^\}]+)\}/$1/g;
24                         $s =~ s/[\(\)]/_/g;
25                         $s =~ s/^/Call/;
26                 }
27                 $s;
28         }
29 );
30
31 my %defaultTable = (
32         'struct:<default>' => {
33                 name => '<default>',
34                 items => [],
35                 options => [ 'default=none', 'access=rw', 'field:rename=studly-caps' ],
36                 regex => qr/^struct:<default>$/,
37                 type => 'struct'
38         },
39         'union:<default>' => {
40                 name => '<default>',
41                 items => [],
42                 options => [ 'default=all', 'access=rw', 'field:rename=studly-caps' ],
43                 regex => qr/^union:<default>$/,
44                 type => 'union'
45         },
46         'call:<default>' => {
47                 name => '<default>',
48                 items => [],
49                 options => [ 'call:rename=call', 'access=r' ],
50                 regex => qr/^call:<default>$/,
51                 type => 'call'
52         },
53         'func:<default>' => {
54                 name => '<default>',
55                 items => [],
56                 options => [],
57                 regex => qr/^func:<default>$/,
58                 type => 'func'
59         },
60         'enum:<default>' => {
61                 name => '<default>',
62                 items => [],
63                 options => [],
64                 regex => qr/^enum:<default>$/,
65                 type => 'enum'
66         },
67 );
68
69 sub new {
70         my $class = shift;
71         my $file = shift;
72         my $vars = shift;
73         my $self = {
74                 vars => $vars,
75                 index => {},
76                 data => {},
77                 types => [],
78         };
79
80         my $conf = new config($vars, $file);
81         $self->{api} = $conf->{objects};
82         foreach my $obj (@{$self->{api}}) {
83                 $self->{index}->{"$obj->{type}:$obj->{name}"} = $obj;
84         }
85         foreach my $k (keys %defaultTable) {
86                 if (!defined($self->{index}->{$k})) {
87                         $self->{index}->{$k} = $defaultTable{$k};
88                         push @{$self->{api}}, $defaultTable{$k};
89                 }
90         }
91
92         while ($#_ >= 0) {
93                 my $name = shift;
94                 my $info = loadAPIFile($name);
95
96                 $self->{data} = { %{$self->{data}}, %{$info} };
97         }
98
99         foreach my $p (@{$conf->{pragmas}}) {
100                 if ($p->[0] eq '%require') {
101                         require $p->[1];
102                 }
103         }
104
105         analyseAPI($self);
106         preprocess($self);
107
108         # add phantom 'api' entries for anything else required
109         foreach my $s (findDependencies($self)) {
110                 my $n = "$s->{type}:$s->{name}";
111                 my $def = $self->{index}->{"$s->{type}:<default>"};
112
113                 die "no default for implicit dependency $n" if (!$def);
114
115                 my $obj = {
116                         %$def,
117                         match => "$s->{type}:$s->{name}",
118                         name => $s->{name},
119                         regex => qr/^$n$/,
120                 };
121                 $obj->{rename} = $obj->{"$obj->{type}:rename"} ? $obj->{"$obj->{type}:rename"}->($obj->{name}) : $obj->{name};
122
123                 print " implicit $n\n";
124                 push @{$self->{api}}, $obj;
125                 $self->{index}->{$n} = $obj;
126         }
127
128         postprocess($self);
129
130         # form the types
131         # TODO: could match the regexes to every possible type in the api and create a direct index
132         my $copyIndex = {};
133         foreach my $obj (grep { $_->{type} eq 'type' && $_->{name} =~ m@<.*>@ } @{$self->{api}}) {
134                 $copyIndex->{$obj->{name}} = $obj;
135         }
136
137         foreach my $obj (grep { $_->{type} eq 'type' && $_->{name} =~ m@^/.*/$@ } @{$self->{api}}) {
138                 push @{$self->{types}}, initType($self, $copyIndex, $obj);
139         }
140
141         bless $self, $class;
142
143         return $self;
144 }
145
146 # class.name to class/name.java
147 sub classToPath {
148         my $api = shift;
149         my $name = shift;
150
151         $name = $api->{vars}->{package}.'.'.$name;
152         $name =~ s@\.@/@g;
153         $name = $api->{vars}->{output}.'/'.$name.'.java';
154         $name;
155 }
156
157 sub closeOutput {
158         my $api = shift;
159         my $name = shift;
160         my $f = shift;
161         my $path = $api->classToPath($name);
162
163         close($f) || die;
164         rename($path.'~', $path) || die ("rename failed: $!");
165 }
166
167 sub openOutput {
168         my $api = shift;
169         my $name = shift;
170         my $path = $api->classToPath($name);
171         my $dir = dirname($path);
172
173         make_path($dir) if (!-d $dir);
174
175         open(my $f, ">", $path.'~') || die ("Cannot open '$path' for writing");
176         print "writing '$path'\n";
177         $f;
178 }
179
180 sub renameFunction {
181         my $api = shift;
182         my $name = shift;
183         $renameTable{$name};
184 }
185
186 sub initType {
187         my $api = shift;
188         my $index = shift;
189         my $obj = shift;
190         my $type = {};
191
192         $type->{options} = [ @{$obj->{options}} ];
193
194         # FIXME: per-item options, set etc?
195         foreach my $inc (@{$obj->{items}}) {
196                 $type->{items}->{$inc->{match}} = $inc->{literal};
197         }
198
199         my $v = optionValue('select', undef, $obj);
200         $type->{select} = $v if defined($v);
201
202         #print "init $obj->{name}\n";
203         foreach my $c (split /,/,optionValue('copy', undef, $obj)) {
204                 my $copy = $index->{$c};
205
206                 if ($copy) {
207                         #print " copy $c\n";
208                         my $proto = initType($api, $index, $copy);
209
210                         foreach my $k (keys %{$proto->{items}}) {
211                                 $type->{items}->{$k} = $proto->{items}->{$k} if !defined($type->{items}->{$k});
212                         }
213
214                         push @{$type->{options}}, @{$proto->{options}};
215                 } else {
216                         die ("type copy target $c not found");
217                 }
218         }
219
220         $type->{regex} = qr/$1/ if $obj->{name} =~ m@/(.*)/@;
221
222         return $type;
223 }
224
225 # returns { type=>$type, match=>$match)
226 #  match is named groups from regex (%+)
227 sub findType {
228         my $api = shift;
229         my $m = shift;
230         my $deref = $m->{deref};
231         my @list;
232
233         foreach my $type (@{$api->{types}}) {
234                 my $select = !defined($type->{select}) || defined($m->{$type->{select}});
235
236                 if ($select && ($deref =~ m/$type->{regex}/)) {
237                         my %match = %+;
238
239                         return { deref=>$deref, type=>$type, match=>\%match };
240                 }
241         }
242         die ("cannot find matching type '$deref' for member $m->{name}");
243         undef;
244 }
245
246 # find value of first option of the given name
247 sub optionValue {
248         my $name = shift;
249         my $or = shift;
250
251         #print "optionValue $name\n";
252         foreach my $obj (@_) {
253                 foreach my $opt (@{$obj->{options}}) {
254                         #print "? $name $opt = ".($opt =~m/^\Q$name\E=(.*)$/)."\n";
255                         #print " = $opt\n" if ($opt =~m/^\Q$name\E=(.*)$/);
256                         return $1 if ($opt =~m/^\Q$name\E=(.*)$/);
257                 }
258         }
259         $or;
260 }
261
262 # look for all matching options of the given name
263 # multiple objects are searched, the first one with
264 #  the given parameter overrides the rest.
265 # name, object, object *
266 sub optionValues {
267         my $name = shift;
268         my $rx = qr/$name/;
269         my @list;
270
271         foreach my $obj (@_) {
272                 foreach my $opt (@{$obj->{options}}) {
273                         push @list, $1 if ($opt =~m/^$rx=(.*)$/);
274                 }
275                 last if ($#list >= 0);
276         }
277         @list;
278 }
279
280 # same as above but doesn't short-circuit
281 sub optionValuesAll {
282         my $name = shift;
283         my $rx = qr/$name/;
284         my @list;
285
286         foreach my $obj (@_) {
287                 foreach my $opt (@{$obj->{options}}) {
288                         push @list, $1 if ($opt =~m/^$rx=(.*)$/);
289                 }
290         }
291         @list;
292 }
293
294 # find first occurance of a flag
295 sub optionFlag {
296         my $name = shift;
297
298         foreach my $obj (@_) {
299                 foreach my $opt (@{$obj->{options}}) {
300                         return 1 if ($opt eq $name);
301                 }
302         }
303         undef;
304 }
305
306 sub findItem {
307         my $s = shift;
308         my $name = shift;
309
310         foreach my $i (@{$s->{items}}) {
311                 return $i if $i->{match} eq $name;
312         }
313         undef;
314 }
315
316 sub findAllItems {
317         my $api = shift;
318         my $obj = shift;
319         my $s = shift;
320         my %visited = ();
321         my @fields = ();
322
323         #print Dumper($obj);
324
325         my @all = @{$s->{items}};
326         my %index;
327
328         foreach my $m (@all) {
329                 $index{$m->{name}} = $m;
330         }
331
332         foreach my $inc (@{$obj->{items}}) {
333                 my $d = $index{$inc->{match}};
334
335                 if ($d) {
336                         next if $visited{$d->{type}.':'.$d->{name}}++;
337                         push @fields, [ $inc, $d ];
338                 } else {
339                         foreach my $d (grep { $_->{name} =~ m/$inc->{regex}/ } @all) {
340                                 next if $visited{$d->{type}.':'.$d->{name}}++;
341                                 push @fields, [ $inc, $d ];
342                         }
343                 }
344         }
345
346         if (optionValue('default', undef, $obj, $api->{index}->{'struct:<default>'}) eq 'all') {
347                 #print "* add all items\n";
348                 foreach my $d (@all) {
349                         next if $visited{$d->{type}.':'.$d->{name}}++;
350                         push @fields, [ $obj, $d ];
351                 }
352         }
353
354         return @fields;
355 }
356
357 sub findField {
358         my $s = shift;
359         my $name = shift;
360
361         foreach my $i (@{$s->{items}}) {
362                 return $i if $i->{name} eq $name;
363         }
364         undef;
365 }
366
367 # ######################################################################
368
369 sub addDependencies {
370         my $api = shift;
371         my $obj = shift;
372         my $s = shift;
373         my $add = shift;
374
375         #print "add deps for '$s->{name}'\n";
376         if ($s->{type} =~ m/^(struct|union)$/n) {
377                 # include embedded structures always
378                 foreach my $d (grep { $_->{type} =~ m/^(struct|union):/ && $_->{deref} =~ m/\[\d+\$\{|^\$\{/ } @{$s->{items}}) {
379                         #print "  embedded $d->{name} $d->{deref}\n";
380                         $add->($d->{type});
381                 }
382
383                 # include selected fields optionally
384                 if ($obj) {
385                         foreach my $i (findAllItems($api, $obj, $s)) {
386                                 my ($inc, $d) = @{$i};
387                                 #print "  selected $d->{name} $d->{type} $d->{deref}\n";
388                                 $add->($d->{type}) if ($d->{type} =~ m/^(struct|union|func|call|enum):/);
389                                 # HACK: enum types are integers but ctype includes the actual type
390                                 $add->("enum:$1") if ($d->{ctype} =~ m/^enum (.+)/);
391                         }
392                 }
393         } elsif ($s->{type} =~ m/^(call|func)/n) {
394                 # for calls/func need all fields
395                 foreach my $d (grep { $_->{type} =~ m/^(struct|union|func|call|enum):/ } @{$s->{items}}, $s->{result}) {
396                         #print "  argument $d->{name} $d->{type} $d->{deref}\n";
397                         $add->($d->{type});
398                 }
399         }
400 }
401
402 # use either {match} or {regex} to get all matches for a data type
403 sub findMatches {
404         my $api = shift;
405         my $inc = shift;
406         my $ctx = shift;
407         my $data = $api->{data};
408
409         if ($inc->{match} eq 'func:<matcher>') {
410                 # or just last option?
411                 my $code;
412
413                 if (defined($inc->{literal})) {
414                         $code = 'sub { '.$inc->{literal}.' }';
415                 } else {
416                         my @options = @{$inc->{options}};
417                         $code = 'sub { '.$options[$#options].'(@_) }';
418                 }
419
420                 my $match = eval $code;
421
422                 if (!defined($match)) {
423                         die "unable to parse match function $inc->{match} $! $@";
424                 }
425                 grep { $match->($_, $ctx) } grep { $_->{type} eq $inc->{type} } values %$data;
426         } else {
427                 my $s = $data->{$inc->{match}};
428
429                 if (defined($s)) {
430                         $s;
431                 } else {
432                         map { $data->{$_} } grep { $_ =~ m/$inc->{regex}/ } keys %$data;
433                 }
434         }
435 }
436
437 # find all extra types used by the api requested
438 sub findDependencies {
439         my $api = shift;
440         my %data = %{$api->{data}};
441         my %seen;
442         my %deps;
443         my $setdeps = sub { my $d = shift; $deps{$d} = 1; };
444
445         print "Root types\n";
446         foreach my $obj (@{$api->{api}}) {
447                 if ($obj->{type} eq 'library') {
448                         foreach my $inc (@{$obj->{items}}) {
449                                 next if ($inc->{type} eq 'library');
450
451                                 #print "? $inc->{regex}\n";
452                                 foreach my $s (findMatches($api, $inc, $obj)) {
453                                         my $n = "$s->{type}:$s->{name}";
454
455                                         print "+ $n\n";
456
457                                         $seen{$n}++;
458                                         $s->{output} = 1;
459                                         addDependencies($api, $obj, $s, $setdeps);
460                                 }
461                         }
462                 } elsif ($obj->{type} =~ m/^(struct|union|call|func|enum|define)$/) {
463                         #foreach my $n (grep { $_ =~ m/$obj->{regex}/ } keys %data) {
464                         foreach my $s (findMatches($api, $obj, $obj)) {
465                                 my $n = "$s->{type}:$s->{name}";
466
467                                 $seen{$n}++;
468                                 $s->{output} = 1;
469                                 addDependencies($api, $obj, $s, $setdeps);
470                         }
471                 }
472         }
473
474         # at this point 'seen' contains everything explicitly requested
475         # and deps is anything else they need but not referenced directly
476         # recursively grab anything else
477
478         my @list = ();
479         my @stack = sort keys %deps;
480         my $pushstack = sub { my $d = shift; push @stack, $d; };
481         while ($#stack >= 0) {
482                 my $n = shift @stack;
483                 my $s;
484
485                 next if $seen{$n}++;
486
487                 $s = $data{$n};
488
489                 if ($s) {
490                         print "Add referent: $n\n";
491                         $s->{output} = 1;
492                         addDependencies($api, $api->{index}->{"$s->{type}:<default>"}, $s, $pushstack);
493                 } elsif ($n =~ m/^(.*):(.*)$/) {
494                         print "Add anonymous: $n\n";
495                         # type not know, add anonymous
496                         $s = {
497                                 name => $2,
498                                 type => $1,
499                                 size => 0,
500                                 items => [],
501                                 output => 1,
502                         };
503                         $api->{data}->{$n} = $s;
504                 }
505
506                 # maybe it should have some skeleton metadata?
507                 # depends on where it's used i suppose
508                 push @list, $s;
509         }
510
511         print "Added ".($#list+1)." dependencies\n";
512         return @list;
513 }
514
515 # ######################################################################
516
517 sub loadAPIFile {
518         my $file = shift;
519         my $info;
520
521         unless ($info = do $file) {
522                 die "couldn't parse $file: $@"  if $@;
523                 die "couldn't import $file: $!" unless defined $info;
524                 die "couldn't run $file"                unless $info;
525         }
526
527         return $info;
528 }
529
530 sub parseRename {
531         my $how = shift;
532         my $rename = $renameTable{'identity'};
533
534         foreach my $n (split /,/,$how) {
535                 my $old = $rename;
536                 my $new = $renameTable{$n};
537
538                 if ($n =~ m@^s/(.*)/(.*)/$@) {
539                         my $rx = qr/$1/;
540                         my $rp = $2;
541                         $rename = sub { my $s=shift; $s = $old->($s); $s =~ s/$rx/$rp/; return $s;};
542                 } elsif ($new) {
543                         $rename = sub { my $s=shift; $s = $old->($s); return $new->($s); };
544                 } else {
545                         my $x = $n;
546                         $rename = sub { return $x; };
547                 }
548         }
549         $rename;
550 }
551
552 # pre-process {data}
553 sub preprocess {
554         my $api = shift;
555
556         # Find any anonymous types and add them in
557         my %anonymous = ();
558         foreach my $s (values %{$api->{data}}) {
559                 # FIXME: fix the list names in export.cc and export-defines
560                 $s->{items} = $s->{fields} if $s->{fields};
561                 $s->{items} = $s->{arguments} if $s->{arguments};
562                 $s->{items} = $s->{values} if $s->{values};
563
564                 foreach my $m (grep { $_->{type} =~ m/struct:|union:/} @{$s->{items}}) {
565                         $anonymous{$m->{type}} = 1 if !defined($api->{data}->{$m->{type}});
566                 }
567
568                 # add 'result' name
569                 $s->{result}->{name} = 'result$' if $s->{type} =~ m/func|call/;
570
571                 # add a canonical deref for all types
572                 if ($s->{type} =~ m/func|call|struct|union/) {
573                         foreach my $m (grep { !defined($_->{deref}) } @{$s->{items}}, ($s->{type} =~ m/func|call/) ? $s->{result} : ()) {
574                                 if ($m->{type} =~ m/^(union|struct):(.*)/) {
575                                         $m->{deref} = "\${$2}";
576                                 } elsif ($m->{ctype} eq 'bitfield') {
577                                         $m->{deref} = "bitfield";
578                                 } else {
579                                         $m->{deref} = $m->{type};
580                                 }
581                         }
582                 }
583
584                 # all 'defines' are output by default
585                 $s->{output} = 1 if $s->{type} eq 'define';
586         }
587
588         foreach my $k (sort keys %anonymous) {
589                 print " anon $k\n";
590                 if ($k =~ m/^(.*):(.*)$/) {
591                         $api->{data}->{$k} = {
592                                 name => $2,
593                                 type => $1,
594                                 size => 0,
595                                 items => [],
596                         };
597                 }
598         }
599 }
600
601 # preprocess {api}
602 sub analyseAPI {
603         my $api = shift;
604
605         # Note that type:name regexes always start at the beginning
606
607         foreach my $obj (@{$api->{api}}) {
608                 if ($obj->{name} =~ m@^/(.*)/$@) {
609                         $obj->{regex} = qr/^$obj->{type}:$1/;
610                 } else {
611                         $obj->{regex} = qr/^$obj->{type}:$obj->{name}$/;
612                 }
613                 $obj->{match} = "$obj->{type}:$obj->{name}";
614
615                 foreach my $opt (@{$obj->{options}}) {
616                         if ($opt =~ m/^(.+:rename)=(.*)$/) {
617                                 $obj->{$1} = parseRename($2);
618                         } elsif ($opt =~ m/^rename=(.*)$/) {
619                                 $obj->{"$obj->{type}:rename"} = parseRename($1);
620                         }
621                 }
622
623                 my $defmode = ($obj->{type} eq 'library' ? 'func' : 'field');
624                 foreach my $inc (@{$obj->{items}}) {
625                         my $match = $inc->{match};
626                         my $mode = $defmode;
627
628                         if ($inc->{match} =~ m/^(.*):(.*)$/) {
629                                 $match = $2;
630                                 $mode = $1;
631                         }
632
633                         $inc->{type} = $mode;
634                         if ($match =~ m@^/(.*)/$@) {
635                                 $inc->{regex} = $mode ne 'field' ? qr/$mode:$1/ : qr/$1/;
636                         } else {
637                                 $inc->{regex} = $mode ne 'field' ? qr/^$mode:$match$/ : qr/^$match$/;
638                         }
639
640                         foreach my $opt (@{$inc->{options}}) {
641                                 if ($opt =~ m/^rename=(.*)$/) {
642                                         #print "option $opt ".Dumper($inc);
643                                         $inc->{"$mode:rename"} = parseRename($1);
644                                 }
645                         }
646
647                         $inc->{"$mode:rename"} = $obj->{"$mode:rename"} if (!(defined($inc->{"$mode:rename"})) && defined($obj->{"$mode:rename"}));
648                 }
649         }
650 }
651
652 #
653 # 'lib/struct/func' level    'lib.inc' level            'func/struct.inc' level  setting
654 #  array:name1                array:name1                array                    char* is array, void* is a Segment
655 #  array-size:name1=name2     array-size:name1=name2     array-size=name2         implied array size from name2
656 #  implied:name1=expr         implied:name1=expr         implied=expr             value of name1 is calculated from other arguments
657 #  instance:name1             instance:name1             instance                 parameter/return is instance, implies non-static function
658
659 #  scope:name1=scope[,close]  scope:name1=scope[,close]  scope=scope[,close]      parameter/return is a new instance with given scope
660 #  success:name1=values       success:name1=values       success=values           which parameter and values indicate integer success
661 #                                                                                 pointer types are considered in/out and implied
662 #  success:name1=!null        success:name1=!null        success=!null            which parameter and values indicate non-null success
663 #  return:name1               return:name1               return                   return this output argument instead of the return code
664
665 #  access:name1=rwi           access:name1=rwi           access=rwi               set access type, read, write, indexed
666 #  access=rwi                 access=rwi                 access=rwi                - can also be set as default
667
668 #  onsuccess=blah             onsuccess=blah             onsuccess=blah
669
670 # 'name' is parameter name, or parameter index, or result$ for return value
671 # scope is instance for instance-scope, explicit for explicit scope, global for global scope.  default is global.
672
673 # err, maybe this format makes more sense:
674 #   name1:success=values   name1:success=values  success=values
675 #   name1:instance         name1:instance        instance
676
677 my @itemFlags = (
678         'array',
679         'segment',
680         'instance',
681         'return',
682         'raw',
683         'raw-in',
684 );
685
686 my @itemOptions = (
687         'array-size',
688         'scope',
689         'success',
690         'implied',
691         'tonative',
692 );
693
694 my @itemAnyOptions = (
695         'access',
696 );
697
698 # process struct->field
699 #  api, obj (struct, func), inc (field entry), s (struct), m (struct field)
700 # Note: keep in sync with processFunc
701 sub processField {
702         my $api = shift;
703         my $obj = shift;
704         my $inc = shift;
705         my $s = shift;
706         my $m = shift;
707         my $def = $api->{index}->{"$s->{type}:<default>"};
708
709         #print "process $s->{type}:$s->{name}.$m->{name}\n";
710         #print "  $m->{name}\n";
711
712         foreach my $flag (@itemFlags) {
713                 my $value = optionFlag("$flag", $inc);
714                 $value = optionFlag("$flag:$m->{name}", $obj, $def) if !defined($value);
715                 $m->{$flag} = $value if (defined($value));
716         }
717         foreach my $option (@itemOptions) {
718                 my $value = optionValue("$option", undef, $inc);
719                 $value = optionValue("$option:$m->{name}", undef, $obj, $def) if !defined($value);
720                 $m->{$option} = $value if (defined($value));
721         }
722         foreach my $option (@itemAnyOptions) {
723                 my $value = optionValue("$option", undef, $inc);
724                 $value = optionValue("$option:$m->{name}", undef, $obj, $def) if !defined($value);
725                 $value = optionValue("$option", undef, $obj, $def) if !defined($value);
726                 $m->{$option} = $value if (defined($value));
727         }
728
729         $m->{output} = 1;
730         $m->{rename} = (first { defined $_ } $inc->{'field:rename'}, $obj->{'field:rename'}, $def->{'field:rename'}, $renameTable{identity})->($m->{name});
731 }
732
733 # process func or call main type
734 sub processTypeFunc {
735         my $api = shift;
736         my $seen = shift;
737         my $obj = shift;
738         my $def = $api->{index}->{"$obj->{type}:<default>"};
739
740         foreach my $s (@_) {
741                 my $v;
742
743                 if ($seen->{"$s->{type}:$s->{name}"}++) { print "warning: seen $s->{type}:$s->{name}\n"; next; }
744
745                 print " $s->{name}\n" if ($api->{vars}->{verbose} > 1);
746
747                 foreach my $m ($s->{result}, @{$s->{items}}) {
748                         my $inc = findItem($obj, $m->{name});
749
750                         processField($api, $obj, $inc, $s, $m);
751                 }
752
753                 $s->{rename} = (first { defined $_ } $obj->{"$s->{type}:rename"}, $renameTable{identity})->($s->{name});
754                 $s->{access} = optionValue('access', '', $obj, $def);
755                 $v = optionValue('onsuccess', undef, $obj, $def);
756                 $s->{onsuccess} = $v if defined $v;
757
758                 postProcessType($s);
759         }
760 }
761
762 # process library->func
763 # process struct->func
764 #  api, obj (library, struct), inc (func entry), s ($data->{func:name})
765 # Note: keep in sync with processField
766 sub processFunc {
767         my $api = shift;
768         my $obj = shift;
769         my $inc = shift;
770         my $s = shift;
771         my $index = -1;
772         my $def = $api->{index}->{"$s->{type}:<default>"};
773         my $v;
774
775         print "process $s->{type}:$s->{name}\n" if ($api->{vars}->{verbose} > 1);
776
777         foreach my $m (defined($s->{result}) ? $s->{result} : (), @{$s->{items}}) {
778                 #print "  $m->{name}\n";
779
780                 foreach my $flag (@itemFlags) {
781                         my $value = optionFlag("$flag:$m->{name}", $inc, $obj, $def);
782                         $value = optionFlag("$flag:$index", $inc, $obj, $def) if !defined($value);
783                         $m->{$flag} = $value if (defined($value));
784                 }
785                 foreach my $option (@itemOptions) {
786                         my $value = optionValue("$option:$m->{name}", undef, $inc, $obj, $def);
787                         $value = optionValue("$option:$index", undef, $inc, $obj, $def) if !defined($value);
788                         $m->{$option} = $value if (defined($value));
789                 }
790                 foreach my $option (@itemAnyOptions) {
791                         my $value = optionValue("$option:$m->{name}", undef, $inc, $obj, $def);
792                         $value = optionValue("$option:$index", undef, $inc, $obj, $def) if !defined($value);
793                         $value = optionValue("$option", undef, $inc, $obj, $def) if !defined($value);
794                         $m->{$option} = $value if (defined($value));
795                 }
796                 $m->{output} = 1;
797                 $index++;
798         }
799
800         $s->{rename} = (first { defined $_ } $inc->{"$s->{type}:rename"}, $obj->{"$s->{type}:rename"}, $renameTable{identity})->($s->{name});
801         $s->{access} = optionValue('access', '', $inc, $obj, $def);
802         $v = optionValue('onsuccess', undef, $inc, $obj, $def);
803         $s->{onsuccess} = $v if defined ($v);
804
805         postProcessType($s);
806 }
807
808 # finally link up array sizes and work out what is output or not
809 # TODO: struct field array-size should be output but not included in constructors?
810 sub postProcessType {
811         my $s = shift;
812         my $static = 1;
813
814         foreach my $m (defined($s->{result}) ? $s->{result} : (), @{$s->{items}}) {
815                 $static = 0 if ($m->{instance});
816
817                 # FIXME: collect multiple scopes here
818                 $s->{scope} = 'explicit' if ($m->{scope} =~ m/^explicit$|^explicit,(.*)$/);
819                 $s->{scope} = 'global' if ($m->{scope} eq 'global');
820                 $s->{scope} = 'object' if ($m->{scope} eq 'object');
821
822                 if ($m->{'array-size'}) {
823                         my $size = findField($s, $m->{'array-size'});
824
825                         print Dumper($s) if (!defined($size));
826                         die "can't find array-size=$m->{'array-size'}" if !defined($size);
827
828                         $size->{output} = 0 if ($s->{type} =~ m/func|call/);
829                         $size->{'array-size-source'} = $m;
830                         $m->{'array-size'} = $size;
831                 }
832
833                 # no java arg for instance parameter
834                 $m->{output} = 0 if ($m->{instance});
835                 # don't generate java args for values calculated
836                 $m->{output} = 0 if (defined($m->{implied}));
837                 # don't generate java args for return statuss unless they're also the constructed value
838                 $m->{output} = 0 if (defined($m->{success}) && !$m->{scope});
839                 # don't generate java args for output arguments
840                 $m->{output} = 0 if ($m->{scope} && $m->{name} ne 'result$');
841
842                 # link success/return fields to struct/func
843                 $s->{success} = $m if defined($m->{success});
844                 $s->{return} = $m if ($m->{return});
845         }
846
847         $s->{static} = $static;
848
849         # TODO: default scope?  or from struct:<default> etc?
850 }
851
852 # transfer info from {api} to {data}
853 sub processFields {
854         my $api = shift;
855         my $seen = shift;
856         my $obj = shift;
857         my $inc = shift;
858         my $s = shift;
859
860         foreach my $m (@_) {
861                 next if $seen->{$m->{name}}++;
862
863                 processField($api, $obj, $inc, $s, $m);
864         }
865 }
866
867 # process a struct/union
868 # these have fields as well as potentially other included types
869 sub processType {
870         my $api = shift;
871         my $seen = shift;
872         my $obj = shift;
873         my $def = $api->{index}->{"$obj->{type}:<default>"};
874
875         foreach my $s (@_) {
876                 my $memberseen = {};
877
878                 next if ($seen->{"$s->{type}:$s->{name}"}++);
879
880                 print "process type $s->{type}:$s->{name}\n" if ($api->{vars}->{verbose} > 1);
881
882                 # process the struct/union fields first
883                 foreach my $inc (grep { $_->{type} eq 'field' } @{$obj->{items}}) {
884                         my @list = grep { $_->{name} =~ m/$inc->{regex}/ } @{$s->{items}};
885
886                         processFields($api, $memberseen, $obj, $inc, $s, @list);
887                 }
888
889                 if (optionValue('default', undef, $obj, $def) eq 'all') {
890                         print " + adding all fields\n" if ($api->{vars}->{verbose} > 1);
891                         processFields($api, $memberseen, $obj, undef, $s, @{$s->{items}});
892                 }
893
894                 $s->{rename} = (first { defined $_ } $obj->{"$s->{type}:rename"}, $def->{"$s->{type}:rename"}, $renameTable{identity})->($s->{name});
895
896                 # finish off
897                 postProcessType($s);
898
899                 # handle other types included/mark them no-output
900                 $seen->{"$s->{type}:$s->{name}"} = 0;
901                 processLibrary($api, $seen, $obj, $s);
902         }
903
904 }
905
906 sub processLibrary {
907         my $api = shift;
908         my $seen = shift;
909         my $lib = shift;
910         my $ctx = shift;
911         my $data = $api->{data};
912
913         return if ($seen->{"$lib->{type}:$lib->{name}"}++);
914
915         print "process library $lib->{type}:$lib->{name}\n";
916         #print 'lib='.Dumper($lib);
917         #print 'lib.options='.Dumper($lib->{options});
918
919         # TODO: embedded types
920
921         foreach my $inc (@{$lib->{items}}) {
922                 print " $inc->{match}\n" if ($api->{vars}->{verbose} > 1);
923
924                 if ($inc->{type} =~ m/func|call/on) {
925                         my @list = findMatches($api, $inc, $ctx);
926
927                         #print 'inc='.Dumper($inc);
928                         #print "match $inc->{regex} .options=".Dumper($inc->{options});
929
930                         foreach my $s (@list) {
931                                 if ($seen->{"$s->{type}:$s->{name}"}++) { print "warning: seen $s->{type}:$s->{name}\n"; next; }
932
933                                 #print " $s->{name}\n";
934                                 processFunc($api, $lib, $inc, $s);
935
936                                 #print 'func='.Dumper($s);
937                         }
938                 } elsif ($inc->{type} eq 'library') {
939                         foreach my $l (grep { "$_->{type}:$_->{name}" =~ m/$inc->{regex}/ } @{$api->{api}}) {
940                                 # included libraries are never output directly
941                                 $l->{output} = 0;
942                                 processLibrary($api, $seen, $l, $ctx);
943                         }
944                 } elsif ($inc->{type} =~ m/define|enum/on) {
945                         # suppress direct output of anything included
946                         foreach my $c (findMatches($api, $inc, $ctx)) {
947                                 $c->{output} = 0;
948                         }
949                 }
950         }
951 }
952
953 sub postprocess {
954         my $api = shift;
955         my $seen = {};
956         my %data = %{$api->{data}};
957
958         # apply requested options to specific objects (not defaults)
959         foreach my $obj (grep {$_->{type} =~ m/^(func|call|struct|union)$/} @{$api->{api}}) {
960                 my @list = findMatches($api, $obj, $obj);
961
962                 if ($obj->{type} =~ m/func|call/) {
963                         processTypeFunc($api, $seen, $obj, @list);
964                 } else {
965                         processType($api, $seen, $obj, @list);
966                 }
967         }
968
969         # handle libraries
970         foreach my $lib (grep {$_->{type} eq 'library'} @{$api->{api}}) {
971                 next if defined($lib->{output});
972                 $lib->{output} = 1;
973                 processLibrary($api, $seen, $lib, $lib);
974         }
975
976         # apply options for default object types
977         foreach my $obj (grep {$_->{name} eq '<default>'} @{$api->{api}}) {
978                 my @list;
979
980                 @list = grep { !defined($seen->{"$_->{type}:$_->{name}"}) && $_->{type} eq $obj->{type} } values %data;
981
982                 print "apply $obj->{type}:$obj->{name} to ".($#list + 1)." objects\n" if ($#list >= 0);
983
984                 if ($obj->{type} =~ m/func|call/) {
985                         processTypeFunc($api, $seen, $obj, @list);
986                 } else {
987                         processType($api, $seen, $obj, @list);
988                 }
989         }
990 }
991
992 1;