Repository List / webpac / openisis / 0.9.0 / oipc @ HEAD

#!/usr/bin/perl -w
#/*
#	openisis - an open implementation of the CDS/ISIS database
#	Version 0.8.x (patchlevel see file Version)
#	Copyright (C) 2001-2003 by Erik Grziwotz, erik@openisis.org
#
#	This library is free software; you can redistribute it and/or
#	modify it under the terms of the GNU Lesser General Public
#	License as published by the Free Software Foundation; either
#	version 2.1 of the License, or (at your option) any later version.
#
#	This library is distributed in the hope that it will be useful,
#	but WITHOUT ANY WARRANTY; without even the implied warranty of
#	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
#	Lesser General Public License for more details.
#
#	You should have received a copy of the GNU Lesser General Public
#	License along with this library; if not, write to the Free Software
#	Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#	see README for more information
#EOH */

# $Id: oipc,v 1.2 2003/04/08 00:20:53 kripke Exp $
#
#	usage
#	./oipc foo.oip gcc %o && ./a.out
#	./oipc foo.oip gcc %o -shared -o foo.oip.so && ./oipl $PWD/foo.oip.so


sub mk {
	my $ifile = shift;
	my $ofile = $ifile . '.c';
	my $buf = ''; # collected strings from output mode
	my @code = ('',''); # main and global code
	my $code = 0, $state = -1; 
	# -1: file header
	# 0: stuff to output literally 
	# run code:
	#	1: in <%
	#	2: in <%=
	# global code:
	#	3: in <%!
	#	4: in <%@
	die "could not read $ifile" unless open I, $ifile;
	# transform line by line
	LIN: while (<I>) {
		if ( -1 == $state ) { # skipping initial # lines
			next if /^#/;
			$state = 0; # switch to output state
		}
		while (1) {
			if ( ! $state ) { # output up to <%
				my ($o,$s,$m,$x) = /^(.*?)(<%([=!@])?(.*))?$/s;
				if ( length $o ) {
					$o =~ s/\\/\\\\/g;
					$o =~ s/"/\\"/g;
					if ( defined $s ) {
						$buf .= '"' . $o . '"';
					} else {
						$buf .= '"' . $o . '\n"' . "\n";
					}
				}
				next LIN unless defined $s;
				$code[$code] .= "\tOIPS(\n".$buf."\t);\n" if length $buf;
				$buf = '';
				($m ||= 0) =~ y/=!@/123/;
				$state = 1+$m;
				$code = 2 < $state ? 1 : 0;
				$_ = $x;
				$code[$code] .= "\n#line ".$.."\n";
				next LIN unless length $x;
			}
			my ($x,$s,$m,$o) = /^(.*?)((!)?%>(.*))?$/s;
			$buf .= $x;
			if ( defined $s ) {
				if ( 2 == $state ) { # <%=
					if ( 1 == length $buf ) {
						if ( $buf =~ /[i-n]/ ) { # integer shorthand
							$buf = '"%d",'.$buf;
						} elsif ( $buf =~ /[u-w]/ ) { # unsigned shorthand
							$buf = '"%u",'.$buf;
						} elsif ( $buf =~ /[f-h]/ ) { # OpenIsis Field shorthand
							$buf = '"%.*s",'.$buf.'->len,'.$buf.'->val';
						}
					}
					if ( $buf =~ /^\s*"/ ) {
						$buf = 'OIPP(OIPF,'.$buf.');';
					} else {
						$buf = 'OIPS('.$buf.');';
					}
				}
				$code[$code] .= $buf;
				# don't reset print code destination if global ends with !%>
				$code = 0 unless $code && defined $m;
				$state = 0;
				if ( length $o ) {
					$buf = '';
					$_ = $o;
					next;
				}
				$buf = '"\n"';
			} else {
				$buf .= "\n";
			}
			last;
		}
	}
	close I;
	$code[0] .= "OIPS(\n".$buf.");\n" if length $buf;
	die "could not write $ofile" unless open O, '>', $ofile;
	print O '#include "oip.h"',"\n";
	print O $code[1];
	print O "OIPRUN\n";
	print O $code[0];
	print O "OIPEND\n";
	close O;
	map s/%o/$ofile/, @_;
	die 'exec '.join(' ',@_)." failed\n" unless exec @_;
}

mk @ARGV;