#!@PERL@
#  # LPRng's apsfilter
#  #  Version 1.0
#  #  Patrick Powell <papowell@astart.com>
#  # apsfilter.pl.in,v 1.3 1998/03/29 23:56:28 papowell Exp
#  # Inspired by the
#  # apsfilter - Line Printer Input Filter
#  #   by Andreas Klemm <andreas@knobel.gun.de>
#  #   co-author: Thomas Bueschgens <sledge@hammer.oche.de>  
#  #   
#  #  This filter is meant to be used with an LPRng printcap file
#  #  of the following form:
#  # printcap:
#  #
#  aps-PS_300dpi-letter-ascii-mono|PS_300dpi ascii mono
#  	:qq:lp=lp1@astart4.astart.com
#  	:force_queuename=aps-PS_300dpi-letter-ascii-mono
#  #
#  aps-PS_300dpi-letter-auto-mono|PS_300dpi auto mono
#  	:qq:lp=lp1@astart4.astart.com
#  	:force_queuename=aps-PS_300dpi-letter-auto-mono
#  #
#  aps-PS_300dpi-letter-raw|PS_300dpi auto raw
#  	:qq:lp=lp1@astart4.astart.com
#  	:force_queuename=aps-PS_300dpi-letter-raw
#  #
#  lp1|Real PS_300dpi
#  	:qq:lp=/dev/lp0:server
#  	:sd=/usr/spool/lp1
#  	:lf=log:af=acct
#  	:if=BINDIR/apsfilter /commprog
#  	:direct_read:mx#0:sh
#  
#  The aps-... printers are the user visible printers;  the :qq:
#  and :force_queuename options force the specified queue name into the
#  control file Q line.
#  
#  When the :if=/.../apsfilter is invoked, it is passed -Qaps-.... on the
#  command line.  It will use this to determine the actual processing to
#  be done by the filter.  It will then pipe this to the /commprog
#  for transfer to the actuall printing device.

use English;
use IO;

my(%VAR,$i,$new,$key,$value,$opt,$default,$local,$commprog);
my($decode_name,$printer,$aps,$device,$papersize,$filetype,$color);
my($count,$method,$r,$a2ps,$decompress,$cmd,$to_ps);
my($djpeg,$compression,$type,$dvips,$temp);
my($rewindstdin,@lines);

my($gs_path)="@GS@";
my($a2ps_path)="@A2PS@";
my($djpeg_path)="@DJPEG@";
my($dvips_path)="@DVIPS@";
my($fcat)="@FCAT@";
my($fig2dev)="@FIG2DEV@";
my($giftopnm)="@GIFTOPNM@";
my($gzip)="@GZIP@";
my($pnmtops)="@PNMTOPS@";
my($ppmtopgm)="@PPMTOPGM@";
my($rasttopnm)="@RASTTOPNM@";
my($tifftopnm)="@TIFFTOPNM@";
my($zcat)="@ZCAT@";
my($JABORT)= 33;
my($debug)= 0;
my($optind)= -1;
my($res) = "";
my($gs) = "";
my($allow_pcl) = "";
$decode_name = "";


sub printSTDERR;
$value = select STDOUT; $| = 1; select $value;

# open the configuration file and read the values;
# global and local configuration files

$default = "@sysconfdir@/apsfilter.conf";
$local = "./apsfilter.conf";

# these cannot be local
$opt_s = $opt_P = $opt_T = $opt_Q = $opt_c = "";

for( $i = 0; $i < @ARGV; ++$i ){
    $opt = $ARGV[$i];
    print STDERR "XX opt= $opt\n" if $debug;
    if( $opt eq '-c' ){
        $opt_c = 1;
    } elsif( ($key, $value) = ($opt =~ /^-(.)(.*)/) ){
        if( $value eq "" ){
            $value = $ARGV[++$i];
        }
		if( $key eq "T" and $opt_T ){ 
			$opt_T = $opt_T . "," . $value;
		} else {
			${"opt_$key"} = $value;
		}
        print STDERR "XX opt_$key = " . ${"opt_$key"} . "\n" if $debug;
    } else {
        $optind = $i;
        last;
    }
}


print STDERR "XX opt_P = $opt_P\n" if $debug;
print STDERR "XX opt_T $opt_T\n" if $debug;
print STDERR "XX opt_s $opt_s\n" if $debug;

if( $opt_s and -f $opt_s and open( STATUS, ">>$opt_s" ) ){
	print STDERR "opened status file $opt_s\n" if $debug;
	$value = select STATUS; $| = 1; select $value;
	$opt_s = "_ open _";
}
if( $opt_s ne "_ open _" and !open( STATUS, "/dev/null" ) ){
	print STDERR "cannot open /dev/null - $!\n";
	exit $JABORT;
}

# pull out the -T options
$commprog = "";

my(@T_vars) = split(",",$opt_T );
foreach ( @T_vars ){
	($key,$value) = split( '=', $_ );
	$debug = 1 if( $key eq "debug" );
	$commprog = $value if( $key eq "commprog" );
	$res = $value if( $key eq "res" );
	$allow_pcl = $value if( $key eq "allow_pcl" );
	$decode_name = $value if( $key eq "printer" );
}

# open the default files and get @VAR values
getvars( $default );
getvars( $local );

# get the printer
# use the configuration file value for printer name first
# then the -Q value

# find the right printer
# do globmatching
$printer = $opt_P if $opt_P;
$decode_name = "";
$new = globmatch( "$opt_P.printer" );
$decode_name = $VAR{$new} if( $new );
if( !$decode_name ){
	$new = globmatch( "$opt_Q.printer" );
	$decode_name = $VAR{$new} if( $new );
	$decode_name = $opt_Q if !$decode_name;
}
if( !$decode_name ){
	printSTDERR "$0: missing -Q option and configuration type for printer\n";
	exit $JABORT;
}

# set the PATH
$ENV{PATH} = $VAR{PATH} if( $VAR{PATH} );

# get the commprog
if( !$commprog ){
	$new = globmatch( "$printer.commprog" );
	$new = globmatch( "commprog" ) if !$new;
	$commprog = $VAR{$new} if( $new );
}
if( !$commprog ){
	printSTDERR "$0: missing communications program\n";
	exit $JABORT;
}

# now we check to see what type of printer we have
# Postscript printers have PS_NNNdpi where NNN is resolution
# aps-djet500-a4-{auto,ascii,raw}-{color,mono}
#     device
#             papersize
#                method
#                                 color
$count = ($aps,$device,$papersize,$method,$color) = split(/-/,$decode_name);
print STDERR "count=$count\n" if $debug;

if( $count != 5 and $count != 4){
	printSTDERR "$0: bad format for printer name '$decode_name'\n";
	exit $JABORT;
}

print STDERR "aps=$aps,device=$device,papersize=$papersize,method=$method,color=$color\n" if $debug; 

# Translate the device to a generic one if necessary
$new = globmatch( "$device.family");  
$device = $VAR{$new} if( $new );

# get the device for ghostscript translation
$new = globmatch( "$printer.allow_pcl" );  
$new = globmatch( "$device.allow_pcl" ) if !$new;
$allow_pcl = $VAR{$new} if( $new and $VAR{$new} );

$new = globmatch( "$printer.res" );  
$new = globmatch( "$device.res" ) if !$new;
$res = $VAR{$new} if( $new );

if( $device !~ /^PS/ ){
	($value = $papersize) =~ s/^(.)/\L$1/;
	$r = "-r$res" if $res;
	$gs = "$gs_path -q -sDEVICE=$device $r -sPAPERSIZE=$value "
		. "-dNOPAUSE -dSAFER -sOutputFile=- - | ";
} else {
	($res) = $device =~ /([0-9]*)/;
	$res = 300 if !$res;
}

print STDERR "gs='$gs'\n" if $debug;

# we will use these as:
# decompress to_ps  gs  comm
#
$decompress = "";
$to_ps = "";
$cmd = "";

$new = globmatch( "$device.a2ps" );  
$a2ps = $VAR{$new} if( $new );
$a2ps = $VAR{"a2ps"} if( !$a2ps and $VAR{"a2ps"} );
$a2ps = "$a2ps_path -q -R -1 -m -B" if(!$a2ps);
# capitalize the first letter of $papersize for a2ps
$papersize =~ s/^([a-z])/\U$1/;
print STDERR "papersize $papersize\n" if $debug;
$a2ps = "$a2ps -M $papersize";

if( $color eq "color" ){
	$pnmtops = "pnmtops";
	$djpeg = "$djpeg_path -colors 256";
} else {
	$pnmtops = " ppmtopgm | pnmtops";
	$djpeg = "$djpeg_path -grayscale";
}

print STDERR "method $method\n" if $debug;

$compression = "";
if( $method eq "raw" ){
	$type = "raw";
	print STDERR "doing raw\n" if $debug;
	$gs = "";
} elsif( $method eq "ascii" ){
	print STDERR "doing ascii\n" if $debug;
	$type = "ascii";
	$to_ps = "$a2ps -o - |";
	print STDERR "ascii, to_ps ='$to_ps'\n" if $debug;
} else {
	print STDERR "doing auto\n" if $debug;

	# get the file type
	$filetype = filetype( $decompress );
	print STDERR "initial filetype '$filetype'\n" if $debug;
	if( $filetype =~ m/.*(gzip).*/ ){
		$type = $1;
		$decompress = "$gzip -dc |";
	} elsif( $filetype =~ m/.*(compress).*/ ){
		$type = $1;
		$decompress = "$zcat |";
	} elsif( $filetype =~ m/.*(frozen).*/ ){
		$type = $1;
		$decompress = "$fcat |";
	} elsif( $filetype =~ /.*(packed).*/ ){
		$type = $1;
		$decompress = "$zcat |";
	}
	print STDERR "type $type, decompress='$decompress'\n" if $debug;
	if( $decompress =~ /^\s*no/ ){
		printSTDERR "$0: no $type expansion program\n";
		exit $JABORT;
	}
	if( $decompress ){
		$compression = "$type ";
		$filetype = filetype( $decompress );
	}

	print STDERR "final filetype '$filetype'\n" if $debug;

	$type = "unknown";
	if( $filetype =~ /.*(fig).*/ ){
	# fig
		$type = $1;
		$to_ps = "$fig2dev -Lps -P -c |";
	} elsif( $filetype =~ /.*(pnm|pbm|ppm).*/ ){
	# pnm
		$type = $1;
		$to_ps = " $pnmtops |";
	} elsif( $filetype =~ /.*(tiff).*/ ){
	# tiff
		$type = $1;
		$to_ps = " tifftopnm | $pnmtops |";
	} elsif( $filetype =~ /.*(jpeg).*/ ){
	# jpeg
		$type = $1;
		$to_ps = "$djpeg | $pnmtops |"
	} elsif( $filetype =~ /.*(gif).*/ ){
	# gif
		$type = $1;
		$to_ps = " giftopnm | $pnmtops |";
	} elsif( $filetype =~ /.*(rasterfile).*/ ){
	# sun raster file
		$to_ps = " rasttopnm | $pnmtops |";
	} elsif( $filetype =~ /.*(postscript).*/  ){
	# nothing for ps
		$type = $1;
		;
	} elsif( $filetype =~ /.*(text).*/  ){
	# text
		$type = $1;
		$to_ps = "$a2ps -o - |";
	} elsif( $filetype =~ /.*(pcl).*/ and $allow_pcl ){
	# nothing for pcl
		$type = $1;
		$gs = "";
	} elsif( $filetype =~ /.*(dvi).*/ ){
		$type = $1;
		# dvi
		# for dvi, we need to convert to ps
		# OPTIONS for dvips - DVIPS_OPTS
		#       -q quiet mode
		#       -r print last page first
		#       -t papersize
		#           (look known formats in the config file config.ps
		#            on Linux Slackware usually in /usr/TeX/lib/tex/ps)
		#       -D (or -P) num horizontal + vertical resolution in dpi
		#          or:  -X num horizontal resolution in dpi
		#           -Y num vertical   resolution in dpi
		#       -Z compress bitmap fonts 
		#          usually only when resolution is >= 400
		$dvips = "$dvips_path -q -f";
		$new = globmatch("$device.dvips");
		$dvips = $VAR{"$new"} if( $new );
		$dvips = "$dvips -D$res" if( $res );
		$dvips = "$dvips -t $papersize";
		if( $decompress ){
			$temp = "/tmp/$$.ps";
			$cmd = "$decompress >$temp";
			print STDERR "doing '$cmd'\n" if $debug;
			@lines = `$cmd`;
			if( $? ){
				printSTDERR "$0: error executing '$cmd' - $!\n"
					. join("",@lines);
				unlink $temp;
				exit $JABORT;
			}
			open( STDIN, "/tmp/$$.ps" ) or die "cannot open $temp - $!\n";
			unlink("$temp") or die "cannot unlink $temp - $!\n";
			$decompress = "";
		}
		$to_ps = "$dvips |";
	} else {
		printSTDERR "$0: cannot print type $filetype\n";
		exit $JABORT;
	}
	if( $to_ps =~ /^\s*no/ ){
		printSTDERR "$0: no conversion program for type $filetype\n";
		exit $JABORT;
	}
}
print STDERR "decompress=$decompress,to_ps=$to_ps,gs=$gs,commprog=$commprog\n" if $debug;

# pass the options to the commprog as well
if( $commprog !~ m,/bin/cat, ){
	$commprog = $commprog . " " . join(" ", @ARGV);
}
$cmd = "$decompress $to_ps $gs $commprog";
printSTDERR "$0: input filetype '$compression$type'\n";
printSTDERR "$0: using '$cmd'\n";
rewind(*STDIN);
close( STATUS );
exec "$cmd";
printSTDERR "$0: error '$cmd' - $!\n";
exit $JABORT;

sub filetype {
	my ($prefix) = @_;
	my (@type, $filetype,$line,$count,$tempfile);
	print STDERR "filetype prefix='$prefix'\n" if $debug;
	rewind(*STDIN);
	if( $prefix ){
		open(TEMP,"$prefix ") || die "$0: cannot open $prefix";
		$count = read(TEMP,$line,1024);
		if( $count < 0 ){
			die "$0: cannot read from '$prefix' - $!\n";
		}
		close(TEMP);
	} else {
		$count = read(*STDIN,$line,1024);
		if( $count < 0 ){
			die "$0: cannot read from STDIN - $!\n";
		}
	}
	# now we create a temp file
	$tempfile = "/tmp/$$";
	open(TEMP,">$tempfile") || die "$0: cannot open $tempfile";
	print TEMP $line || die "$0: cannot write $tempfile";
	close(TEMP) || die "$0: cannot write $tempfile";
	
	($line) = `@FILEPROG@ $tempfile`;
	die "$0: command failed '$prefix file' - $!\n" if( $? );
	unlink $tempfile || die "$0: cannot unlink $tempfile";
	chomp $line;
	print STDERR "file output '$line'\n" if $debug;
	$line =~ s/.*?://;
	@type = split(" ",$line);
	print STDERR "type '" . join( "','",@type)."'\n" if $debug;
	$filetype = join(" ",@type);
	$filetype =~ tr/A-Z/a-z/;
	print STDERR "new type '$filetype'\n" if $debug;
	$filetype;
}

sub getvars {
	my ($default) = @_;
	my (@lines, $var, $value );
	if( -f $default and -r $default ){
		if( !open( FILE, $default ) ){
			printSTDERR "$0: cannot open '$default' - $!\n";
			exit $JABORT;
		}
		while(<FILE>){
			chomp;
			print STDERR "getvars: read '$_'\n" if $debug;
			next if( /^\s*#/ );
			($var,$value) = /\s*(.*?)[=\s]+(.*)/;
			if( $value ){
				$VAR{$var} = $value;
			} else {
				delete($VAR{$var});
			}
			print STDERR "getvars: $var='$value'\n" if $debug;
		}
		if( !close(FILE) ){
			printSTDERR "$0: cannot close $default - $!\n";
			exit $JABORT;
		}
	}
}

sub rewind {
	my($FD) = @_;
	if( $PERL_VERSION < 5.004 ){
		$rewindstdin = $VAR{"rewindstdin"}  if !$rewindstdin;
		$rewindstdin = "BINDIR/rewindstdin" if !$rewindstdin;
		print STDERR "rewind using '$rewindstdin'\n" if $debug;
		my($code) = system( $rewindstdin );
		if( $code ){
			printSTDERR "$0: $rewindstdin failed - exit code $code\n";
			$rewindstdin = "rewindstdin";
			$code = system( $rewindstdin );
			printSTDERR "$0: $rewindstdin failed - exit code $code\n";
			exit $JABORT if $code;
		}
	} else {
		print STDERR "rewind using sysseek\n" if $debug;
		sysseek($FD, 0, 0) or die "$0: cannot seek START stdin - $!\n";
	}
}

# see if there is a variable whose name matches the
# one passed

sub globmatch {
	my ($var, $ret) = @_;
	print STDERR "globmatch '$var', ret='$ret'\n" if $debug;
	if( defined( $var ) and $var ){
		foreach (keys %VAR){
			print STDERR "globmatch checking '$_'\n" if $debug;
			if( $var =~ /^$_$/ ){
				print STDERR "globmatch found '$_', value '$VAR{$_}'\n" if $debug;
				if( $VAR{$_} ){
					return $_;
				} else {
					return "";
				}
			}
		}
	}
	return $ret;
}

sub printSTDERR {
	print STDERR @_;
	print STATUS @_;
}