summaryrefslogtreecommitdiff
path: root/src/itf2h.pl
blob: 9ebce6525a4c23844bdd52a8219408b03d9dc5b7 (plain)
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);