#!/usr/bin/perl -w
$perlloc="/usr/bin/perl";

#
# Copyright (C) Warren D. MacEvoy, 1998, under the Gnu Public License.
# See the file Copying for details.
#
# Mod 19991229 [AGP] Alberto González Palomo <matmota@linuxfreak.com>
#              Fixed a bug that prevented the second of two joint quotes
#              (double or single ones) from being backslash escaped.

$of=undef;
$if=undef;
$pl=0;
$quote=q{'};
for ($i=0; $i<=$#ARGV; ++$i) {
    if ($ARGV[$i] eq "-pl") { $pl=1; next; }
    if ($ARGV[$i] eq "-q") { $quote=q{'}; next; }
    if ($ARGV[$i] eq "-qq") { $quote=q{"}; next; }
    if ($ARGV[$i] eq "-perl") { $perlloc=$ARGV[$i+1]; ++$i; next; }
    if ($ARGV[$i] eq "-o") { $of=$ARGV[$i+1]; ++$i; next; }
    last;
}

$if=$ARGV[$i] if ($i<=$#ARGV);
@args=@ARGV[$i+1..$#ARGV];

if (!defined($if) || ($if eq "-")) {
    open(IF,"<&STDIN");
    $if=undef;
} else {
    open(IF,"<$if");
}

if ((!defined($of) && !defined($if)) || (defined($of) && $of eq "-")) {
    if ($pl==0) {
	$args=join(' ',@args);
	open(OF,"|$perlloc -w - $args");
    } else {
	open(OF,">&STDOUT");
    }
    $of=undef;
} else {
    if (!defined($of)) {
	$of=$if;
	if ($pl==0) {
	    $of =~ s/\.ppp$//;
	} else {
	    $of =~ s/\.ppp$/\.pl/;
	}
    }
    if ($pl==0) {
	$args=join(' ',@args);
	open(OF,"|$perlloc - $args>$of");
    } else {
	open(OF,">$of");
    }
}
	
print OF ('#!',$perlloc,"\n");
while (<IF>) {
    $action=$quote;
    if (m/^([\"\'\`!])/) {
      $action=$1;
      $_=substr($_,1);
    };
    if ($action eq '!') { print OF; next; }
    if ($action eq '"') {
      s/(([^\\]|^)(\\\\)*)\"/$1\\\"/g; # escape unescaped double-quotes
      s/(([^\\]|^)(\\\\)*)\"/$1\\\"/g; # [AGP] re-escape unescaped double-quotes
      s/(([^\\]|^)(\\\\)*)\\$/\\\\/g;  # escape an unescaped trailing backslash
      
      print OF ("print(\"$_\");\n");
    } elsif ($action eq '`') {
      chomp;
      s/(([^\\]|^)(\\\\)*)\`/$1\\\`/g; # escape unescaped back-quotes
      s/(([^\\]|^)(\\\\)*)\`/$1\\\`/g; # [AGP] re-escape unescaped back-quotes
      s/(([^\\]|^)(\\\\)*)\\$/\\\\/g;  # escape an unescaped trailing backslash
      print OF ("print(\`$_\`);\n");
    } else {
      s/\\/\\\\/g; # escape all backslashes
      s/\'/\\\'/g; # escape unescaped single quotes
      print OF ("print(\'$_\');\n");
    }
}

close(IF) if defined($if);
close(OF) if defined($of);

system("chmod +x $of") if defined($of) && $pl;