#! /usr/bin/perl -w
# $Id: perlpp,v 1.6 2000/03/04 18:11:00 earl Exp $

# perlpp [-debug] [-lines] file

# perl preprocessor
# Copyright (C) 1998-2000 Iain McClatchie.  All rights reserved.  No warrantee implied.
# Author:  Iain McClatchie
# You can redistribute and/or modify this software under the terms of the
# GNU General Public License as published by the Free Software Foundation;
# either version 2, or (at your option) any later version.

# Modified by Earl Killian to "use strict".

package perlpp;

use strict;

require "newgetopt.pl";

use vars qw(@opt_I @opt_D @opt_e @global_file_stack $opt_lines $opt_debug);

@opt_I = ();
@opt_e = ();

&NGetOpt( "debug", "lines", "I=s@", "D=s@", "e=s@" ) && ( $#ARGV == 0 ) || do {
    print STDERR <<"END";
perlpp [args] file
  Applies a perl preprocessor to the indicated file, and any files included
  therein; the output of the preprocessor is written to stdout.  Perl is
  embedded in the source text by one of two means.  Whole lines of perl can be
  embedded by preceding them with a semicolon (you would typically do this for
  looping statments or subroutine calls).  Alternatively, perl expressions
  can be embedded into the middle of other text by escaping them with backticks.
  -debug      Print perl code to STDERR, so you can figure out why your embedded
              perl statements are looping forever.
  -lines      Embed \'#line 43 \"foo.w\"\' directives in output, for more
              comprehensible error and warning messages from later tools.
  -I dir      search for include files in directory dir
  -D \$var     Set the perl variable \$var = 1.
  -D \$var=foo Set the perl variable \$var = "foo".
  -e code     Evaluate code before preprocessing the file (e.g. to set
              variables).
BUGS:
  To get a single semicolon on a line, write
  ;print ";\\n";
END
    exit( 1 );
};

foreach (@opt_e) {
    eval $_;
    die ("perlpp: $@\n")
      if $@;
}

my $varset;
foreach $varset (@opt_D) {
    if( $varset =~ /(\S+)=(.*)/) {
	eval( "$varset" );
    } else {
	eval( "$varset = 1" );
    }
}

push( @INC, @opt_I );
@global_file_stack = ();
&ppp_require( $ARGV[0] );
exit( 0 );

sub ppp_require {
    my( $file ) = @_;
    my( $buf, $tempname, @chunks, $chunk, $state );
    my $lasttype = 'text';

    if( $file =~ m/^\// ) {
	open( INP, "<$file" ) || &ppp_error( $file, "Couldn't open file" );
    } else {
	my $path;
	foreach $path ( ".", @opt_I ) {
	    if( open( INP, "<$path/$file" )) {
		$file = "$path/$file";
		goto GETONWITHIT;
	    }
	}
	&ppp_error( $file, "Couldn't open file" );
      GETONWITHIT:
    }
    $buf .= "\n\# line 1 \"$file\"\n";
    while( <INP> ) {
	if( /^\s*;(.*)$/ ) {
	    if( $lasttype ne "perl" ) {
		$lasttype = "perl";
	    }
	    $buf .= $1 . "\n";
	} else {
	    if( $opt_lines and $lasttype ne "text" ) {
		$buf .= "print \"\#line $. \\\"$file\\\"\\n\";\n";
		$lasttype = "text";
	    }
	    chomp;
	    if( m/^$/ ) {
		$buf .= "print \"\\n\";\n";
		next;
	    }
	    @chunks = split( "\`", $_, -1 );
	    $state = 0;
	    $tempname = "00";
	    foreach $chunk ( @chunks ) {
		if( $state == 0 ) {
		    $chunk = quotemeta( $chunk );
		    $state = 1;
		} else {
		    if( $chunk =~ m/^\W/ ) {  # Perl expression
			$buf .= "\$perlpp::temp$tempname = $chunk;\n";
			$chunk = "\$\{perlpp::temp$tempname\}";
			$tempname++;
			$state = 0;
		    } else {                  # Backquoted something
			$chunk = "\\\`". quotemeta( $chunk );
			$state = 1;
		    }
		}
	    }
	    &ppp_error( $file, "Unterminated embedded perl expression, line $." )
		if( $state == 0 );
	    $buf .= "\# line $. \"$file\"\n"
		if( $tempname != "00" );
	    $buf .= "print \"" . join( "", @chunks ) . "\\n\";\n";
	}
    }
    close( INP );
    print STDERR $buf if( $opt_debug );
    push( @global_file_stack, $file );
    eval( $buf );
    pop( @global_file_stack );
    if( $@ ) {
	chomp( $@ );
	&ppp_error( $file, $@ );
    }
}

sub ppp_error {
    my( $file, $err ) = @_;
    my( $firstline, @errlines ) = split( '\n', $err );

    print STDERR "Error: $firstline\n";
    foreach my $line (@errlines) {
	print STDERR "       $line\n";
    }
    print STDERR "   while preprocessing file \"$file\"\n";
    foreach my $fn ( @global_file_stack ) {
	print STDERR "   included from \"$fn\"\n";
    }
    exit( 1 );
}


# Local Variables:
# mode:perl
# perl-indent-level:4
# cperl-indent-level:4
# End: