#!/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 () { 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;