NotZed's Source Code Repository - panamaz/blob - 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;