path: root/net-print/cups/files/cupsomatic

#!/usr/bin/perl

# The above Perl path may vary on your system; fix it!!!

# Cupsomatic is intended to be used as a CUPS filter for printers
# defined in a PPD file (CUPS-O-Matic or PPD-O-Matic) obtained from
# the Linux Printing Database.
#
# See http://www.linuxprinting.org/cups-doc.html

# ==========================================================================
#
#    User-configurable settings, edit them if needed
#
# ==========================================================================

# What path to use for filter programs and such.  Your printer driver
# must be in the path, as must be Ghostscript, $enscriptcommand, and
# possibly other stuff.	 The default path is often fine on Linux, but
# may not be on other systems.
#
my $execpath = "/usr/local/bin:/usr/bin:/bin";

# Location of the configuration file "filter.conf", this file can be
# used for settings which should apply to all filters (lpdomatic,
# cupsomatic, ...).
# This variable must contain the full pathname of the directory which
# contains the configuration file, usually "/etc/foomatic".
my $configpath = "/etc/foomatic";

# For the stuff below, the settings in the configuration file have priority.

# Enter here your personal command for converting non-postscript files
# (especially text) to PostScript. If you leave it blank, at first the
# line "textfilter: ..." from /etc/foomatic/filter.conf is read and
# then the commands given on the list below are tried, beginning with
# the first one.
# You can set this to "a2ps", "enscript" or "mpage" to select one of the
# default command strings.
my $enscriptcommand = "";

# Set to 1 to insert postscript code for accounting.
my $ps_accounting = 1;

# Set debug to 1 to enable the debug logfile for this filter; it will
# appear as /tmp/prnlog It will contain status from this filter, plus
# Ghostscript stderr output. You can also add a line "debug: 1" to
# your /etc/foomatic/filter.conf to get all your Foomatic filters into
# debug mode.
#
# WARNING: This logfile is a security hole; do not use in production.
my $debug = 0;

# This is the location of the debug logfile in case you have enabled debugging
# above.
my $logfile = "/tmp/prnlog";

# End interesting enduser options

# ==========================================================================
#
# cupsomatic Perl Foomatic filter script for CUPS
#
# Copyright 2000-2001 Grant Taylor <gtaylor at picante dot com>
#                   & Till Kamppeter <till dot kamppeter at gmx dot net>
#
#  This program is free software; you can redistribute it and/or modify it
#  under the terms of the GNU General Public License as published by the Free
#  Software Foundation; either version 2 of the License, or (at your option)
#  any later version.
#
#  This program 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 General Public License
#  for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#

# Read config file if present
%conf = readConfFile("$configpath/filter.conf");

# Determine which filter to use for non-PostScript files to be converted
# to PostScript

my @enscriptcommands = 
  ('a2ps -1 @@--medium=@@PAGESIZE@@ @@--center-title=@@JOBTITLE@@ -o - 2>/dev/null',
   'enscript -G @@-M @@PAGESIZE@@ @@-b "Page $%|@@JOBTITLE@@ -p- 2>/dev/null',
   'mpage -o -1 @@-b @@PAGESIZE@@ @@-H -h @@JOBTITLE@@ -P- -');

if (defined(%conf) and $conf{textfilter})
{
    $enscriptcommand = $conf{textfilter};
    $enscriptcommand eq 'a2ps' and $enscriptcommand = $enscriptcommands[0];
    $enscriptcommand eq 'enscript' and $enscriptcommand = $enscriptcommands[1];
    $enscriptcommand eq 'mpage' and $enscriptcommand = $enscriptcommands[2];
}

if ($execpath) {$ENV{'PATH'} = $execpath;}

# Set debug mode
$debug = $conf{debug} if defined(%conf) and defined $conf{debug};

# Where to send debugging log output to
if ($debug) {
    # Grotesquely unsecure; use for debugging only
    open LOG, ">$logfile";
    $logh = *LOG;

    use IO::Handle;
    $logh->autoflush(1);
} else {
    $logh=*STDERR;
}

# This piece of PostScript code (initial idea 2001 by Michael Allerhand
# (michael.allerhand at ed dot ac dot uk, vastly improved by Till Kamppeter
# in 2002) lets GhostScript output the page accounting information which
# CUPS needs on standard error.

$ps_accounting = $conf{ps_accounting} 
	if defined(%conf) and defined $conf{ps_accounting};
my $accounting_prolog = $ps_accounting ? "[{
%% Code for writing CUPS accounting tags on standard error

/cupsPSLevel2 % Determine whether we can do PostScript level 2 or newer
    systemdict/languagelevel 2 copy
    known{get exec}{pop pop 1}ifelse 2 ge
def

/cupsGetNumCopies { % Read the number of Copies requested for the current
		    % page
    cupsPSLevel2
    {
	% PS Level 2+: Get number of copies from Page Device dictionary
	currentpagedevice /NumCopies get
    }
    {
	% PS Level 1: Number of copies not in Page Device dictionary
	null
    }
    ifelse
    % Check whether the number is defined, if it is \"null\" use #copies 
    % instead
    dup null eq {
	pop #copies
    }
    if
    % Check whether the number is defined now, if it is still \"null\" use 1
    % instead
    dup null eq {
	pop 1
    } if
} bind def

/cupsWrite { % write a string onto standard error
    (%stderr) (w) file
    exch writestring
} bind def

/cupsEndPage { % write page log info when we were invoked by \"showpage\"
	       % or \"copypage\" return \"true\" or \"false\" as we had no
	       % redefinition of \"EndPage\"

    2 ne % If the reason code is 0 or 1, we have finshed a page
	 % (we were invoked by \"showpage\" or \"copypage\"), 
         % write log info and exit with \"true\" to push out the page.
	 % In case of reason code 2, we are invoked during device
	 % deactivation (happens also at a \"setpagedevice\" call),
	 % here we should not log and return \"false\"
    {
	% write \"Page <# of page> <# of copies><LF>\" to stderr
	(PAGE: ) cupsWrite
	% we must add 1 here, the number on the stack is the number
	% of \"showpage\" already executed during this job
	1 add 40 string cvs cupsWrite
	% space
	( ) cupsWrite
	% get the number of copies for this page
	cupsGetNumCopies 40 string cvs cupsWrite
	% line feed
	(\\n) cupsWrite
	% page should be ejected
	true
    }
    {
	pop % ignore the number of pages already printed
	% do not eject paper
	false
    }
    ifelse
} bind def

<</EndPage{cupsEndPage}>>setpagedevice
} stopped cleartomark
" : "";


# Flush everything immediately.
$|=1;

my $comversion='$Revision: 1.3 $';
#'# Fix emacs syntax highlighting
print $logh "Cupsomatic backend version $comversion running...\n";
# print the command line only in debug mode, Mac OS X adds very many
# options so that CUPS cannot handle the output of the command line
# in its log files. If CUPS encounters a line with more than 1024 characters
# sent into its log files, it aborts the job with an error.
if ($debug) {
    print $logh "called with arguments: '",join("','",@ARGV),"'\n";
}
my $jobtitle = $ARGV[2];
# Check for and handle inputfile vs stdin
my $inputfile = $ARGV[5];
if ($inputfile and $inputfile ne '-') {
    print $logh 'inputfile handling is broken!!!';
    warn 'inputfile handling is broken!!!';
}

# We get the PPD filename in environment variable PPD.
# Load the cups-o-matic data structure from it
# Load also the defaults from the PPD syntax...
my $ppdfile = $ENV{'PPD'};

print $logh "ppd=$ppdfile\n";

open PPD, "$ppdfile" || do {
    print $logh "error opening $ppdfile.\n";
    die "unable to open ppd file $ppdfile";
};

my @datablob;                   # embedded data
my %ppddefaults;                # defaults from PPD
while(<PPD>) {
    if (s!^\*\% COMDATA \#!!) {
        push (@datablob, $_);
    } elsif (m!^\*Default(\w+): ([\w\.\+]+)!) { 
	     # The dot in the default value is needed to support float
	     # options
        $ppddefaults{$1} = $2;
    }
}
close PPD;

# OK, we have the datablob
eval join('',@datablob) || do {
    print $logh "unable to evaluate datablob\n";
    die "error in datablob eval";
};

$dat = $VAR1;

# Determine with which command non-PostScript files are converted to PostScript
if ($enscriptcommand eq "") {
    for my $c (@enscriptcommands) {
	($c =~ m/^\s*(\S+)\s+/) || ($c = m/^\s*(\S+)$/);
	$command = $1;
	for (split(':', $ENV{'PATH'})) {
	    if (-x "$_/$command") {
		$enscriptcommand = $c;
		last;
	    }
	}
	if ($enscriptcommand ne "") {
	    last;
	}
    }
    if ($enscriptcommand eq "") {
	$enscriptcommand = "echo \"Cannot convert file to PostScript!\" 1>&2";
    }
}

## First, for arguments with a default, stick the default in as the
## userval.  First take the defaults from the embedded data, then take
## the defaults as found in the PPD file: some people modify the PPD
## file directly to set new system-wide defaults.

# from metadata
for $arg (@{$dat->{'args'}}) {
    if ($arg->{'default'}) {
        $arg->{'userval'} = $arg->{'default'};
    }
}

# from ppd file; these overwrite the standard defaults
for $arg (@{$dat->{'args'}}) {
    my $ppddef = $ppddefaults{$arg->{'name'}};
    if (defined($ppddef)) {
	my $name = $arg->{'name'};
        if ($arg->{'type'} eq 'bool') {
            # This maps Unknown to mean False.  Good?  Bad?
            $arg->{'userval'} = ($ppddef eq 'True' ? '1' : '0');
        } elsif ($arg->{'type'} eq 'enum') {
            if (defined($arg->{'vals_byname'}{$ppddef})) {
                $arg->{'userval'} = $ppddef;
            } else {
                # wtf!?  that's not a choice!
                my $name=$arg->{'name'};
                print $logh 
                   "PPD default value $ppddef for $name is not a choice!\n";
            }
        } elsif (($arg->{'type'} eq 'int') ||
		 ($arg->{'type'} eq 'float')) {
	    if (($ppddef <= $arg->{'max'}) &&
		($ppddef >= $arg->{'min'})) {
		$arg->{'userval'} = $ppddef;
	    } else {
		print $logh 
                   "PPD default value $ppddef for $name is out of range!\n";
	    }
	}
    }
}

# so now what were the defaults? print them if debugging...
if ($debug) {
    for $arg (@{$dat->{'args'}}) {
        my ($name, $val) = ($arg->{'name'}, $arg->{'userval'});
        print $logh "Default for option $name is $val\n";
    }
}

## We get various options as argument 5.  Parse these out.  User-set
## values get stored as 'userval' in the argument's structure
my $optstr = $ARGV[4];

# print the options string only in debug mode, Mac OS X adds very many
# options so that CUPS cannot handle the output of the option string
# in its log files. If CUPS encounters a line with more than 1024 characters
# sent into its log files, it aborts the job with an error.
if ($debug) {
    print $logh "options: ->$optstr<-\n";
}

# Parse them.  They're foo='bar nut', or foo, or 'bar nut', or
# foo:'bar nut' (when GPR was used) all with spaces between...

my @opts;

# foo='bar nut'
while ($optstr =~ s!(\w+=\'.+?\') ?!!) {
    push (@opts, $1);
}

# foo:'bar nut' (GPR separates option and setting with a colon ":")
while ($optstr =~ s!(\w+:\'.+?\') ?!!) {
    push (@opts, $1);
}

# 'bar nut'
while ($optstr =~ s!(\'.+?\') ?!!) {
    push (@opts, $1);
}

# foo
push(@opts, split(/ /,$optstr));


# Now actually process those pesky options...

for (@opts) {
    print $logh "Pondering option `$_'\n";

    if ((lc($_) =~ /^\s*docs\s*$/) ||
	(lc($_) =~ /^\s*docs\s*=\s*true\s*$/)) {
	# The second one is necessary becuase CUPS 1.1.15 or newer sees
	# "docs" as boolean option and modifies it to "docs=true"
        $do_docs = 1;
        last;
    }

    my $arg;
    if ((m!(.+)=\'?(.+)\'?!) || (m!(.+):\'?(.+)\'?!)) {
	# GPR separates option and setting with a colon ":", all other 
	# frontends use "=".
        my ($aname, $avalue) = ($1, $2);

        # Standard arguments?
        # media=x,y,z
        # sides=one|two-sided-long|short-edge

        # handled by cups for us?
        # page-ranges=
        # page-set=
        # number-up=

        # brightness= gamma= these probably collide with printer-specific
        # options.  Hmm.  CUPS has a stupid design for option
        # handling; everything gets all muddled together.

        # Rummage around in the media= option for known media, source, etc types.
        # We ought to do something sensible to make the common manual
        # boolean option work when specified as a media= tray thing.
        # 
        # Note that this fails miserably when the option value is in
        # fact a number; they all look alike.  It's unclear how many
        # drivers do that.  We may have to standardize the verbose
        # names to make them work as selections, too.

        if ($aname =~ m!^media$!i) {
            my @values = split(',',$avalue);
            for (@values) {
                if ($dat->{'args_byname'}{'PageSize'}
                    and $val=valbyname($dat->{'args_byname'}{'PageSize'},$_)) {
                    $dat->{'args_byname'}{'PageSize'}{'userval'} = 
                        $val->{'value'};
                } elsif ($dat->{'args_byname'}{'MediaType'}
                         and $val=valbyname($dat->{'args_byname'}{'MediaType'},$_)) {
                    $dat->{'args_byname'}{'MediaType'}{'userval'} =
                        $val->{'value'};
                } elsif ($dat->{'args_byname'}{'InputSlot'}
                         and $val=valbyname($dat->{'args_byname'}{'InputSlot'},$_)) {
                    $dat->{'args_byname'}{'InputSlot'}{'userval'} = 
                        $val->{'value'};
                } elsif (lc($_) eq 'manualfeed') {
                    # Special case for our typical boolean manual
                    # feeder option if we didn't match an InputSlot above
                    if (defined($dat->{'args_byname'}{'ManualFeed'})) {
                        $dat->{'args_byname'}{'ManualFeed'}{'userval'} = 1;
                    }
                } else {
                    print $logh "Unknown media= component $_.\n";
                }
            }

        } elsif ($aname =~ m!^sides$!i) {
            # Handle the standard duplex option, mostly
            if ($avalue =~ m!^two-sided!i) {
                if (defined($dat->{'args_byname'}{'Duplex'})) {
		    # We set "Duplex" to '1' here, the real argument setting
		    # will be done later
                    $dat->{'args_byname'}{'Duplex'}{'userval'} = '1';
		    # Check the binding: "long edge" or "short edge"
		    if ($avalue =~ m!long-edge!i) {
			if (defined($dat->{'args_byname'}{'Binding'})) {
			    $dat->{'args_byname'}{'Binding'}{'userval'} =
	  $dat->{'args_byname'}{'Binding'}{'vals_byname'}{'LongEdge'}{'value'};
			} else {
			    $dat->{'args_byname'}{'Duplex'}{'userval'} = 
				'LongEdge';
			}
		    } elsif ($avalue =~ m!short-edge!i) {
			if (defined($dat->{'args_byname'}{'Binding'})) {
			    $dat->{'args_byname'}{'Binding'}{'userval'} =
	 $dat->{'args_byname'}{'Binding'}{'vals_byname'}{'ShortEdge'}{'value'};
			} else {
			    $dat->{'args_byname'}{'Duplex'}{'userval'} = 
				'ShortEdge';
			}
		    }
                }
            } elsif ($avalue =~ m!^one-sided!i) {
                if (defined($dat->{'args_byname'}{'Duplex'})) {
		    # We set "Duplex" to '0' here, the real argument setting
		    # will be done later
                    $dat->{'args_byname'}{'Duplex'}{'userval'} = '0';
                }
            }

            # We should handle the other half of this option - the
            # BindEdge bit.  Also, are there well-known ipp/cups
            # options for Collate and StapleLocation?  These may be
            # here...

        } else {
            # Various non-standard printer-specific options
            if ($arg=argbyname($aname)) {
                $arg->{'userval'} = $avalue;

                # Special case for PPD undef in required defaults; etc.
                # The user himself should never be specifying 'Unknown'.
                if (lc($avalue) eq 'unknown') {
                    $arg->{'userval'} = undef;
                }
            } else {
                print $logh "Unknown option $aname=$avalue.\n";
            }
        }
    } elsif (m!no(.+)!i) {
        # standard bool args:
        # landscape; what to do here?
        # duplex; we should just handle this one OK now?

        if ($arg=argbyname($1)) {
            $arg->{'userval'} = 0;
        } else {
            print $logh "Unknown bool option $1.\n";
        }
    } elsif (m!(.+)!) {
        if ($arg=argbyname($1)) {
            $arg->{'userval'} = 1;
        } else {
            print $logh "Unknown bool? option $1.\n";
        }
    }
}


## Next, examine the postscript job itself for traces of command-line
## and pjl options.  Sometimes these don't show up in the CUPS filter
## 'options' argument!

# Examination strategy: read some lines from STDIN.  Put those lines
# onto the stack @examined_stuff, which will be stuffed into
# Ghostscript/whatever later on.

print $logh "Seaerching job for option settings ...\n";
my $maxlines = 1000;            # how many lines to examine?
my $more_stuff = 1;             # there is more stuff in stdin.
my $linect = 0;                 # how many lines have we examined?
my $insertprepend = 1;          # number of the line where the PostScript
                                # commands of numerical options should be
                                # inserted. This must be after the option
                                # settings inserted by CUPS, because when one
                                # uses a PPD-O-Matic PPD file and sets a
                                # numerical option to a value which is not
                                # under the choices of the PPD representation
                                # of the option CUPS inserts the PostScript
                                # code for the default setting.
my $inheader = 1;               # Are we still in the header formed by the
                                # option PostScript code inserted by CUPS?
my $infeature = 0;              # Are we in a "[{ %%BeginFeature ... } stopped
                                # cleartomark" structure?

do {
    my $line;
    if ($line=<STDIN>) {
        if ($linect == 0) {
            # Line zero should be postscript leader
            die 'job does not start with Postscript %! thing'
                if $line !~ m/^.?%!/; # There can be a Windows control char
	                              # before "%!"
	    # Insert page accounting code in the beginning of the
	    # PostScript data stream
	    $line .= $accounting_prolog;
        } else {
            if (($line =~ m/\%\%BeginFeature:\s+\*?([^\s=]+)\s+(\S.*)$/) ||
		($line =~ m/\%\%\s*FoomaticOpt:\s*([^\s=]+)\s*=\s*(\S.*)$/)) {
                my ($option, $value) = ($1, $2);

                # OK, we have an option.  If it's not a
                # *ostscript-style option (ie, it's command-line or
                # PJL) then we should note that fact, since the
                # attribute-to-filteroption passing in CUPS is kind of
                # funky, especially wrt boolean options.  

		print $logh "Found: $line";
                if ($arg=argbyname($option)) {
		    print $logh "   Option: $option=$value";
                    if ($arg->{'style'} ne 'G') {
			print $logh " --> Setting option\n";
                        if ($arg->{'type'} eq 'bool') {
                            # Boolean options are 1 or 0
                            if ($value eq 'True') {
                                $arg->{'userval'} = 1;
                            } elsif ($value eq 'False') {
                                $arg->{'userval'} = 0;
                            } else {
                                warn "job contained boolean option",
                                " with neither True nor False value!?";
                            }
                        } elsif (($arg->{'type'} eq 'enum') ||
				 ($arg->{'type'} eq 'int') ||
				 ($arg->{'type'} eq 'float')) {
                            # enum options go as the value, unless 
                            # they were Unknown...
			    # Same with numerical options, they can appear
			    # here when the client has used the Adobe-
			    # compliant PPD-O-MATIC PPD file.

                            if (lc($value) eq 'unknown') {
                                $arg->{'userval'} = undef;
                            } else {
                                $arg->{'userval'} = $value;
                            }
                        }
                    } else {
                        # it is a postscript style option, presuemably
                        # all applied for us and such...
			print $logh " --> Option will be set by PostScript interpreter\n";
                    }
                } else {
                    # This option is unknown to us.  WTF?
                    warn "unknown option $option=$value found in the job";
                }

	    } elsif ($line =~ /^\s*\[\{/) {
		# Initial line ("[{") of an option setting inserted by CUPS
		$infeature ++;
	    } elsif ($line =~ /\}\s*stopped\s+cleartomark\s*$/) {
		# Final line ("} stopped cleartomark") of an option setting
		# inserted by CUPS
		$infeature --;
	    } elsif (($inheader) && (!$infeature) &&
		     ($line !~ /^\s*$/) && ($line =~ /ESPrc/)) {
		# Found end of option settings inserted by CUPS
		# (CUPS defines the "ESPrc" function then)
		$inheader = 0;
		$insertprepend = $linect;
	    }
	}

        # Push the line onto the stack for later spitting up...
        push (@examined_stuff, $line);
        $linect++;

    } else {
        # EOF!
        $more_stuff = 0;
    }
    # CUPS has inserted more than 1000 ($maxlines) lines with option
    # settings, so increase $maxlines.
    if (($linect >= $maxlines) && ($inheader)) {
	$maxlines += 200;
    }
} while (($linect < $maxlines) and ($more_stuff != 0));

#### Everything below here ought to be generic for any printing
#### system?  It just uses the $dat structure, with user values filled
#### in, and turns postscript into printer data.


# Construct the proper command line.
my $commandline = $dat->{'cmd'};
my $arg;
 argument:
    for $arg (sort { $a->{'order'} <=> $b->{'order'} } 
              @{$dat->{'args'}}) {
        
        # Only do command-line and postscript style arguments.
	# I think PJL options may break some drivers?  Uncomment if so
        # next argument if ($arg->{'style'} eq 'J');
        
        my $name = $arg->{'name'};
        my $spot = $arg->{'spot'};
        my $varname = $arg->{'varname'};
        my $cmd = $arg->{'proto'};
        my $comment = $arg->{'comment'};
        my $type = $arg->{'type'};
        my $cmdvar = "";
        my $userval = $arg->{'userval'};
        
        my $psarg = ($arg->{'style'} eq 'G' ? 1 : 0);

        if ($type eq 'bool') {

            if ($psarg && !$do_docs) {
		# CUPS handles bools for us, only for docs printing we must do 
		# it again, because we do not print the file which CUPS has 
		# filtered
            } else {
                # If true, stick the proto into the command line
                if (defined($userval) && $userval == 1) {
                    $cmdvar = $cmd;
                }
            }

        } elsif ($type eq 'int' or $type eq 'float') {

            # If defined, process the proto and stick the result into
            # the command line or postscript queue.
            if (defined($userval)) {
                my $min = $arg->{'min'};
                my $max = $arg->{'max'};
                if ($userval >= $min and $userval <= $max) {
		    my $sprintfcmd = $cmd;
		    $sprintfcmd =~ s!\%([^s])!\%\%$1!g;
		    $cmdvar = sprintf($sprintfcmd,
				      ($type eq 'int' 
                                       ? sprintf("%d", $userval)
                                       : sprintf("%f", $userval)));
                } else {
                    print $logh "Value $userval for $name is out of range $min<=x<=$max.\n";
                }
            }

        } elsif ($type eq 'enum') {

            if ($psarg && !$do_docs) {
		# CUPS handles enums for us, only for docs printing we must do 
		# it again, because we do not print the file which CUPS has 
		# filtered
            } else {
                # If defined, stick the selected value into the proto and
                # thence into the commandline
                if (defined($userval)) {
		    # CUPS assumes that options with the choises "Yes", "No",
		    # "On", "Off", "True", or "False" are boolean options and
		    # maps "-o Option=On" to "-o Option" and "-o Option=Off"
		    # to "-o noOption", which cupsomatic maps to "0" and "1".
		    # So when "0" or "1" is unavailable in the option, we try
		    # "Yes", "No", "On", "Off", "True", and "False".
		    my $found = 0;
		    my $val;
		    if ($val=valbyname($arg,$userval)) {
			$found = 1;
		    } elsif ($userval eq '0') {
			foreach (qw(No Off False None)) {
			    if ($val=valbyname($arg,$_)) {
				$userval = $_;
				$arg->{'userval'} = $userval;
				$found = 1;
				last;
			    }
			}
		    } elsif ($userval eq '1') {
			foreach (qw(Yes On True)) {
			    if ($val=valbyname($arg,$_)) {
				$userval = $_;
				$arg->{'userval'} = $userval;
				$found = 1;
				last;
			    }
			}
		    } elsif ($userval eq 'LongEdge') {
			# Handle different names for the choices of the
			# "Duplex" option
			foreach (qw(LongEdge DuplexNoTumble)) {
			    if ($val=valbyname($arg,$_)) {
				$userval = $_;
				$arg->{'userval'} = $userval;
				$found = 1;
				last;
			    }
			}
		    } elsif ($userval eq 'ShortEdge') {
			foreach (qw(ShortEdge DuplexTumble)) {
			    if ($val=valbyname($arg,$_)) {
				$userval = $_;
				$arg->{'userval'} = $userval;
				$found = 1;
				last;
			    }
			}
		    }
		    if ($found) {
			my $sprintfcmd = $cmd;
			$sprintfcmd =~ s!\%([^s])!\%\%$1!g;
                        $cmdvar = sprintf($sprintfcmd,
                                          (defined($val->{'driverval'})
                                           ? $val->{'driverval'}
                                           : $val->{'value'}));
                    } else {
                        # User gave unknown value?
                        print $logh "Value $userval for $name is not a valid choice.\n";
                    }
                }
            }

        } else {
                    
            print $logh "unknown type for argument $name!?\n";
            # die "evil type!?";

        }

        if ($arg->{'style'} eq 'G') {
            if ($type eq 'int' or $type eq 'float' or $do_docs) {
                # Place this Postscript command onto the prepend queue.
                push (@prepend, "$cmdvar\n") if $cmdvar;
            } else {
                # non numeric arguments are done for us by cups (except
		# for docs printing, here the file prepared by CUPS will
		# be replaced by the docs file which is generated by this
		# script
            }

        } elsif ($arg->{'style'} eq 'J') {

            if (defined($dat->{'pjl'})) {
                # put PJL commands onto PJL stack...
	        push (@pjlprepend, "\@PJL $cmdvar\n") if $cmdvar;
            }

        } elsif ($arg->{'style'} eq 'C') {
            # command-line argument

            # Insert the processed argument in the commandline
            # just before the spot marker.
            $commandline =~ s!\%$spot!$cmdvar\%$spot!;
        }

    }


### Tidy up after computing option statements for all of P, J, and C types:

## C type finishing
# Pluck out all of the %n's from the command line prototype
my @letters = qw/A B C D E F G H I J K L M Z/;
for $spot (@letters) {
    # Remove the letter marker from the commandline
    $commandline =~ s!\%$spot!!;
}

## G type finishing
# Insert PostScript code of the numerical options after the options settings
# which CUPS has inserted
splice(@examined_stuff, $insertprepend, 0, @prepend);
print $logh "$0: inserted option PS code:\n", @prepend;

## J type finishing
# Compute the proper stuff to say around the job

if (defined($dat->{'pjl'})) {

    # PJL "frame" with "JOB" and "EOJ" commands

    # Stick beginning of job cruft on the front of the pjl stuff...
    #unshift (@pjlprepend,
    #         "\033%-12345X\@PJL JOB NAME=\"CUPSOMATIC\"\n");

    # Arrange for PJL EOJ command at end of job
    #push (@pjlappend,
    #      "\33%-12345X\@PJL RESET\n\@PJL EOJ\n");

    # PJL "frame" without "JOB" and "EOJ" commands. We use this because
    # some printers do not support these commands

    # Stick beginning of job cruft on the front of the pjl stuff...
    unshift (@pjlprepend,
             "\033%-12345X\@PJL\n");

    # Arrange for PJL RESET command at end of job
    push (@pjlappend,
          "\33%-12345X\@PJL RESET\n");

    print $logh "PJL: ", @pjlprepend, "<job data>\n", @pjlappend;
}

# Insert the page size into the $enscriptcommand
if ($enscriptcommand =~ /\@\@([^@]+)\@\@PAGESIZE\@\@/) {
    my $optstr = ((($arg = argbyname('PageSize')))
		  ? $1 . $arg->{'userval'}
		  : "");
    $enscriptcommand =~ s/\@\@([^@]+)\@\@PAGESIZE\@\@/$optstr/;
}

# Insert the job title into the $enscriptcommand
if ($enscriptcommand =~ /\@\@([^@]+)\@\@JOBTITLE\@\@/) {
    if ($do_docs) {
	$jobtitle = "Documentation for the $dat->{'make'} $dat->{'model'}";
    }
    my $titlearg = $1;
    my ($arg, $optstr);
    ($arg = $jobtitle) =~ s/\"/\\\"/g;
    if (($titlearg =~ /\"/) || $arg) {
	$optstr = $titlearg . ($titlearg =~ /\"/ ? '' : '"') .
	    ($arg ? "$arg\"" : '"');
    } else {
	$optstr = "";
    }
    $enscriptcommand =~ s/\@\@([^@]+)\@\@JOBTITLE\@\@/$optstr/;
}

# Debugging printout of all option values
if ($debug) {
    for $arg (@{$dat->{'args'}}) {
        my ($name, $val) = ($arg->{'name'}, $arg->{'userval'});
        print $logh "Final value for option $name is $val\n";
    }
}

# Now print the darned thing!
if (! $do_docs) {
    # Run the proper command line.
    my ($driverh, $driverpid) = getdriverhandle();

    print $driverh @examined_stuff; # first 1000 lines or so
    if ($debug != 0) {
	open DRIVERINPUT, "> /tmp/prnjob"
	    or die "error opening /tmp/prnjob";
	print DRIVERINPUT @examined_stuff;
    }
    if ($more_stuff) {
        while (<STDIN>) {
            print $driverh $_;
	    if ($debug != 0) {
		print DRIVERINPUT $_;
	    }
        }
    }

    close $driverh 
        or die "error closing $driverh";
    if ($debug != 0) {
	close DRIVERINPUT 
	    or die "error closing /tmp/prnjob";
    }

    # Wait for driver child
    waitpid($driverpid, 0);
    print $logh "Main process finished\n";
    exit(0);

    ### End of non-doc processing...

} else {

    print $logh "printing docs\n";

    my $pid, $sleep_count=0;
    do {
        $pid = open(KID1, "|-");
        unless (defined $pid) {
            warn "cannot fork: $!";
            die "bailing out" if $sleep_count++ > 6;
            sleep 10;
        }
    } until defined $pid;

    if (! $pid) {
        # child/driver; exec enscript...

        my ($driverhandle, $driverpid) = getdriverhandle();

        print $logh "setting STDOUT to be $driverhandle and spawning $enscriptcommand\n";

        open (STDOUT, ">&$driverhandle")
            or die "Couldn't dup driverhandle";
	# PostScript option settings, as "PageSize"
	print $logh "Prepending option PS code:\n@prepend";
	print "@prepend";
        system "$enscriptcommand" 
            and die "Couldn't exec $enscriptcommand";

	close STDOUT;
	close $driverhandle;

	# Wait for driver child
	waitpid($driverpid, 0);
	print $logh "KID1 finished\n";
	exit(0);
    }

    # parent; write the job into KID1 aka $enscriptcommand
    select KID1;

    my ($make, $model, $driver) 
        = ($dat->{'make'}, $dat->{'model'}, $dat->{'driver'});

    my $optstr = ("Specify each option with a -o argument to lp/lpr ie\n",
                  "% lpr -o duplex -o two=2 -o three=3\n");

    print "Invokation summary for your $make $model printer as driven by
the $driver driver.

$optstr

The following options are available for this printer:

";

    for $arg (@{$dat->{'args'}}) {
        my ($name,
            $required,
            $type,
            $comment,
            $spot,
            $default) = ($arg->{'name'},
                         $arg->{'required'},
                         $arg->{'type'},
                         $arg->{'comment'},
                         $arg->{'spot'},
                         $arg->{'default'});
        
        my $reqstr = ($required ? " required" : "n optional");
        print "Option `$name':\n  A$reqstr $type argument.\n  $comment\n";
        print "  This options corresponds to a PJL command.\n" if ($arg->{'style'} eq 'J');
        
        if ($type eq 'bool') {
            if (defined($default)) {
                my $defstr = ($default ? "True" : "False");
                print "  Default: $defstr\n";
            }
            print "  Example: `$name'\n";
        } elsif ($type eq 'enum') {
            print "  Possible choices:\n";
            my $exarg;
            for (@{$arg->{'vals'}}) {
                my ($choice, $comment) = ($_->{'value'}, $_->{'comment'});
                print "   o $choice: $comment\n";
                $exarg=$choice;
            }
            if (defined($default)) {
                print "  Default: $default\n";
            }
            print "  Example: $name=$exarg\n";
        } elsif ($type eq 'int' or $type eq 'float') {
            my ($max, $min) = ($arg->{'max'}, $arg->{'min'});
            my $exarg;
            if (defined($max)) {
                print "  Range: $min <= x <= $max\n";
                $exarg=$max;
            }
            if (defined($default)) {
                print "  Default: $default\n";
                $exarg=$default;
            }
            if (!$exarg) { $exarg=0; }
            print "  Example: $name=$exarg\n";
        }

        print "\n";
    }

    select STDOUT;
    close KID1 
        or warn "error closign KID1/enscript for docs print";
}

# Wait for enscript child
waitpid($pid, 0);
print $logh "Main process finished\n";
close $logh;
exit(0);


## Everything below here *is* the same in lpdomatic and cupsomatic
## KEEP IT THAT WAY!

# return glob ref to "| commandline | self(pjlstuffer) | $postpipe"
# ugly, we use $commandline, $postpipe, @prepend, @pjlprepend, @pjlappend globals
sub getdriverhandle {

    pipe KID3_IN, KID3;
    my $pid3 = fork();
    if (!defined($pid3)) {
        print $logh "$0: cannot fork for kid3!\n";
        die "can't for for kid3\n";
    }
    if ($pid3) {

        # we are the parent; return a glob to the filehandle
        close KID3_IN;

        KID3->flush();
        return ( *KID3, $pid3 );

    } else {
        close KID3;

        pipe KID4_IN, KID4;
        my $pid2 = fork();
        if (!defined($pid2)) {
            print $logh "$0: cannot fork for kid4!\n";
            die "can't fork for kid4\n";
        }

        if ($pid2) {
            # parent, child of primary task; we are |commandline|
            close KID4_IN;

            print $logh "gs PID pid2=$pid2\n";
	    print $logh "gs command: $commandline\n";

            close STDIN                or die "couldn't close STDIN in $pid2";
            open (STDIN, "<&KID3_IN")  or die "Couldn't dup KID3_IN";
            open (STDOUT, ">&KID4")    or die "Couldn't dup KID4";
	    if ($debug) {
		open (STDERR, ">&$logh")
		    or die "Couldn't dup logh to stderr";
	    }

	    # Massage commandline to execute foomatic-gswrapper
	    my $havewrapper = 0;
	    for (split(':', $ENV{'PATH'})) {
		if (-x "$_/foomatic-gswrapper") {
		    $havewrapper=1;
		    last;
		}
	    }
	    if ($havewrapper) {
		$commandline =~ s!^\s*gs !foomatic-gswrapper !;
		$commandline =~ s!(\|\s*)gs !\|foomatic-gswrapper !;
		$commandline =~ s!(;\s*)gs !; foomatic-gswrapper !;
	    }

	    # Actually run the thing...
            system "$commandline"
		and die "Couldn't exec $commandline";
	    close STDOUT;
	    close KID4;
	    close STDIN;
	    close KID3_IN;
	    # Wait for output child
	    waitpid($pid2, 0);
	    print $logh "KID3 finished\n";
	    exit(0);
        } else {
            # child, trailing task on the pipe; we write pjl stuff
            close KID4;

            my $fileh = *STDOUT;
            if ($postpipe) {
                open PIPE,$postpipe
                    or "die cannot open postpipe $postpipe";
                $fileh = *PIPE;
            }

            # wrap the PJL around the job data...
            # wrap the PJL around the job data, if there are any
            # options specified...
	    if ( @pjlprepend > 1 ) {
		print $fileh @pjlprepend;
	    }
            while (<KID4_IN>) {
                print $fileh $_;
            }
	    if ( @pjlprepend > 1 ) {
		print $fileh @pjlappend;
	    }

            close $fileh or die "error closing $fileh";
	    close KID4_IN;

            print $logh "tail process done writing data to $fileh\n";

	    print $logh "KID4 finished\n";
            exit(0);
        }
    }
}

# Find an argument by name in a case-insensitive way
sub argbyname {
    my $name = @_[0];

    my $arg;
    for $arg (@{$dat->{'args'}}) {
        return $arg if (lc($name) eq lc($arg->{'name'}));
    }

    return undef;
}

sub valbyname {
    my ($arg,$name) = @_;

    my $val;
    for $val (@{$arg->{'vals'}}) {
        return $val if (lc($name) eq lc($val->{'value'}));
    }

    return undef;
}

sub readConfFile {
    my ($file) = @_;

    my %conf;
    # Read config file if present
    if (open CONF, "< $file") {
	while (<CONF>)
	{
	    $conf{$1}="$2" if (m/^\s*([^\#\s]\S*)\s*:\s*(.*)\s*$/);
	}
	close CONF;
    }

    return %conf;
}


# Emacs tabulator/indentation

### Local Variables:
### tab-width: 8
### perl-indent-level: 4
### End: