[p5sagit/p5-mst-13.2.git] / h2ph.SH

case $CONFIG in
'')
    if test ! -f config.sh; then
	ln ../config.sh . || \
	ln ../../config.sh . || \
	ln ../../../config.sh . || \
	(echo "Can't find config.sh."; exit 1)
    fi 2>/dev/null
    . ./config.sh
    ;;
esac
: This forces SH files to create target in same directory as SH file.
: This is so that make depend always knows where to find SH derivatives.
case "$0" in
*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
esac
echo "Extracting h2ph (with variable substitutions)"
: This section of the file will have variable substitutions done on it.
: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
: Protect any dollar signs and backticks that you do not want interpreted
: by putting a backslash in front.  You may delete these comments.
rm -f h2ph
$spitshell >h2ph <<!GROK!THIS!
#!$bin/perl
'di ';
'ds 00 \"';
'ig 00 ';

\$perlincl = '$archlibexp';
!GROK!THIS!

: In the following dollars and backticks do not need the extra backslash.
$spitshell >>h2ph <<'!NO!SUBS!'

chdir '/usr/include' || die "Can't cd /usr/include";

@isatype = split(' ',<<END);
	char	uchar	u_char
	short	ushort	u_short
	int	uint	u_int
	long	ulong	u_long
	FILE
END

@isatype{@isatype} = (1) x @isatype;

@ARGV = ('-') unless @ARGV;

foreach $file (@ARGV) {
    if ($file eq '-') {
	open(IN, "-");
	open(OUT, ">-");
    }
    else {
	($outfile = $file) =~ s/\.h$/.ph/ || next;
	print "$file -> $outfile\n";
	if ($file =~ m|^(.*)/|) {
	    $dir = $1;
	    if (!-d "$perlincl/$dir") {
		mkdir("$perlincl/$dir",0777);
	    }
	}
	open(IN,"$file") || ((warn "Can't open $file: $!\n"),next);
	open(OUT,">$perlincl/$outfile") || die "Can't create $outfile: $!\n";
    }
    while (<IN>) {
	chop;
	while (/\\$/) {
	    chop;
	    $_ .= <IN>;
	    chop;
	}
	if (s:/\*:\200:g) {
	    s:\*/:\201:g;
	    s/\200[^\201]*\201//g;	# delete single line comments
	    if (s/\200.*//) {		# begin multi-line comment?
		$_ .= '/*';
		$_ .= <IN>;
		redo;
	    }
	}
	if (s/^#\s*//) {
	    if (s/^define\s+(\w+)//) {
		$name = $1;
		$new = '';
		s/\s+$//;
		if (s/^\(([\w,\s]*)\)//) {
		    $args = $1;
		    if ($args ne '') {
			foreach $arg (split(/,\s*/,$args)) {
			    $arg =~ s/^\s*([^\s].*[^\s])\s*$/$1/;
			    $curargs{$arg} = 1;
			}
			$args =~ s/\b(\w)/\$$1/g;
			$args = "local($args) = \@_;\n$t    ";
		    }
		    s/^\s+//;
		    do expr();
		    $new =~ s/(["\\])/\\$1/g;
		    if ($t ne '') {
			$new =~ s/(['\\])/\\$1/g;
			print OUT $t,
			  "eval 'sub $name {\n$t    ${args}eval \"$new\";\n$t}';\n";
		    }
		    else {
			print OUT "sub $name {\n    ${args}eval \"$new\";\n}\n";
		    }
		    %curargs = ();
		}
		else {
		    s/^\s+//;
		    do expr();
		    $new = 1 if $new eq '';
		    if ($t ne '') {
			$new =~ s/(['\\])/\\$1/g;
			print OUT $t,"eval 'sub $name {",$new,";}';\n";
		    }
		    else {
			print OUT $t,"sub $name {",$new,";}\n";
		    }
		}
	    }
	    elsif (/^include\s+<(.*)>/) {
		($incl = $1) =~ s/\.h$/.ph/;
		print OUT $t,"require '$incl';\n";
	    }
	    elsif (/^ifdef\s+(\w+)/) {
		print OUT $t,"if (defined &$1) {\n";
		$tab += 4;
		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
	    }
	    elsif (/^ifndef\s+(\w+)/) {
		print OUT $t,"if (!defined &$1) {\n";
		$tab += 4;
		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
	    }
	    elsif (s/^if\s+//) {
		$new = '';
		do expr();
		print OUT $t,"if ($new) {\n";
		$tab += 4;
		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
	    }
	    elsif (s/^elif\s+//) {
		$new = '';
		do expr();
		$tab -= 4;
		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
		print OUT $t,"}\n${t}elsif ($new) {\n";
		$tab += 4;
		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
	    }
	    elsif (/^else/) {
		$tab -= 4;
		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
		print OUT $t,"}\n${t}else {\n";
		$tab += 4;
		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
	    }
	    elsif (/^endif/) {
		$tab -= 4;
		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
		print OUT $t,"}\n";
	    }
	}
    }
    print OUT "1;\n";
}

sub expr {
    while ($_ ne '') {
	s/^(\s+)//		&& do {$new .= ' '; next;};
	s/^(0x[0-9a-fA-F]+)//	&& do {$new .= $1; next;};
	s/^(\d+)//		&& do {$new .= $1; next;};
	s/^("(\\"|[^"])*")//	&& do {$new .= $1; next;};
	s/^'((\\"|[^"])*)'//	&& do {
	    if ($curargs{$1}) {
		$new .= "ord('\$$1')";
	    }
	    else {
		$new .= "ord('$1')";
	    }
	    next;
	};
	s/^sizeof\s*\(([^)]+)\)/{$1}/ && do {
	    $new .= '$sizeof';
	    next;
	};
	s/^([_a-zA-Z]\w*)//	&& do {
	    $id = $1;
	    if ($id eq 'struct') {
		s/^\s+(\w+)//;
		$id .= ' ' . $1;
		$isatype{$id} = 1;
	    }
	    elsif ($id eq 'unsigned') {
		s/^\s+(\w+)//;
		$id .= ' ' . $1;
		$isatype{$id} = 1;
	    }
	    if ($curargs{$id}) {
		$new .= '$' . $id;
	    }
	    elsif ($id eq 'defined') {
		$new .= 'defined';
	    }
	    elsif (/^\(/) {
		s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i;	# cheat
		$new .= " &$id";
	    }
	    elsif ($isatype{$id}) {
		if ($new =~ /{\s*$/) {
		    $new .= "'$id'";
		}
		elsif ($new =~ /\(\s*$/ && /^[\s*]*\)/) {
		    $new =~ s/\(\s*$//;
		    s/^[\s*]*\)//;
		}
		else {
		    $new .= $id;
		}
	    }
	    else {
		$new .= ' &' . $id;
	    }
	    next;
	};
	s/^(.)//			&& do {$new .= $1; next;};
    }
}
##############################################################################

	# These next few lines are legal in both Perl and nroff.

.00 ;			# finish .ig

'di			\" finish diversion--previous line must be blank
.nr nl 0-1		\" fake up transition to first page again
.nr % 0			\" start at page 1
'; __END__ ############# From here on it's a standard manual page ############
.TH H2PH 1 "August 8, 1990"
.AT 3
.SH NAME
h2ph \- convert .h C header files to .ph Perl header files
.SH SYNOPSIS
.B h2ph [headerfiles]
.SH DESCRIPTION
.I h2ph
converts any C header files specified to the corresponding Perl header file
format.
It is most easily run while in /usr/include:
.nf

	cd /usr/include; h2ph * sys/*

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