xref: /original-bsd/contrib/perl-4.036/h2ph.SH (revision c3e32dec) 
1case $CONFIG in
2'')
3    if test ! -f config.sh; then
4	ln ../config.sh . || \
5	ln ../../config.sh . || \
6	ln ../../../config.sh . || \
7	(echo "Can't find config.sh."; exit 1)
8    fi 2>/dev/null
9    . ./config.sh
10    ;;
11esac
12: This forces SH files to create target in same directory as SH file.
13: This is so that make depend always knows where to find SH derivatives.
14case "$0" in
15*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
16esac
17echo "Extracting h2ph (with variable substitutions)"
18: This section of the file will have variable substitutions done on it.
19: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
20: Protect any dollar signs and backticks that you do not want interpreted
21: by putting a backslash in front.  You may delete these comments.
22rm -f h2ph
23$spitshell >h2ph <<!GROK!THIS!
24#!$bin/perl
25'di';
26'ig00';
27
28\$perlincl = '$installprivlib';
29!GROK!THIS!
30
31: In the following dollars and backticks do not need the extra backslash.
32$spitshell >>h2ph <<'!NO!SUBS!'
33
34chdir '/usr/include' || die "Can't cd /usr/include";
35
36@isatype = split(' ',<<END);
37	char	uchar	u_char
38	short	ushort	u_short
39	int	uint	u_int
40	long	ulong	u_long
41	FILE
42END
43
44@isatype{@isatype} = (1) x @isatype;
45
46@ARGV = ('-') unless @ARGV;
47
48foreach $file (@ARGV) {
49    if ($file eq '-') {
50	open(IN, "-");
51	open(OUT, ">-");
52    }
53    else {
54	($outfile = $file) =~ s/\.h$/.ph/ || next;
55	print "$file -> $outfile\n";
56	if ($file =~ m|^(.*)/|) {
57	    $dir = $1;
58	    if (!-d "$perlincl/$dir") {
59		mkdir("$perlincl/$dir",0777);
60	    }
61	}
62	open(IN,"$file") || ((warn "Can't open $file: $!\n"),next);
63	open(OUT,">$perlincl/$outfile") || die "Can't create $outfile: $!\n";
64    }
65    while (<IN>) {
66	chop;
67	while (/\\$/) {
68	    chop;
69	    $_ .= <IN>;
70	    chop;
71	}
72	if (s:/\*:\200:g) {
73	    s:\*/:\201:g;
74	    s/\200[^\201]*\201//g;	# delete single line comments
75	    if (s/\200.*//) {		# begin multi-line comment?
76		$_ .= '/*';
77		$_ .= <IN>;
78		redo;
79	    }
80	}
81	if (s/^#\s*//) {
82	    if (s/^define\s+(\w+)//) {
83		$name = $1;
84		$new = '';
85		s/\s+$//;
86		if (s/^\(([\w,\s]*)\)//) {
87		    $args = $1;
88		    if ($args ne '') {
89			foreach $arg (split(/,\s*/,$args)) {
90			    $arg =~ s/^\s*([^\s].*[^\s])\s*$/$1/;
91			    $curargs{$arg} = 1;
92			}
93			$args =~ s/\b(\w)/\$$1/g;
94			$args = "local($args) = \@_;\n$t    ";
95		    }
96		    s/^\s+//;
97		    do expr();
98		    $new =~ s/(["\\])/\\$1/g;
99		    if ($t ne '') {
100			$new =~ s/(['\\])/\\$1/g;
101			print OUT $t,
102			  "eval 'sub $name {\n$t    ${args}eval \"$new\";\n$t}';\n";
103		    }
104		    else {
105			print OUT "sub $name {\n    ${args}eval \"$new\";\n}\n";
106		    }
107		    %curargs = ();
108		}
109		else {
110		    s/^\s+//;
111		    do expr();
112		    $new = 1 if $new eq '';
113		    if ($t ne '') {
114			$new =~ s/(['\\])/\\$1/g;
115			print OUT $t,"eval 'sub $name {",$new,";}';\n";
116		    }
117		    else {
118			print OUT $t,"sub $name {",$new,";}\n";
119		    }
120		}
121	    }
122	    elsif (/^include\s+<(.*)>/) {
123		($incl = $1) =~ s/\.h$/.ph/;
124		print OUT $t,"require '$incl';\n";
125	    }
126	    elsif (/^ifdef\s+(\w+)/) {
127		print OUT $t,"if (defined &$1) {\n";
128		$tab += 4;
129		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
130	    }
131	    elsif (/^ifndef\s+(\w+)/) {
132		print OUT $t,"if (!defined &$1) {\n";
133		$tab += 4;
134		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
135	    }
136	    elsif (s/^if\s+//) {
137		$new = '';
138		do expr();
139		print OUT $t,"if ($new) {\n";
140		$tab += 4;
141		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
142	    }
143	    elsif (s/^elif\s+//) {
144		$new = '';
145		do expr();
146		$tab -= 4;
147		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
148		print OUT $t,"}\n${t}elsif ($new) {\n";
149		$tab += 4;
150		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
151	    }
152	    elsif (/^else/) {
153		$tab -= 4;
154		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
155		print OUT $t,"}\n${t}else {\n";
156		$tab += 4;
157		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
158	    }
159	    elsif (/^endif/) {
160		$tab -= 4;
161		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
162		print OUT $t,"}\n";
163	    }
164	}
165    }
166    print OUT "1;\n";
167}
168
169sub expr {
170    while ($_ ne '') {
171	s/^(\s+)//		&& do {$new .= ' '; next;};
172	s/^(0x[0-9a-fA-F]+)//	&& do {$new .= $1; next;};
173	s/^(\d+)//		&& do {$new .= $1; next;};
174	s/^("(\\"|[^"])*")//	&& do {$new .= $1; next;};
175	s/^'((\\"|[^"])*)'//	&& do {
176	    if ($curargs{$1}) {
177		$new .= "ord('\$$1')";
178	    }
179	    else {
180		$new .= "ord('$1')";
181	    }
182	    next;
183	};
184	s/^sizeof\s*\(([^)]+)\)/{$1}/ && do {
185	    $new .= '$sizeof';
186	    next;
187	};
188	s/^([_a-zA-Z]\w*)//	&& do {
189	    $id = $1;
190	    if ($id eq 'struct') {
191		s/^\s+(\w+)//;
192		$id .= ' ' . $1;
193		$isatype{$id} = 1;
194	    }
195	    elsif ($id eq 'unsigned') {
196		s/^\s+(\w+)//;
197		$id .= ' ' . $1;
198		$isatype{$id} = 1;
199	    }
200	    if ($curargs{$id}) {
201		$new .= '$' . $id;
202	    }
203	    elsif ($id eq 'defined') {
204		$new .= 'defined';
205	    }
206	    elsif (/^\(/) {
207		s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i;	# cheat
208		$new .= " &$id";
209	    }
210	    elsif ($isatype{$id}) {
211		if ($new =~ /{\s*$/) {
212		    $new .= "'$id'";
213		}
214		elsif ($new =~ /\(\s*$/ && /^[\s*]*\)/) {
215		    $new =~ s/\(\s*$//;
216		    s/^[\s*]*\)//;
217		}
218		else {
219		    $new .= $id;
220		}
221	    }
222	    else {
223		$new .= ' &' . $id;
224	    }
225	    next;
226	};
227	s/^(.)//			&& do {$new .= $1; next;};
228    }
229}
230##############################################################################
231
232	# These next few lines are legal in both Perl and nroff.
233
234.00;			# finish .ig
235
236'di			\" finish diversion--previous line must be blank
237.nr nl 0-1		\" fake up transition to first page again
238.nr % 0			\" start at page 1
239'; __END__ ############# From here on it's a standard manual page ############
240!NO!SUBS!
241cat << ENDOFMAN > h2ph.man
242.TH H2PH 1 "August 8, 1990"
243.AT 3
244.SH NAME
245h2ph \- convert .h C header files to .ph Perl header files
246.SH SYNOPSIS
247.B h2ph [headerfiles]
248.SH DESCRIPTION
249.I h2ph
250converts any C header files specified to the corresponding Perl header file
251format.
252It is most easily run while in /usr/include:
253.nf
254
255	cd /usr/include; h2ph * sys/*
256
257.fi
258If run with no arguments, filters standard input to standard output.
259.SH ENVIRONMENT
260No environment variables are used.
261.SH FILES
262/usr/include/*.h
263.br
264/usr/include/sys/*.h
265.br
266etc.
267.SH AUTHOR
268Larry Wall
269.SH "SEE ALSO"
270perl(1)
271.SH DIAGNOSTICS
272The usual warnings if it can't read or write the files involved.
273.SH BUGS
274Doesn't construct the %sizeof array for you.
275.PP
276It doesn't handle all C constructs, but it does attempt to isolate
277definitions inside evals so that you can get at the definitions
278that it can translate.
279.PP
280It's only intended as a rough tool.
281You may need to dicker with the files produced.
282.ex
283ENDOFMAN
284chmod 755 h2ph
285$eunicefix h2ph
286