#! /usr/bin/perl

#
# psplpr: (l)pr frontend for PS printers using PPD files.
# 
# Copyright (C) 1995, 1996, Yves Arrouye <Yves.Arrouye@marin.fdn.fr>
# 
# This package and its included files may be redistributed under the
# terms of the GNU General Public License, a copy of which can be
# found in the file GPL.
# 
# I ask you to email me (preferrably in the form of context diffs)
# any changes you make to this code. This is a wish, not an obligation,
# but it will make maintaining the tools easier. Thanks!
# 

$file_printcap = '/etc/printcap'; # Default printcap file.

$prog_pr = '/usr/bin/pr';	# Default formatter for lpr -p option.

$prog_cat = '/bin/cat';		# Location (or name) of the cat binary.

$dflt_printer{'lpr'} = 'lp';	# Default lpr(1) printer on this system.
$dflt_printer{'lp'} = 'lp';	# Default lp(1) printer on this system.
$dflt_printer{'cat'} = 'lp';

$pcap_final = '_nxfinalform';	# Use all features.

#

require 'psptools.pl';

require 'ppd.pl';
require 'printer.pl';

#
# tell_user(what)
#
# Print a message on standard output if $opt_verbose is set.
#

sub tell_user {
    print $tellstream "@_\n" if $opt_verbose;
}

#
# usage(code)
#
# Print the usage string and exit.
#

($myname = $0) =~ s,^.*/,,;

sub usage {
    local($code) = @_;

    if ($code) {
	select STDERR;
    }

    if ($code) {
	print "usage:";
    } else {
	print "Usage:";
    }

    print " $myname [ -x opt-prefix ] [ --version ] [ --help ] [ --ppdpath ]"
	. " [ --lpr ] [ --lp ]"
        . " [ -z, --show [ all ] [ list | long ] [ constraints ] ]"
	. " [ --verbose ] [ -q, --quiet ] [ --silent ] [ --warn ]"
	. " [ --nodsc ] [ --stripdsc ] [ --stripcomments ]"
	. " [ --globps ] [ --dontglobps ]"
	. " [ --standard ] [ --conformant ] [ --safer ] [ --special ]"
        . " [ -o, --output file ]"
        . " [ --prepend ]"
	. " [ -k, --kind, --type type ]"
        . " [ --dontincfeatures ] [ --dontchgfeatures ]"
	. " [ --delfeatures [ totally ] ]"
	. " [ -a, --dftfeatures ] [ --nodftfeatures ]"
	. " [ -u, --feature keyword[=value] [ param=value ... ] ]"
	. " [ spooler-options ] [ file ... ]\n";

    if (!$code) {
	print <<DESCRIPTION_END

Options: -x opt-prefix\t\t\tprefix opt-prefix to all options names
         --version\t\t\tprint version information and exit
         --help\t\t\t\tprint this help message and exit
	 --ppdpath\t\t\tprint the path for PPD files and exit
         -z, --show [ keywords ]\tshow defined printer features and exit
			       \t\t  (`all' shows all features)
			       \t\t  (`list' or `long' changes output)
			       \t\t  (`constraints' shows constraints)
         --verbose\t\t\tprint informations while progressing
	 -q, --quiet\t\t\tdo not complain while producing output
	 --silent\t\t\tdo not print anything
         --warn\t\t\t\twarn instead of exiting on error
         --lpr\t\t\t\tuse the lpr(1) print spooler
         --lp\t\t\t\tuse the lp(1) print spooler
         --nodsc\t\t\tdo not put DSC comments in the ouput
         --stripdsc\t\t\tsuppress DSC comments from the output
         --stripcomments\t\tsuppress any comment from the output
         --globps\t\t\tread a full section before handling it
         --dontglobps\t\t\tdo not turn ps globbing automatically
	 --standard\t\t\tdo not output non-standard DSC comments
         --conformant\t\t\tdo not handle some DSC-like comments
	 --safer\t\t\tbracket PPD code with error handler
	 --special\t\t\ttreat some features specially
         -o, --output file\t\tfilter files to file (stdout if -)
                     \t\t\t  (and silently ignore lpr options)
         --prepend\t\t\tprepend the features code to the input
	 -k, --kind, --type type\tset the printer type to use
	 --dontincfeatures\t\tdo not process features inclusions
	 --dontchgfeatures\t\tdo not changed defined features
	 --delfeatures [ totally ]\tsuppress defined features from input
	                          \t  (`totally' suppresses DSC comments)
         -a, --dftfeatures\t\tselect default values for all features
         --nodftfeatures\t\tdo not select default features at all
         -u, --feature keyword[=value]\tspecify a feature to use, eventually
                   [ param=value ... ]\t  followed by parameters

Other options are passed as is to the system spooler for printing.
The -P option automatically select --lpr if --lp has not been used.
DESCRIPTION_END
    }

    exit $code;
}

#

sub execpath {
    local($what) = @_;
    local(@path) = split(':', $ENV{'PATH'});
    local($comp);

    foreach $comp (@path) {
	if (-x "$comp/$what") {
	    return "$comp/$what";
	}
    }

    return '';
}

#
# Local procedures.
#

sub psplprprolog {
    local($trap, $nodsc) = @_;
    local($dictsz) = 1;

    local($pagesetup) = countfeatures('PageSetup');

    if ($trap) {
	++$dictsz if $pagesetup;
    }

    return unless $dictsz;

    if (!$nodsc) {
	print "%%BeginResource: procset psplpr\n";
    }

    print "/psplprdict $dictsz dict def psplprdict begin\n";

    if ($trap && $pagesetup) {
	print "/pagesetup {\n";
	outputfeatures('PageSetup', $nodsc);
	print "} bind def\n";
    }

    print "/psplprsetup {\n";
    print "  psplprdict begin\n";
    print "    mark { pagesetup } stopped pop cleartomark\n";
    print "  end\n";
    print "} bind def\n";

    print "end\n";

    if ($trap) {
	print <<ENDPROLOG
/erasepage where {
  pop /erasepage { erasepage psplprdict /pagesetup get exec } bind def
} if
/copypage where {
  pop /showpage { copypage erasepage } bind def
} if
ENDPROLOG
    }

    if (!$nodsc) {
	print "%%EndResource\n";
    }

}

#
# Add features from the PPD file.
#

sub ignoredeps {

    local($section) = @_;

    if (exists($PPD_Dependencies{$section})) {
	local($warned) = 0;
	foreach $key (eval("keys %PPD_Dep_$section")) {
	    if (exists($ppd_options{$key})) {
		if (!$warned) {
	            print STDERR "$myname: warning: ignoring *OrderDependency value $section\n";
		    $warned = 1;
		}
		print STDERR "$myname: warning: ignoring $key in $section section\n";
	    }
	}
    }
}

sub countfeatures {
    local($section) = @_;
    local($pred);

    if (!exists($PPD_Dependencies{$section})) {
	return 0;
    }

    local($count) = 0;

    foreach $pred (sort { $a <=> $b } keys %{$PPD_RevDep{$section}}) {
	local($key);

	foreach $key (keys %{$PPD_RevDep{$section}{$pred}}) {
	    if ($ppd_options{$key}) {
		++$count;
	    }
	}
    }

    return $count;
}

sub outputfeatures {
    local($section, $nodsc, $safer, $nonstd, $nonconf, $special) = @_;
    local($pred);

    local(%added);

    if (!exists($PPD_Dependencies{$section})) {
	return;
    }

    foreach $pred (sort { $a <=> $b } keys %{$PPD_RevDep{$section}}) {
	local($key);

	foreach $key (sort keys %{$PPD_RevDep{$section}{$pred}}) {
	    if ($ppd_options{$key}) {
      	        ppd::outputppdfeature($key, $ppd_options{$key}, $nodsc,
		    $safer, $nonstd, $nonconf, $special);
		%added = (%added, $key, $ppd_options{$key});
	    }
	}
    }

    return %added;
}

sub outputallfeatures {
    local($nodsc, $doc, $safer, $nonstd, $special, %all_options) = @_;
    local($hasprolog, $section) = 0;

    local($counta, $countb);

    local($dsc) = !$nodsc;

    if ($doc && $dsc) {
        print "%!PS-Adobe-3.0\n";
	print "%%Title: Dummy PostScript Document\n";
	print "%%Creator: $myname version 1.2.2\n";
	print "%%CreationDate: " . localtime() . "\n";
	print "%%For: ";
	local($who) = eval("(getpwuid($>))[6] || (getpwuid($<))[6]");
	if ($who) {
	    $who =~ s/,.*$//;
	} else {
	    $who = "User "
		. ($ENV{'USER'} || $ENV{'LOGNAME'} || getlogin || "nobody");
	}
	print "$who\n";
	print "%%BoundingBox: 0 0 0 0\n%%Pages: 0\n";
	print "%%EndComments\n";
    } else {
        print "%!\n";
    }

    if (!$doc) {
	psplprprolog(1, $nodsc);
	$hasprolog = 1;
    }

    if (countfeatures('Prolog')) {
	if ($doc && $dsc) {
	    print "%%BeginProlog\n";
	}
	%all_options = (%all_options,
	    outputfeatures('Prolog', $nodsc, $safer, $nonstd,
	        !$conformant, $special));
    }
    if ($doc && $dsc) {
	print "%%EndProlog\n";
    }
    if (($counta = countfeatures('DocumentSetup'))
	+ ($countb = countfeatures('AnySetup'))) {
	if ($doc && $dsc) {
	    print "%%BeginSetup\n";
	}
	if ($counta) {
	    %all_options = (%all_options,
	        outputfeatures('DocumentSetup', $nodsc, $safer, $nonstd,
		    !$conformant, $special));
	}
	if ($countb) {
	    if ($doc && $dsc && $counta) {
		print "%\n";
	    }
	    %all_options = (%all_options,
	        outputfeatures('AnySetup', $nodsc, $safer, $nonstd,
		    !$conformant, $special));
	}
	if ($doc && $dsc) {
	    print "%%EndSetup\n";
	}
    }

    if (countfeatures('PageSetup') && $doc) {
	if ($dsc) {
	    print "%%Page: 0 0\n%%BeginPageSetup\n";
	}
	%all_options = (%all_options,
	    outputfeatures('PageSetup', $nodsc, $safer, $nonstd,
		!$conformant, $special));
	if ($doc && $dsc) {
	    print "%%EndPageSetup\n";
	}
    }

    if (!$doc) {
	print "psplprdict begin psplprsetup end\n";
    }

    if ($doc && $dsc) {
	print "%%EOF\n";
    }

    return %all_options;
}

sub readpsline {
    local($conf) = @_;

    $_ = <FILE>;

    if (!$conf) {
	if (/^%%PaperSize:\s+(\S+)$/) {
	    $_ = "%%IncludeFeature: *PageSize $1\n";
	} elsif (/^%%BeginPaperSize:\s+(\S+)$/) {
	    $_ = "%%BeginFeature: *PageSize $1\n";
	} elsif (/^%%EndPaperSize/) {
	    $_ = "%%EndFeature: *PageSize\n";
	}
    }

    $_ =~ s/\r\n$/\n/;

    return $_;
}

sub skipfeature {
    local($conformant, $print, $nested) = @_;

    local($count) = 1;

    while (readpsline($conformant)) {
	print if $print;

	if ($nested && /^%%BeginFeature:/) {
	    ++$count;
	} elsif (/^%%EndFeature/) {
	    last if !--$count;
	}
    }
}

sub readfeatures {
    local($glob, $conformant, $noinc, $nochg, $del, $nodsc, $code, $_) = @_;
   
    local($count, $ps) = 1;

    if (!$_) {
	$_ = readpsline($conformant);
    };

    while ($_) {
	if (!$code) {
	    last if (!/^%%/);
	}

	if (/^%%(Begin|Include)Feature:\s+(\*\S+)\s+(\S+)/
	    || (!$conformant && /^%%(Feature):\s+(\*\S+)\s+(\S+)/)) {

	    if ($1 ne 'Begin') {
		if ($del) {
		    next;
		} elsif ($noinc) {
		    print;
		    next;
		}
	    } else {
		if ($del) {
		    if (!$nodsc && $del > 0) {
			print "%%IncludeFeature: $2 $3\n";
		    }
		    next;
		} elsif ($nochg) {
		    print;
		    skipfeature(1);
		    next;
		}
	    }

	    local(@errs, $error);

	    if (!exists($ppd_options{$2})) {
	        @errs = (ppd::checkfeature($2, $3, ($1 eq 'Feature')));

	        if ($#errs != 1) {
		    foreach $error (@errs) {
			if ($error) {
			    print STDERR "$myname: $error, ignoring\n"
				unless $opt_quiet;
			    print "%%IncludeFeature: $2 $3\n" unless $del < 0;
			}
		    }
		} else {
		    @errs = ();
		}
	    }

	    if (!@errs && !exists($ppd_options{$2})) {
		@errs =
		  ppd::checkconstraints("$2=$3", %all_options);

		foreach $error (@errs) {
		    print STDERR "$myname: $error, ignoring\n"
			unless $opt_quiet;
		    print "%%IncludeFeature: $2 $3\n" unless $del < 0;
		}
	    }

	    if (!@errs) {
		$ppd_options{$2} = $3;
	    }

	    skipfeature if $1 eq 'Begin';
	} else {
	    if (/^%%Begin/) {
		++$count;
	    } elsif (/^%%End/) {
		last if (!--$count);
	    } elsif (!$glob) {
		last;
	    } else {
	        $ps .= $_;
	    }
	}

	$_ = readpsline($conformant);
    }

    return ($_, $ps);
}

sub addppdfeatures {
    local($file, $name, $out, $nodsc, $stripcomments,
	$safer, $nonstd, $glob, $dontglob, $conformant, $special,
	$inc, $chg, $del, $dirty, %ppd_options) = @_;
    local($prolog_output, $setup_output) = 0;
    local($in_comment) = 0;

    if ($name ne '-' && ! -r $file) {
	print "$myname: cannot read $name\n";
        return;
    }

    if (!open(FILE, $file)) {
	return "cannot process $name";
    }
    
    if (!open(OUT, $out)) {
	return "cannot pipe output to system printer spooler";
    }

    local($old) = select OUT;
    $| = 1;

    ignoredeps('ExitServer');
    ignoredeps('JCLSetup');

    $_ = readpsline($conformant);

    if (!$_) {
	%all_options = outputallfeatures($nodsc, !$dirty, $safer,
	    $nonstd, $special);
    } else {
	$_ =~ s/^\004//;

	local($bad);

	if ($dirty || ($bad = !/^%!PS/)) {
	    local($first) = $_;

	    %all_options = outputallfeatures($nodsc, 0, $safer, $nonstd,
	    	$special);

	    if ($bad && !$dontglob) {
		$glob = 1;
	    }
	}

        local($lineno) = 0;

	while ($_) {
	    local($printed) = 0;
	    local($dontread) = 0;

	    local($conforms, $ps);

	    ++$lineno;

	    if (/^%%Begin/) {
		$in_comment = 1;
	    } elsif (/^%%End/) {
		$in_comment = 0;
	    }

	    if (/^%%BeginProlog/) {
		print if $nodsc >= 0;
		($_, $ps) = readfeatures($glob, $conformant, !$inc, !$chg,
		    $del, $nodsc);
		$dontread = 1;
		outputfeatures('Prolog', $nodsc, $safer, $nonstd,
		    !$conformant, $special);
		print $ps;
		$prolog_output = 1;
		$printed = 1;
	    } elsif (/^%%EndProlog/) {
		if (!$prolog_output) {
		    print "%%BeginProlog\n" unless $nodsc;
		    outputfeatures('Prolog', $nodsc, $safer, $nonstd,
		        !$conformant, $special);
		    print if $nodsc >= 0;
		    $prolog_output = 1;
		    $printed = 1;
		}
	    } elsif (($conforms = /^%%BeginSetup/)
		|| (!$in_comment && $prolog_output && !$setup_output)) {

		if (!$prolog_output) {
		    outputfeatures('Prolog', $nodsc, $safer, $nonstd,
		        !$conformant, $special);
		    $prolog_output = 1;
		}

		if ($conforms) {
		    print if $nodsc >= 0;
		    $printed = 1;
		} else {
		    print "%%BeginSetup\n" unless $nodsc;
		}

		if (!/^%%Page/) {
		    ($_, $ps) = readfeatures($glob, $conformant,
		        !$inc, !$chg, $del, $nodsc, $conforms);
		    $dontread = 1;
		}

		outputfeatures('DocumentSetup', $nodsc, $safer,
		    $nonstd, !$conformant, $special);
		outputfeatures('AnySetup', $nodsc, $safer, $nonstd,
		    !$conformant, $special);
		print $ps;
		$setup_output = 1;

		if (!$conforms) {
		    print "%%EndSetup\n" unless $nodsc;
		}
	    }

	    if (/^%%Page:/) {
		local($addsc) = 0;

		if (!$prolog_output) {
		    outputfeatures('Prolog', $nodsc, $safer, $nonstd,
		        !$conformant, $special);
		    $prolog_output = 1;
		    print "%%EndProlog\n" unless $nodsc;
		}
		if (!$setup_output) {
		    print "%%BeginSetup\n" unless $nodsc;
		    outputfeatures('DocumentSetup', $nodsc, $safer, $nonstd,
		        !$conformant, $special);
		    outputfeatures('AnySetup', $nodsc, $safer, $nonstd,
		        !$conformant, $special);
		    print "%%EndSetup\n" unless $nodsc;
		    $setup_output = 1;
		}

		print if $nodsc >= 0;
		if ($_ = readpsline($conformant)) {
		    if (/^%%BeginPageSetup/) {
			print if $nodsc >= 0;
			$printed = 1;
		    } else {
			$adddsc = !$nodsc && countfeatures('PageSetup');
			print "%%BeginPageSetup\n" if $adddsc;
		    }
		}

		if (/^%%BeginFeature/) {
		    ($_, $ps) = readfeatures($glob, $conformant,
		        !$inc, !$chg, $del, $nodsc);
		}

		outputfeatures('PageSetup', $nodsc, $safer, $nonstd,
		    !$conformant, $special);
		print $ps;
		if ($adddsc) {
		    print "%%EndPageSetup\n";
		}

		$dontread = 1;
	    } elsif (/^%%/) {

		# Eventually delete features.

		if ($del &&
		    (/^%%(Begin|Include)Feature:\s+(\*\S+)\s+(\S+)/
		    || (!$conformant && /^(%%Feature):\s+(\*\S+)\s+(\S+)/))) {
		    if ($1 eq 'Begin') {
			if (!$nodsc && $del > 0) {
			    print "%%IncludeFeature: $2 $3\n";
			}

			skipfeature;
			goto another;
		    } else {
			goto another if $del < 0;
		    }
		}

		# Eventually include features.

		if ($inc && (/^%%(Include)Feature:\s+(\*\S+)\s+(\S+)/
		    || (!$conformant && /^%%(Feature):\s+(\*\S+)\s+(\S+)/))) {

		    local($feature, $value) = ($2, $3);

		    if ($1 eq 'Feature') {
			local($f, $v) =
			    ppd::checkfeature($feature, $value, 1);

			if ($f && $v) {
			    $feature = $f;
			    $value = $v;
			}
		    }

      	            local($error, %added) =
			ppd::outputppdfeature($feature, $value,
			    $nodsc, $safer, $nonstd, !$conformant, $special);
		    if ($error) {
		        print STDERR "$myname: $error", "\n"
			    unless $opt_quiet;
		        print unless $del < 0;
		    } else {
			%all_options = (%all_options, %added);
			goto another;
		    }
		}

		# Eventually change features.

		if ($chg && /^%%BeginFeature:\s+(\*\S+)\s+(\S+)/) {
                    local(@errs, $error, %added);

                    @errs =
			ppd::checkconstraints("$1=$2", %all_options);

		    foreach $error (@errs) {
			print STDERR "$myname: $error, ignoring\n"
			    unless $opt_quiet;
			print "%%IncludeFeature: $1 $2\n" unless $del < 0;
		    }

		    if (!@errs) {
			($error, %added) =
			    ppd::outputppdfeature($1, $2, $nodsc, $safer,
			        $nonstd, !$conformant, $special);
                    }

		    if ($error) {
			print STDERR "$myname: $error, ignoring\n"
			    unless $opt_quiet;
			print "%%IncludeFeature: $1 $2\n" unless $del < 0;
		    }

		    %all_options = (%all_options, %added);

		    skipfeature;
		    goto another;
		}

		# Output the line if it was not processed and we keep comments.

		print if $nodsc >= 0 && !$printed;
	    } elsif (/^%!/) {
		if ($stripcomments) {
		    print "%!\n";
		} else {
		    print unless $printed;
		}
	    } elsif (!$stripcomments || !/^%/) {
		print unless $printed;
	    }

another:
	    $_ = readpsline($conformant) unless $dontread;
	}
    }

    select($old);

    close(OUT);
    close(FILE);

    return '';
}

#
# Parse arguments.
#
# The script gets its own options and record other arguments that are
# not for its own use.
#   The -x argument tells the script that it will have to execute the lpr
# filter itself, except for the if and ff filters.
#   The -K argument will yield the type of the printer in $ptype.
#   The -o arguments will fill the $ppd_options array.
#   Other arguments are intended for lpr and will be recorded in the
# $lpr_args array. Some of them (like -P) are parsed for our use.
#

$exec_filter = 1;
$opt_output = '';
$opt_verbose = 0;
$opt_nodsc = 0;

$opt_prefix = '';
$lopt_prefix = '';

$opt_incfeatures = 1;
$opt_chgfeatures = 1;

$needs_ppd = $opt_incfeatures + $opt_chgfeatures;

@args = (split(/\s/, $ENV{'PSPLPR_OPTIONS'}), @ARGV);

while ($args[0]) {
    if ($args[0] eq "-${opt_prefix}x") {
	usage(1) if !$args[1];
	$opt_prefix = $args[1];
	$lopt_prefix = "$args[1]-";
	shift @args;
    } elsif ($args[0] eq "--${lopt_prefix}version") {
	print "$myname version 1.2.2, "
	    . "by Yves Arrouye <Yves.Arrouye\@marin.fdn.fr>\n";
	exit(0);
    
    } elsif ($args[0] eq "--${lopt_prefix}ppdpath") {
	print ppd::ppdpath();
	exit(0);
    } elsif ($args[0] eq "--${lopt_prefix}help") {
	usage(0);
    } elsif ($args[0] eq "-${opt_prefix}z"
	|| $args[0] eq "--${lopt_prefix}show") {
	++$needs_ppd;
	$opt_show = 1;
	if ($args[1] eq "all") {
	    $opt_show = 10;
	    shift @args;
	}
	if ($args[1] eq 'long') {
	    $opt_show = -$opt_show;
	    shift @args;
	} elsif ($args[1] eq 'list') {
	    $opt_show = 5;
	    shift @args;
	}
	if ($args[1] eq 'constraints') {
	    $opt_showconstraints = 1;
	    shift @args;
	}
    } elsif ($args[0] eq "-${opt_prefix}o"
	|| $args[0] eq "--${lopt_prefix}output") {
	$opt_output = $args[1];
	usage(1) if (!$opt_output);
	shift @args;
    } elsif ($args[0] eq "-${lopt_prefix}lpr") {
	$used_prog_lpr = $prog_lpr;
    } elsif ($args[0] eq "-${lopt_prefix}lp") {
	$used_prog_lpr = $prog_lp;
    } elsif ($args[0] eq "--${lopt_prefix}verbose") {
        $opt_verbose = 1;
    } elsif ($args[0] eq "-${opt_prefix}q"
	|| $args[0] eq "--${lopt_prefix}quiet") {
	$opt_quiet = 1;
    } elsif ($args[0] eq "--${lopt_prefix}silent") {
        $opt_verbose = 0;
	close(STDERR);
    } elsif ($args[0] eq "-${opt_prefix}x"
	|| $args[0] eq "--${lopt_prefix}warn") {
        $opt_warn = 1;
    } elsif ($args[0] eq "--${lopt_prefix}nodsc") {
	$opt_nodsc = 1 unless $opt_nodsc;
    } elsif ($args[0] eq "--${lopt_prefix}stripdsc") {
	$opt_nodsc = -1;
    } elsif ($args[0] eq "--${lopt_prefix}stripcomments") {
	$opt_stripcomments = 1;
	$opt_nodsc = -1;
    } elsif ($args[0] eq "--${lopt_prefix}globps") {
	$opt_globps = 1;
    } elsif ($args[0] eq "--${lopt_prefix}dontglobps") {
	$opt_dontglobps = 1;
    } elsif ($args[0] eq "--${lopt_prefix}standard") {
	$opt_standard = 1;
    } elsif ($args[0] eq "--${lopt_prefix}conformant") {
	$opt_conformant = 1;
    } elsif ($args[0] eq "--${lopt_prefix}safer") {
	$opt_safer = 1;
    } elsif ($args[0] eq "--${lopt_prefix}special") {
	$opt_special = 1;
    } elsif ($args[0] eq "-${opt_prefix}q"
	|| $args[0] eq "--${lopt_prefix}prepend") {
	$opt_prepend = 1;
    } elsif ($args[0] eq "-${opt_prefix}k"
	|| $args[0] eq "--${lopt_prefix}kind"
	|| $args[0] eq "--${lopt_prefix}type") {
	usage(1) if (($ptype = $args[1]) eq '');
	shift @args;
    } elsif ($args[0] eq "--${lopt_prefix}dontincfeatures") {
	--$needsppd;
	$opt_incfeatures = 0;
    } elsif ($args[0] eq "--${lopt_prefix}dontchgfeatures") {
	--$needsppd;
	$opt_chgfeatures = 0;
    } elsif ($args[0] eq "--${lopt_prefix}delfeatures") {
	if ($args[1] eq "totally") {
	    $opt_delfeatures = -1;
	    shift @args;
	} else {
	    $opt_delfeatures = 1;
	}
    } elsif ($args[0] eq "-${opt_prefix}a"
	|| $args[0] eq "--${lopt_prefix}dftfeatures") {
	++$needs_ppd;
	$finalform = 1;
    } elsif ($args[0] eq "--${lopt_prefix}nodftfeatures") {
	$finalform = 0;
    } elsif ($args[0] eq  "-${opt_prefix}u"
	|| $args[0] eq "--${lopt_prefix}feature") {
	++$needs_ppd;
	local($option) = $args[1];
	usage(1) if ($option eq '');
	$ppd_features[$#ppd_features + 1] = $option;
	shift @args;
	while ($args[1] =~ /(.+)=(.+)/) {
	    $PPD_ParamsSet{$option}->{$1} = $2;
	    shift @args;
	}
    } elsif ($used_prog_lpr) {
	if ($args[0] !~ /^-/) {
	    $lpr_files[$#lpr_files + 1] = $args[0];
	} elsif ($exec_filter && $args[0] =~ /-[cdfglnptv]/) {
	    local($filter) = $args[0];

	    $filter =~ s/^-//;

	    if ($filter eq 'p') {
		$use_pr = 1;
	    } elsif ($filter eq 'f') {
		$use_ff = 1;
	    } else {
		$use_filter = $filter;
	    }
        } elsif ($args[0] eq '-i') {
	    if ($args[1] =~ /^\d+$/) {
		$pr_pr_indent = " -o $args[1]";
		$pr_indent = " -i $args[1]";
		shift @args;
	    } else {
		$pr_pr_indent = ' -o 8';
		$pr_indent = ' -i';
	    }
	} elsif ($args[0] eq '-T') {
	    usage if !$#args;
	    $pr_pr_title = " -h $args[1]";
	    $pr_title = " -T $args[1]";
	    shift @args;
        } elsif ($args[0] =~ /^-w(.*)$/) {
	    $pr_pr_width = " -w $1";
	    $pr_width = $args[0];
	} else {
	    $lpr_args[$#lpr_args + 1] = $args[0];

	    if ($args[0] =~ /^-P/) {
		($printer = $args[0]) =~ s/^-P//;
		$used_prog_lpr = $prog_lpr;
	    } elsif ($prog_lp) {
		if ($args[0] eq '-d') {
		    usage(1) if !$#args;
		    $printer = $args[1];
		    shift @args;

		    $lpr_args[$#lpr_args + 1] = $printer;

		    $used_prog_lpr = $prog_lp;
		}
	    }
	}
    }

    shift @args;
}

$opt_nonstd = !$opt_standard;

if ($opt_output eq '-') {
    $tellstream = STDERR;
} else {
    $tellstream = STDOUT;
}

#
# Determine the printer name and get its type.
#
# If the $printer printer name is not set using the -P option, get it
# from the PSPLPR_PRINTER or PRINTER environment variables. Defaults to
# $dflt_printer if nothing is set.
#   Same for lp(1) printing with PSPLPR_LPDEST and LPDEST, defaulting to
# $dflt_lp_printer.
#   Note that if PSPLPR_PRINTER is set we set PRINTER to its value too,
# and if PSPLPR_LPDEST is set we set LPDEST too.
#

$used_prog_lpr = $prog_cat if (!$used_prog_lpr || ! -x $used_prog_lpr);

$cmdline = "|$used_prog_lpr";
if ($#lpr_args >= 0) {
    $cmdline .= " @lpr_args";
}

if (!defined($printer)) {
    $printer = &choose_default_printer;
}

&tell_user("parsing printcap entry for $printer");

if ($ptype) {
    &printcap::printcap($printer);
} else {
    $ptype = &printer::printertype($printer);
}

if (!defined($finalform)) {
    $finalform = exists($PRINTCAP{$pcap_final});
}

if ($use_pr) {
    $filterline .= "$prog_pr$pr_pr_title$pr_pr_width$pr_pr_indent|";
}
if ($PRINTCAP{"${use_filter}f"}) {
    local($filtername) = "${use_filter}f";
    $filterline .= "$PRINTCAP{$filtername}|";
}

if ($ptype) {
    $ppdfile = &ppd::ppdfile($ptype);

    if (!$ppdfile) {
    	print STDERR "$myname: cannot find `$ptype' PPD file for $printer\n";
    	if (!$opt_warn) {
	    exit(2);
    	}
    }

    &tell_user("using $ppdfile") if $ppdfile;
} else {
    if ($needs_ppd) {
	print STDERR "$myname: cannot find description file for $printer\n";
    	if (!$opt_warn) {
    	    exit(2);
        }
    }

    &tell_user("not using a printer description file\n");
}

if ($ppdfile) {
    if ($error = &ppd::parseppd($ppdfile)) {
    	print STDERR "$myname: $error\n";
    	if ($opt_warn) {
	    $ppdfile = '';
    	} else {
	    exit(3);
    	}
    }
}

if ($opt_show) {
    local($key);

    exit(0) if !$ppdfile;

    print "$ppdfile\n\n" if $opt_verbose;

    foreach $key (sort (keys %PPD_Defaults, keys %PPD_Params)) {
	if (exists($PPD_NotInvocationValue{$key})
	    || (abs($opt_show) < 10
	        && (exists($PPD_Dep_JCLSetup{$key})
		    || exists($PPD_Dep_ExitServer{$key})))) {
	    next;
	}

        local(@keys) = keys %{$PPD_Features{$key}};
        local($type) = $PPD_Types{$key};

	if (!$type) {
	    if (exists($PPD_Params{$key})) {
		$type = 'Param';
	    } elsif ($opt_show != 5) {
        	$type = 'PickOne (Unspecified)';
	    } else {
		$type = 'PickOne';
	    }
 	}

        local($printing, $fkey) = 0;

        if ($opt_show < 0) {
	    local($dep, $depsec, $depend);

	    print "$key";
	    if ($PPD_AlternateNames{$key}) {
		print " ($PPD_AlternateNames{$key})";
	    }
	    print "\n";

	    print "    Type\n        $type\n";

	    print "    Order Dependency\n        ";

	    if (exists($PPD_Section{$key})) {
		$depsec = "$PPD_Section{$key}";
	    } elsif (exists($PPD_GuessedDep{$key})) {
		$depsec = "$PPD_GuessedDep{$key}";
 		$depend = " (Unspecified) ";
	    } else {
	    	$depsec = "AnySetup";
 		$depend = " (Unspecified, Error) ";
	    }

	    print "$depsec $PPD_Dep{$depsec}{$key}$depend\n";

	    if ($type eq 'Param') {
		print "    Parameters\n";
		foreach $fkey (sort keys %{$PPD_Params{$key}}) {
		    local($altname) = $PPD_ParamsAltNames{$key}{$fkey};

		    print "        $fkey";
		    if ($altname) {
			print " ($altname)";
		    }
		    print " [", $PPD_Params{$key}{$fkey}{Type},
		        "] ", $PPD_Params{$key}{$fkey}{Min}, " ",
		        $PPD_Params{$key}{$fkey}{Max};
		    print "\n";
		}
	    } elsif (@keys) {
		print "    Valid Values\n";
		foreach $fkey (sort @keys) {
		    local($altname) = $PPD_AltNames{$key}{$fkey};

		    print "        $fkey";
		    if ($altname) {
			print " ($altname)";
		    }
		    print "\n";
		}

		local($def) = $PPD_Defaults{$key};

		print "    Default\n        $def";

		if ($opt_print_alt_def) {
		    local($altdef) = $PPD_AltNames{$key}{$def};

		    if ($altdef) {
		        print " ($altdef)";
		    }
		}

		print "\n";
	    }

	    if ($opt_showconstraints) {
		local($pconst) = 0;
		foreach $ckey (sort keys %PPD_Constraints) {
		    local($rekey) = quotemeta($key);

		    if ($ckey !~ /^$rekey(=(.*))?/) {
			next;
		    }

		    if (!$pconst) {
		        print "    Constraints\n";
			$pconst = 1;
		    }
		    print "        $2",
			$PPD_Constraints{"$key$1"}, "\n";
	    	}
	    }
	    print "\n";
	} elsif ($opt_show == 5) {
	    if ($type eq 'Param') {
		print "$key";
		if ($PPD_AlternateNames{$key}) {
		    print " ($PPD_AlternateNames{$key})";
		}
		print ", $type";

		if ($opt_showconstraints) {
		    local($const) = $PPD_Constraints{$key};
		    if (!$const) {
			$const = $PPD_Constraints{"$key=True"};
		    }
		    if ($const) {
			print ",$const";
		    }
		}
		print "\n";

		foreach $fkey (sort keys %{$PPD_Params{$key}}) {
		    local($altname) = $PPD_ParamsAltNames{$key}{$fkey};

		    print "    $fkey";
		    if ($altname) {
			print " ($altname)";
		    }
		    print " [", $PPD_Params{$key}{$fkey}{Type},
		        "] ", $PPD_Params{$key}{$fkey}{Min}, " ",
		        $PPD_Params{$key}{$fkey}{Max};
		    print "\n";
		}
		print ".\n";
	    } elsif (@keys) {
		print "$key";
	        if ($PPD_AlternateNames{$key}) {
		    print " ($PPD_AlternateNames{$key})";
	        }

		local($def) = $PPD_Defaults{$key};

                print ", $type, $def";

		if ($opt_print_alt_def) {
		    local($altdef) = $PPD_AltNames{$key}{$def};

		    if ($altdef) {
		    	print " ($altdef)";
		    }
		}

		if ($opt_showconstraints) {
		    local($const) = $PPD_Constraints{$key};
		    if ($const) {
			print ",$const";
		    }
		}
		print "\n";
		foreach $fkey (sort @keys) {
		    local($altname) = $PPD_AltNames{$key}{$fkey};

		    print "    $fkey";
		    if ($altname) {
			print " ($altname)";
		    }
		    if ($opt_showconstraints) {
			$PPD_Constraints{"$key=$fkey"};
		    }
		    print "\n";
		}
		print ".\n";
	    }
	} else {
	    if ($type eq 'Param') {
		$printing = 1;

		print "$key\n    $type\n";

		foreach $fkey (sort keys %{$PPD_Params{$key}}) {
		    print "    $fkey [", $PPD_Params{$key}{$fkey}{Type},
		        "] ", $PPD_Params{$key}{$fkey}{Min}, " ",
		        $PPD_Params{$key}{$fkey}{Max}, "\n";
		}
	    } elsif (@keys) {
		$printing = 1;

		print "$key\n    $type, $key=$PPD_Defaults{$key}\n   ";

		local(@keys) = sort @keys;

		foreach $fkey (@keys) {
		    print " $fkey";
		    if ($fkey ne $keys[$#keys]) {
			print ",";
		    }
		}
		print "\n";
	    }

	    if ($printing && $opt_showconstraints) {
		foreach $ckey (sort keys %PPD_Constraints) {
		    local($keyre) = quotemeta($key);

		    if ($ckey !~ /^$keyre(?:=(.*)$)?/) {
			next;
		    }
		    print "        ";
		    if ($1) {
			print "$1 ";
		    }
		    print $PPD_Constraints{$ckey}, "\n";
	    	}
	    }
	}
    }

    exit(0);
}

if (!$ppdfile) {
    goto lpr_eventually;
}

#
# Now that the PPD file has been read, handle all selected features,
# that is replace alternate names by natural names if needed, and enter
# the features in the %ppd_options hash.
#

foreach $key (@ppd_features) {
    local($optname, $optval) = split('=', $key);

    if ($PPD_NaturalNames{$optname}) {
        $optkey = $PPD_NaturalNames{$optname};
	$PPD_UsrNames{Features}{$optkey} = "$optname ($optkey)";
    } else {
	if ($optname =~ /^\*/) {
	    $optkey = $optname;
	} else {
	    $optkey = "*$optname";
	}
    	$PPD_UsrNames{Features}{$optkey} = $optkey;
    }

    if ($optname ne $optkey && exists($PPD_ParamsSet{$optname})) {
	$PPD_ParamsSet{$optkey} = $PPD_ParamsSet{$optname};
	delete $PPD_ParamsSet{$optname};
    }

    if ($optkey =~ /^\*Default(.*)$/) {
        local($theopt, $theval) = ppd::checkfeature("*$1", $optval, 0);

	if ($theopt) {
	    $ppd_defaults{"*$1"} = $PPD_Defaults{"*$1"};
	    if ($optval) {
	        print STDERR
		    "$myname: default feature $optkey cannot take a value\n";
	        ++$bad;
	    }
	} else {
	    print STDERR "$theval\n";
	    ++$bad;
	}
    } else {
        $optval = 'True' unless $optval;
        $ppd_options{$optkey} = $optval;
    }
}

foreach $key (keys %PPD_ParamsSet) {
    local($param);

    foreach $param (keys %{$PPD_ParamsSet{$key}}) {
	if (exists($PPD_ParamsNatNames{$key}{$param})) {
	    local($natparam) = $PPD_ParamsNatNames{$key}{$param};

	    $PPD_ParamsSet{$key}{$natparam} = $PPD_ParamsSet{$key}{$param};
	    delete $PPD_ParamsSet{$key}{$param};

	    $PPD_UsrNames{Params}{$natparam} = "$param ($natparam)";
	} else {
	    $PPD_UsrNames{Params}{$param} = "$param";
	}
    }
}

#
# Add all default values if asked to do so.
#

if ($finalform) {
    local($def);

    foreach $def (keys %PPD_Defaults) {
	if (!exists($PPD_NotInvocationValue{$def})) {
	    if ($def ne "*PageRegion"
		|| !exists($PPD_Defaults{'*PageSize'})) {
	        %ppd_defaults = (%ppd_defaults, $def, $PPD_Defaults{$def});
	    }
	}
    }
}

foreach $key (keys %ppd_defaults) {
    if (!exists($ppd_options{$key})) {
	if (keys %{$PPD_Features{$key}}) {
	    # Really a feature, add the default
	    $ppd_options{$key} = $PPD_Defaults{$key};
	    $PPD_UsrNames{Features}{$key} = $key;
	}
    }
}

#
# Check the options given by the user, and change alt. names to normal ones.
#

foreach $opt (sort keys %ppd_options) {
    local($theopt, $theval) = ppd::checkfeature($opt, $ppd_options{$opt}, 1);

    if (!$theopt) {
	print STDERR "$myname: unknown feature ",
	    "$PPD_UsrNames{Features}{$opt}\n";
        delete $ppd_options{$opt};
        ++$bad;
    } elsif (!$theval) {
	print STDERR
	    "$myname: incorrect value $ppd_options{$opt} for feature ",
	    $PPD_UsrNames{Features}{$opt}, "\n";
	delete $ppd_options{$opt};
	++$bad;
    } else {
	$ppd_options{$theopt} = $theval;
    }
}

#
# Check constraints. We append the default values before, except if
# the final form is used because they are already there.
#

%all_options = ();

if (!$finalform) {
    foreach $key (keys %PPD_Defaults) {
	if (!exists($ppd_options{$key})) {
	    if (keys %{$PPD_Features{$key}}) {
		# Really a feature, add the default
	        $all_options{$key} = $PPD_Defaults{$key};
	    }
	}
    }
}

foreach $opt (keys %ppd_options) {
    $all_options{$opt} = $ppd_options{$opt};
}

if ($all_options{'*ManualFeed'} eq 'True') {
    delete $all_options{'*InputSlot'};
    delete $ppd_options{'*InputSlot'};
}

foreach $opt (keys %all_options) {
    if (!$opt) { next; }

    local($theopt, $constraint);
    local($stopt) = "$opt=$all_options{$opt}";

    local($pbad, $retheopt) = 0;

    local(@errs) = ppd::checkconstraints($stopt, %all_options);
    local($emsg);

    foreach $emsg (@errs) {
	print STDERR "$myname: $emsg\n";
	++$bad;
    }

    local($param, $nextra, $extra);

    foreach $param (sort keys %{$PPD_ParamsSet{$opt}}) {
	if (!defined($PPD_Params{$opt}{$param})) {
	    $extra .= " $param";
	    ++$nextra;
	}
    }

    if ($extra) {
	print STDERR "$myname: incorrect $PPD_UsrNames{Features}{$opt}, ",
	    "unknown parameter", ($nextra == 1 ? "" : "s"), "$extra\n";
	++$pbad;
    } else {		# Check types and values.
	foreach $param (sort keys %{$PPD_ParamsSet{$opt}}) {
	    local($type) = $PPD_Params{$opt}{$param}{Type};
	    local($pval) = $PPD_ParamsSet{$opt}{$param};

	    local($val, $ok, $unit) = ppd::ppdparamvalue($type, $pval);

	    if ($ok) {
		local($min) = $PPD_Params{$opt}{$param}{Min};
		local($max) = $PPD_Params{$opt}{$param}{Max};

		if ($val >= $min && $val <= $max) {
		    $PPD_ParamsSet{$opt}{$param} = $val;
		} else {
		    print STDERR "$myname: out of range $type value ",
			"`$pval' for ", $PPD_UsrNames{Features}{$opt},
		        " ", $PPD_UsrNames{Params}{$param}, ": min is ",
			$min,
			($unit && $unit ne 'pt')
			    ? " (" .  ppd::ppdunitvalue($min, $unit)
				. " $unit)"
			    : "",
			 ", max is ",
			$max,
			($unit && $unit ne 'pt')
			    ? " (" .  ppd::ppdunitvalue($max, $unit)
				. " $unit)"
			    : "",
			"\n";
		    ++$bad;
		}
	    } else {
		print STDERR "$myname: bad $type value `$pval' ",
		    "for ", $PPD_UsrNames{Features}{$opt},
		    " ", $PPD_UsrNames{Params}{$param}, "\n";
		++$pbad;
	    }
	}
    }

    if ($pbad) {
	delete $PPD_ParamsSet{$opt};
    }

    $bad += $pbad;
}

if ($bad && !$opt_warn) {
    if ($say_hm_bad) {
    	print STDERR "$myname: found $bad fatal error";
    	if ($bad != 1) {
            print STDERR "s";
    	}
    	print STDERR ", exiting\n";
    }
    exit(4);
}

local($includeres) = execpath('includeres');

if ($opt_output) {
    if ($opt_output eq '-') {
	if ($includeres eq '' || $cmdline ne "$includeres") {
            $cmdline = "|$prog_cat";
	}
    } else {
	$cmdline = ">$opt_output";
    }
}

if ($includeres) {
    $cmdline = "|$includeres$cmdline";
}

# Eventually call lpr

lpr_eventually: if ($ppdfile eq '') {	# Simply call lpr as is.
    if ($use_filter) {
	$cmdline .= " -$use_filter";
    } elsif ($use_pr) {
	$cmdline .= " -p$pr_title$pr_width$pr_indent";
    }

    $cmdline =~ s/^\|//;

    exec "$cmdline @lpr_files";
}

# Now filter all those files

if (!@lpr_files) {
    $lpr_files[0] = "-";
}

$bad = 0;

foreach $file (@lpr_files) {
    local($filename, $error);

    if ($filterline) {
	$filename = "$prog_cat $file|$filterline";
    } else {
	$filename = $file;
    }

    if ($error = &addppdfeatures($filename, $file, "$cmdline",
	$opt_nodsc, $opt_stripcomments, $opt_safer,
	$opt_nonstd, $opt_globps, $opt_dontglobps, $opt_conformant,
        $opt_special, $opt_incfeatures, $opt_chgfeatures,
	$opt_delfeatures, $opt_prepend, %ppd_options)) {
	print STDERR "$myname: $error\n";
	++$bad;
    }
}

exit($bad ? 5 : 0);

# Local Variables:
# mode: perl
# End:

