1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
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);
|