diff options
Diffstat (limited to 'src/itf2h.pl')
| -rwxr-xr-x | src/itf2h.pl | 146 |
1 files changed, 146 insertions, 0 deletions
diff --git a/src/itf2h.pl b/src/itf2h.pl new file mode 100755 index 0000000..9ebce65 --- /dev/null +++ b/src/itf2h.pl @@ -0,0 +1,146 @@ +#!/usr/bin/perl + +use strict; +use warnings; + + +# itf1 => { name, comment, methods, signals, properties }, ... +# methods = [ { name, comment, flags, in => [ [ type, name ], .. ], out }, .. ] +# signals = [ { name, comment, args => [ [ type, name ], .. ] }, .. ] +# properties = [ { type, name, comment }, .. ] +sub read_itf { + my %itf; + my $itf; + my $comment = ''; + my $sect; + + while(<>) { + chomp; + s/[\s\t]+/ /g; + s/ $//; + next if !$_; + + # Comment + if(/^ *#(.+)$/) { + $comment = "\n" if !$comment; + $comment .= $1; + next; + } + + # New interface + if(/^([^ ]+) ([^ ]+)$/) { + $itf = $1; + $itf{$itf} = { name => $2, comment => $comment, map +($_=>[]), qw|methods signals properties| }; + $comment = ''; + $sect = ''; + next; + } + die "Unknown directive or not in an interface: $_\n" if !$itf; + + # Section switcher + if(/^ -- (methods|signals|properties)$/) { + $sect = $1; + next; + } + die "Unknown directive or not in a section: $_\n" if !$sect; + + # Method start + if($sect eq 'methods' && /^ ([^ ]+)(?: \[([^ ]+)\])?$/) { + push @{$itf{$itf}{methods}}, { name => $1, comment => $comment, flags => $2, in => [], out => [] }; + $comment = ''; + next; + } + + # Method arg + if($sect eq 'methods' && /^ (in|out) ([^ ]+) ([^ ]+)$/) { + die "Argument before method name: $_\n" if !@{$itf{$itf}{methods}}; + push @{$itf{$itf}{methods}[$#{$itf{$itf}{methods}}]{$1}}, [ $2, $3 ]; + next; + } + + # Signal start + if($sect eq 'signals' && /^ ([^ ]+)(?: \[([^ ]+)\])?$/) { + push @{$itf{$itf}{signals}}, { name => $1, comment => $comment, flags => $2, args => [] }; + $comment = ''; + next; + } + + # Signal arg + if($sect eq 'signals' && /^ ([^ ]+) ([^ ]+)$/) { + die "Argument before signal name: $_\n" if !@{$itf{$itf}{signals}}; + push @{$itf{$itf}{signals}[$#{$itf{$itf}{signals}}]{args}}, [ $1, $2 ]; + next; + } + + # Properties + if($sect eq 'properties' && /^ ([^ ]+) ([^ ]+) ([^ ]+)$/) { + push @{$itf{$itf}{properties}}, { type => $1, name => $2, flags => $3, comment => $comment }; + $comment = ''; + next; + } + + die "Unknown directive: $_\n"; + } + + return %itf; +} + + +sub write_h { + my %itf = @_; + + my $argl = sub { + my($n, $a) = @_; + printf "static char *_itf_%s[] = {\n\t", $n; + print join ', ', map(qq{"$_->[0]", "$_->[1]"}, @$a), 'NULL'; + print "\n};\n"; + }; + + my $flags = sub { + my $f = shift->{flags}||''; + return join '|', 0, map $f=~/$_/?("ITFF_\U$_"):(), qw|deprecated noreply read write emitnone emitchange|; + }; + + print "/* File automatically generated by itf2h.pl, DO NOT EDIT. */\n\n"; + for my $itf (keys %itf) { + printf "\n#if !defined(ITF_IMPL_%s) && !defined(ITF_IMPL_ALL)\n", $itf; + printf "extern itf_t *itf_%s;\n", $itf; + printf "#else\n\n", $itf; + + # Method arguments + for my $m (@{$itf{$itf}{methods}}) { + $argl->(sprintf("%s_%s_%s", $itf, $m->{name}, $_), $m->{$_}) for ('in', 'out'); + } + + # Method list + printf "\nstatic itf_method_t _itf_%s_methods[] = {", $itf; + print join ",", map sprintf("\n\t".'{"%2$s", %3$s, _itf_%1$s_%2$s_in, _itf_%1$s_%2$s_out}', $itf, $_->{name}, $flags->($_)), @{$itf{$itf}{methods}}; + print "\n};\n\n"; + + # Signal arguments + $argl->(sprintf("%s_%s_args", $itf, $_->{name}), $_->{args}) for (@{$itf{$itf}{signals}}); + + # Signal list + printf "\nstatic itf_signal_t _itf_%s_signals[] = {", $itf; + print join ",", map sprintf("\n\t".'{"%2$s", %3$s, _itf_%1$s_%2$s_args}', $itf, $_->{name}, $flags->($_)), @{$itf{$itf}{signals}}; + print "\n};\n"; + + # Properties + printf "\nstatic itf_property_t _itf_%s_properties[] = {", $itf; + print join ",", map sprintf("\n\t".'{"%s", "%s", %s}', $_->{name}, $_->{type}, $flags->($_)), @{$itf{$itf}{properties}}; + print "\n};\n\n"; + + # The interface object + printf "itf_t _itf_%s = {\n", $itf; + printf "\t\"%s\",\n", $itf{$itf}{name}; + printf "\t%d, %d, %d,\n", scalar @{$itf{$itf}{methods}}, scalar @{$itf{$itf}{signals}}, scalar @{$itf{$itf}{properties}}; + printf "\t".'_itf_%s_methods, _itf_%1$s_signals, _itf_%1$s_properties'."\n", $itf; + print "};\n"; + printf "itf_t *itf_%s = &_itf_%1\$s;\n\n", $itf; + + printf "#endif /* ITF_IMPL_%s */\n\n", $itf; + } +} + +my %interfaces = read_itf; +write_h(%interfaces); |