Tizen 2.1 base
[platform/upstream/hplip.git] / prnt / hpijs / foomatic-rip-hplip
1 #!/usr/bin/perl
2 # The above Perl path may vary on your system; fix it!!! -*- perl -*-
3
4 use strict;
5 use POSIX;
6 use Cwd;
7
8 my $ripversion='$Revision=3.0.2.131$';
9 #'# Fix emacs syntax highlighting
10
11 # foomatic-rip is a spooler-independent filter script which takes
12 # PostScript as standard input and generates the printer's page
13 # description language (PDL)/raster format as standard output. This
14 # kind of filter is usually called Raster Image Processor (RIP),
15 # therefore the name "foomatic-rip".
16
17 # Save it in one of the directories of your $PATH, so that it gets
18 # found when called from the command line (for spooler-less printing),
19 # link it to spooler-specific directories when you use CUPS or PPR:
20
21 #    ln -s /usr/bin/foomatic-rip /usr/lib/cups/filter/
22 #    ln -s /usr/bin/foomatic-rip /usr/lib/ppr/lib/
23 #    ln -s /usr/bin/foomatic-rip /usr/lib/ppr/interfaces/
24
25 # Mark this filter world-readable and world-executable (note that most
26 # spoolers run the print filters as a special user, as "lp", not as
27 # "root" or as the user who sent the job).
28
29 # See http://www.openprinting.org/cups-doc.html
30 #     http://www.openprinting.org/lpd-doc.html
31 #     http://www.openprinting.org/ppr-doc.html
32 #     http://www.openprinting.org/pdq-doc.html
33 #     http://www.openprinting.org/direct-doc.html
34 #     http://www.openprinting.org/ppd-doc.html
35
36 # ==========================================================================
37 #
38 #    User-configurable settings, edit them if needed
39 #
40 # ==========================================================================
41
42 # What path to use for filter programs and such.  Your printer driver
43 # must be in the path, as must be the renderer, $enscriptcommand, and
44 # possibly other stuff.  The default path is often fine on Linux, but
45 # may not be on other systems.
46 #
47 my $execpath = "/usr/bin:/usr/local/bin:/usr/bin:/bin";
48
49 # CUPS raster drivers are searched here
50 my $cupsfilterpath = "/usr/lib/cups/filter:/usr/local/lib/cups/filter:/usr/local/libexec/cups/filter:/opt/cups/filter:/usr/lib/cups/filter";
51
52 # Location of the configuration file "filter.conf", this file can be
53 # used to change the settings of foomatic-rip without editing
54 # foomatic-rip. itself. This variable must contain the full pathname 
55 # of the directory which contains the configuration file, usually
56 # "/etc/foomatic".
57 # Some versions of configure do not fully expand $sysconfdir
58 my $prefix = "/usr";
59 my $configpath = "/etc/foomatic";
60
61 # For the stuff below, the settings in the configuration file have priority.
62
63 # Set to 1 to insert postscript code for page accounting (CUPS only).
64 my $ps_accounting = 1;
65 my $accounting_prolog = "";
66
67 # Enter here your personal command for converting non-postscript files
68 # (especially text) to PostScript. If you leave it blank, at first the
69 # line "textfilter: ..." from /etc/foomatic/filter.conf is read and
70 # then the commands given on the list below are tried, beginning with
71 # the first one.
72 # You can set this to "a2ps", "enscript" or "mpage" to select one of the 
73 # default command strings.
74 my $fileconverter = '';
75
76 my($kid0,$kid1,$kid2,$kid3,$kid4);
77 my($kidfailed,$kid3finished,$kid4finished);
78 my($convkidfailed,$dockidfailed,$kid0finished,$kid1finished,$kid2finished);
79 my($fileconverterpid,$rendererpid,$fileconverterhandle,$rendererhandle);
80 my($jobhasjcl);
81
82 # What 'echo' program to use.  It needs -e and -n.  Linux's builtin
83 # and regular echo work fine; non-GNU platforms may need to install
84 # gnu echo and put gecho here or something.
85 #
86 my $myecho = 'echo';
87
88 # Which shell to use for executing shell commands.  Some of the PPD files
89 # specify a FoomaticRIPCommandLine that makes use of constructs not available
90 # from a vanilla Bourne shell.  On systems where /bin/sh is a vanilla Bourne
91 # we need to use a more "modern" shell to execute the command.  This will
92 # be set via a 'preferred_shell: (shell)' setting in the foomatic.conf file
93 # or automatically detected at runtime later on in this program.
94 #
95 my $modern_shell = '';
96
97 # Set debug to 1 to enable the debug logfile for this filter; it will
98 # appear as defined by $logfile. It will contain status from this
99 # filter, plus the renderer's stderr output. You can also add a line
100 # "debug: 1" to your /etc/foomatic/filter.conf to get all your
101 # Foomatic filters into debug mode.
102 #
103 # WARNING: This logfile is a security hole; do not use in production.
104 my $debug = 0;
105
106 # This is the location of the debug logfile (and also the copy of the
107 # processed PostScript data) in case you have enabled debugging above.
108 # The logfile will get the extension ".log", the PostScript data ".ps".
109 my $logfile = "/tmp/foomatic-rip";
110
111 # End interesting enduser options
112
113 # ==========================================================================
114 #
115 # foomatic-rip spooler-independent PS->Printer filter (RIP) of Foomatic
116 #
117 # Copyright 2002 - 2008 Grant Taylor <gtaylor@picante.com>
118 #                & Till Kamppeter <till.kamppeter@gmail.com>
119 #                & Helge Blischke <h.blischke@srz.de>
120 #
121 #  This program is free software; you can redistribute it and/or modify it
122 #  under the terms of the GNU General Public License as published by the
123 #  Free Software Foundation; either version 2 of the License, or (at your
124 #  option) any later version.
125 #
126 #  This program is distributed in the hope that it will be useful, but
127 #  WITHOUT ANY WARRANTY; without even the implied warranty of
128 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
129 #  Public License for more details.
130 #
131 #  You should have received a copy of the GNU General Public License
132 #  along with this program; if not, write to the Free Software
133 #  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
134 #  USA.
135 #
136
137 my $added_lf = "\n";
138
139 # Flush everything immediately.
140 $|=1;
141
142
143
144 ## Constants used by this filter
145
146 # Error codes, as some spooles behave different depending on the reason why
147 # the RIP failed, we return an error code. As I have only found a table of
148 # error codes for the PPR spooler. If our spooler is really PPR, these
149 # definitions get overwritten by the ones of the PPR version currently in
150 # use.
151
152 my $EXIT_PRINTED = 0;         # file was printed normally
153 my $EXIT_PRNERR = 1;          # printer error occured
154 my $EXIT_PRNERR_NORETRY = 2;  # printer error with no hope of retry
155 my $EXIT_JOBERR = 3;          # job is defective
156 my $EXIT_SIGNAL = 4;          # terminated after catching signal
157 my $EXIT_ENGAGED = 5;         # printer is otherwise engaged (connection 
158                               # refused)
159 my $EXIT_STARVED = 6;         # starved for system resources
160 my $EXIT_PRNERR_NORETRY_ACCESS_DENIED = 7;     # bad password? bad port
161                                                # permissions?
162 my $EXIT_PRNERR_NOT_RESPONDING = 8;            # just doesn't answer at all 
163                                                # (turned off?)
164 my $EXIT_PRNERR_NORETRY_BAD_SETTINGS = 9;      # interface settings are invalid
165 my $EXIT_PRNERR_NO_SUCH_ADDRESS = 10;          # address lookup failed, may be 
166                                                # transient
167 my $EXIT_PRNERR_NORETRY_NO_SUCH_ADDRESS = 11;  # address lookup failed, not 
168                                                # transient
169 my $EXIT_INCAPABLE = 50;                       # printer wants (lacks) features
170                                                # or resources
171 # Standard Unix signal names
172 #my SIGHUP = 1;
173 #my SIGINT = 2;
174 #my SIGQUIT = 3;
175 #my SIGKILL = 9;
176 #my SIGTERM = 15;
177 #my SIGUSR1 = 10;
178 #my SIGUSR2 = 12;
179 #my SIGTTIN = 21;
180 #my SIGTTOU = 22;
181
182 my $ESPIPE = 29;        # the errno value when seeking a pipe or socket
183
184 # The modern_shell() function will register the PIDs of all shell calls,
185 # so that rip_die() can kill these processes 
186 my %pids;
187
188 # $kidgeneration stays 0 for the main process, child processes of the
189 # main process get $kidgeneration = 1, their children 2, ...
190 my $kidgeneration = 0;
191
192 # Catch signals
193 my $retval = $EXIT_PRINTED;
194 use sigtrap qw(handler set_exit_canceled normal-signals
195                handler set_exit_error error-signals
196                handler set_exit_prnerr USR1 
197                handler set_exit_prnerr_noretry USR2
198                handler set_exit_engaged TTIN);
199
200
201 ## Some important variables
202
203 # We don't know yet, which spooler will be used. If we don't detect
204 # one.  we assume that we do spooler-less printing. Supported spoolers
205 # are currently:
206
207 #    cups    - CUPS - Common Unix Printing System
208 #    solaris - Solaris LP (possibly some other SysV LP services as well)
209 #    lpd     - LPD - Line Printer Daemon
210 #    lprng   - LPRng - LPR - New Generation
211 #    gnulpr  - GNUlpr, an enhanced LPD (development stopped)
212 #    ppr     - PPR (foomatic-rip runs as a PPR RIP)
213 #    ppr_int - PPR (foomatic-rip runs as an interface)
214 #    cps     - CPS - Coherent Printing System
215 #    pdq     - PDQ - Print, Don't Queue (development stopped)
216 #    direct  - Direct, spooler-less printing
217
218 my $spooler = 'direct';
219
220 # PPD file name
221 my $ppdfile = "";
222
223 # Printer model
224 my $model = "";
225
226 # Printer queue name
227 my $printer = "";
228
229 # Printing options
230 my $optstr = "";
231
232 # Job ID
233 my $jobid = "";
234
235 # User who sent job
236 my $jobuser = ((getpwuid($<))[0] || `whoami` || "");
237 chomp $jobuser;
238
239 # Host from which job was sent
240 my $jobhost = `hostname`;
241 chomp $jobhost;
242
243 # Job title
244 my $jobtitle = "$jobuser\@$jobhost";
245
246 # Number of copies
247 my $copies = "1";
248 my $rbinumcopies = "0";
249
250 # Post pipe (command into which the output of this filter should be piped)
251 my $postpipe = "";
252
253 # job meta-data file path (for Solaris LP)
254 my $attrpath = '';
255
256 # Files to be printed
257 my @filelist = ();
258
259 # Where to send debugging log output.  Initialized to STDERR until the command
260 # line arguments are parsed.
261 my $logh = *STDERR;
262
263 # JCL prefix to put before the JCL options (Can be modified by a
264 # "*JCLBegin:" keyword in the PPD file):
265 my $jclbegin = "\033%-12345X\@PJL\n";
266
267 # JCL command to switch the printer to the PostScript interpreter (Can
268 # be modified by a "*JCLToPSInterpreter:" keyword in the PPD file):
269 my $jcltointerpreter = "";
270
271 # JCL command to close a print job (Can be modified by a "*JCLEnd:"
272 # keyword in the PPD file):
273 my $jclend = "\033%-12345X\@PJL RESET\n";
274
275 # Prefix for starting every JCL command (Can be modified by
276 # "*FoomaticJCLPrefix:" keyword in the PPD file):
277 my $jclprefix = "\@PJL ";
278
279 # Under which name were we called and in which directory do we reside
280 $0 =~ m!^(.*/)([^/]+)$!;
281 my $programdir = $1;
282 my $programname = $2;
283
284 # Filters to convert non-PostScript files
285 my @fileconverters = 
286   (# a2ps (converts also other files than text)
287    'a2ps -1 @@--medium=@@PAGESIZE@@ @@--center-title=@@JOBTITLE@@ -o -',
288    # enscript
289    'enscript -G @@-M @@PAGESIZE@@ @@-b "Page $%|@@JOBTITLE@@ ' .
290    '--margins=36:36:36:36 --mark-wrapped-lines=arrow --word-wrap -p-',
291    # mpage
292    'mpage -o -1 @@-b @@PAGESIZE@@ @@-H -h @@JOBTITLE@@ -m36l36b36t36r ' .
293    '-f -P- -');
294
295 # spooler-specific file converters, default for the specific spooler when
296 # none of the converters above is chosen. Remove weird characters from the
297 # command line arguments to enhance security
298 my @fixed_args = 
299     (defined($ARGV[0])?removespecialchars($ARGV[0]):"",
300      defined($ARGV[1])?removespecialchars($ARGV[1]):"",
301      defined($ARGV[2])?removespecialchars($ARGV[2]):"",
302      defined($ARGV[3])?removespecialchars($ARGV[3]):"",
303      defined($ARGV[4])?removespecialchars($ARGV[4]):"");
304 my $spoolerfileconverters = {
305     'cups' => "${programdir}texttops '$fixed_args[0]' '$fixed_args[1]' '$fixed_args[2]' " .
306                 "'$fixed_args[3]' '$fixed_args[4] page-top=36 page-bottom=36 " .
307         "page-left=36 page-right=36 nolandscape cpi=12 lpi=7 " .
308         "columns=1 wrap'"
309     };
310
311 ## Config file
312
313 # Read config file if present
314 my %conf = readConfFile("$configpath/filter.conf");
315
316 # Get execution path from config file
317 $execpath = $conf{execpath} if defined $conf{execpath};
318 $ENV{'PATH'} = $execpath;
319
320 # Get CUPS filter path from config file
321 $cupsfilterpath = $conf{cupsfilterpath} if defined $conf{cupsfilterpath};
322
323 # Set debug mode
324 $debug = $conf{debug} if defined $conf{debug};
325
326 # Determine which filter to use for non-PostScript files to be converted
327 # to PostScript
328 if (defined $conf{textfilter}) {
329     $fileconverter = $conf{textfilter};
330     $fileconverter eq 'a2ps' and $fileconverter = $fileconverters[0];
331     $fileconverter eq 'enscript' and $fileconverter = $fileconverters[1];
332     $fileconverter eq 'mpage' and $fileconverter = $fileconverters[2];
333 }
334
335 # Set the preferred shell for "system()" execution
336 (defined $conf{preferred_shell}) &&
337     ($modern_shell = $conf{preferred_shell});
338 # if none was preferred, look for a shell that will work
339 foreach my $shell ('/bin/sh', '/bin/bash', '/bin/ksh', '/bin/zsh') {
340     if (($modern_shell eq '') && (-x $shell))  {
341         open(FD, "| ".$shell." -c \"((0<1))\" 2>/dev/null");
342         (close(FD) == 1) && ($modern_shell = $shell);
343     }
344 }
345
346 ## Environment variables;
347
348 # "PPD": PPD file name for CUPS, Solaris, or PPR (if we run as PPR RIP)
349 if (defined($ENV{'PPD'})) {
350     # Clean the file name from weird characters which could cause
351     # unexpected behaviour
352     $ppdfile = removespecialchars($ENV{'PPD'});
353     # CUPS, Solaris LP, and PPR (RIP filter) use the "PPD" environment variable
354     # to make the PPD file name available (we set CUPS here preliminarily,
355     # in the next step we check for Solaris LP and the PPR)
356     $spooler = 'cups';
357 }
358
359 # "SPOOLER_KEY": Solaris LP print service
360 if (defined($ENV{'SPOOLER_KEY'})) {
361     $spooler = 'solaris';
362
363     $ppdfile = $ENV{'PPD'};
364     # set the printer name from the PPD file name
365     ($ppdfile =~ m!^.*/([^/]+)\.ppd$!) &&
366         ($printer = $1);
367
368     # Solaris LP may augment the "options" string argument from the command
369     # line with an attributes file ($ATTRPATH)
370     (defined($attrpath = $ENV{'ATTRPATH'})) &&
371         ($optstr = read_attribute_file($attrpath));
372 }
373
374 # "PPR_VERSION": PPR
375 if (defined($ENV{'PPR_VERSION'})) {
376     # We have PPR
377     $spooler = 'ppr';
378 }
379
380 # "PPR_RIPOPTS": PPR
381 if (defined($ENV{'PPR_RIPOPTS'})) {
382     # PPR 1.5 allows the user to specify options for the PPR RIP with the 
383     # "--ripopts" option on the "ppr" command line. They are provided to
384     # the RIP via the "PPR_RIPOPTS" environment variable.
385     # Clean the option string from weird characters which could cause
386     # unexpected behaviour
387     $optstr .= removespecialchars("$ENV{'PPR_RIPOPTS'} ");
388     # We have PPR
389     $spooler = 'ppr';
390 }
391
392 # "LPOPTS": Option settings for some LPD implementations (ex: GNUlpr)
393 if (defined($ENV{'LPOPTS'})) {
394     my @lpopts = split(/,/, removespecialchars($ENV{'LPOPTS'}));
395     foreach my $opt (@lpopts) {
396         $opt =~ s/^\s+//;
397         $opt =~ s/\s+$//;
398         if ($opt =~ /\s+/) {
399             $opt = "\"$opt\"";
400         }
401         $optstr .= "$opt ";
402     }
403     # We have an LPD which accepts "-o" for options
404     $spooler = 'gnulpr';
405 }
406
407
408
409 ## Named command line options
410
411 # We do not use Getopt::Long because it does not work when between the
412 # option and the argument is no space ("-w80" instead of "-w 80"). This
413 # happens in the command line of LPRng, but also users could type in
414 # options this way when printing without spooler.
415
416 # Make one option string with a non-printable character as separator,
417 # So we can parse it more easily.
418
419 # To avoid the separator to be in the options itselves, it is filters
420 # out of the options. This does not break anything as having non
421 # printable characters in the command line options does not make sense
422 # nor is this needed. This way misinterpretation and even abuse is
423 # prevented.
424
425 my $argstr = "\x01" . 
426     join("\x01", map { removeunprintables($_) } @ARGV) . "\x01";
427
428 # Version check
429 if ($argstr =~ /^\x01-(h|v|-help|-version)\x01$/i) {
430     my $ver;
431     if ($ripversion =~ /^\$Revision=(.*)\$$/) {
432         $ver = $1;
433     } else {
434         $ver = "Unknown";
435     }
436     print "foomatic-rip revision $ver\n";
437     print "\"man foomatic-rip\" for help.\n";
438     exit 0;
439 }
440
441 # Debug mode activated via command line
442 if ($argstr =~ s/\x01--debug\x01/\x01/) {
443     $debug = 1;
444 }
445
446 # Command line options for verbosity
447 my $verbose = ($argstr =~ s/\x01-v\x01/\x01/);
448 my $quiet = ($argstr =~ s/\x01-q\x01/\x01/);
449 my $show_docs = ($argstr =~ s/\x01-d\x01/\x01/);
450 my $do_docs;
451 my $cupscolorprofile;
452
453 if ($debug) {
454     # Grotesquely unsecure; use for debugging only
455     open LOG, "> ${logfile}.log";
456     $logh = *LOG;
457
458     use IO::Handle;
459     $logh->autoflush(1);
460 } elsif (($quiet) && (!$verbose)) {
461     # Quiet mode, do not log
462     open LOG, "> /dev/null";
463     $logh = *LOG;
464
465     use IO::Handle;
466     $logh->autoflush(1);
467 } else {
468     # Default: log to STDERR
469     $logh=*STDERR;
470 }
471
472
473
474 ## Start debug logging
475 if ($debug) {
476     # If we are not in debug mode, we do this later, as we must find out at
477     # first which spooler is used. When printing without spooler we
478     # suppress logging because foomatic-rip is called directly on the
479     # command line and so we avoid logging onto the console.
480     print $logh "foomatic-rip version $ripversion running...\n";
481     # Print the command line only in debug mode, Mac OS X adds very many
482     # options so that CUPS cannot handle the output of the command line
483     # in its log files. If CUPS encounters a line with more than 1024
484     # characters sent into its log files, it aborts the job with an error.
485     if (($debug) || ($spooler ne 'cups')) {
486         print $logh "called with arguments: '", join("', '",@ARGV), "'\n";
487     }
488 }
489
490
491
492 ## Continue with named options
493
494 # Check for LPRng first so we do not pick up bogus ppd files by the -p option
495 if ($argstr =~ s/\x01--lprng\x01/\x01/) {
496     # We have LPRng
497     $spooler = 'lprng';
498 }
499 # 'PRINTCAP_ENTRY' environment variable is : LPRng
500 #  the :ppd=/path/to/ppdfile printcap entry should be used
501 if (defined($ENV{'PRINTCAP_ENTRY'})){
502         $spooler = 'lprng';
503         my( @pc);
504         @pc = split( /\s*:\s*/, $ENV{'PRINTCAP_ENTRY'} );
505         shift @pc;
506         foreach (@pc) {
507                 if( /^ppd=(.*)$/ or  /^ppdfile=(.*)$/ ){
508                         $ppdfile = removespecialchars($1) if $1;
509                 }
510         }
511 } elsif ($argstr =~ s/\x01--lprng\x01/\x01/g) {
512     # We have LPRng
513     $spooler = 'lprng';
514 }
515
516
517 # PPD file name given via the command line
518 # allow duplicates, and use the last specified one
519 while ( ($spooler ne 'lprng') and ($argstr =~ s/\x01-p(\x01|)([^\x01]+)\x01/\x01/)) {
520     $ppdfile = $2;
521 }
522 while ($argstr =~ s/\x01--ppd(\x01|=|)([^\x01]+)\x01/\x01/) {
523     $ppdfile = $2;
524 }
525
526 # Check for LPD/GNUlpr by typical options which the spooler puts onto
527 # the filter's command line (options "-w": text width, "-l": text
528 # length, "-i": indent, "-x", "-y": graphics size, "-c": raw printing,
529 # "-n": user name, "-h": host name)
530 if ($argstr =~ s/\x01-h(\x01|)([^\x01]+)\x01/\x01/) {
531     # We have LPD or GNUlpr
532     if (($spooler ne 'lpd') && ($spooler ne 'gnulpr') && ($spooler ne 'lprng')) {
533         $spooler = 'lpd';
534     }
535     $jobhost = $2;
536 }
537 if ($argstr =~ s/\x01-n(\x01|)([^\x01]+)\x01/\x01/) {
538     # We have LPD or GNUlpr
539     if (($spooler ne 'lpd') && ($spooler ne 'gnulpr') && ($spooler ne 'lprng')) {
540         $spooler = 'lpd';
541     }
542     $jobuser = $2;
543 }
544 if (($argstr =~ s/\x01-w(\x01|)\d+\x01/\x01/) ||
545     ($argstr =~ s/\x01-l(\x01|)\d+\x01/\x01/) || 
546     ($argstr =~ s/\x01-x(\x01|)\d+\x01/\x01/) ||
547     ($argstr =~ s/\x01-y(\x01|)\d+\x01/\x01/) || 
548     ($argstr =~ s/\x01-i(\x01|)\d+\x01/\x01/) ||
549     ($argstr =~ s/\x01-c\x01/\x01/)) {
550     # We have LPD or GNUlpr
551     if (($spooler ne 'lpd') && ($spooler ne 'gnulpr') && ($spooler ne 'lprng')) {
552         $spooler = 'lpd';
553     }
554 }
555
556 # LPRng delivers the option settings via the "-Z" argument
557 if ($argstr =~ s/\x01-Z(\x01|)([^\x01]+)\x01/\x01/) {
558     my @lpopts = split(/,/, $2);
559     foreach my $opt (@lpopts) {
560         $opt =~ s/^\s+//;
561         $opt =~ s/\s+$//;
562         $opt = removeshellescapes($opt);
563         if ($opt =~ /\s+/) {
564             $opt = "\"$opt\"";
565         }
566         $optstr .= "$opt ";
567     }
568     # We have LPRng
569     $spooler = 'lprng';
570 }
571
572 # Job title and options for stock LPD
573 if ($argstr =~ s/\x01-[jJ](\x01|)([^\x01]+)\x01/\x01/) {
574     # An LPD
575     $jobtitle = removeshellescapes($2);
576     # Classic LPD hack
577     if ($spooler eq "lpd") {
578         $optstr .= "$jobtitle ";
579     }
580 }
581
582 # Check for CPS
583 if ($argstr =~ s/\x01--cps\x01/\x01/) {
584     # We have cps
585     $spooler = 'cps';
586 }
587
588 # Options for spooler-less printing, CPS, or PDQ
589 while ($argstr =~ s/\x01-o(\x01|)([^\x01]+)\x01/\x01/) {
590     my $opt = $2;
591     $opt =~ s/^\s+//;
592     $opt =~ s/\s+$//;
593     $opt = removeshellescapes($opt);
594     if ($opt =~ /\s+/) {
595         $opt = "\"$opt\"";
596     }
597     $optstr .= "$opt ";
598     # If we don't print as a PPR RIP or as a CPS filter, we print without
599     # spooler (we check for PDQ later)
600     if (($spooler ne 'ppr') && ($spooler ne 'cps')) {
601         $spooler = 'direct';
602     }
603 }
604
605 # Printer for spooler-less printing or PDQ
606 if ($argstr =~ s/\x01-d(\x01|)([^\x01]+)\x01/\x01/) {
607     $printer = removeshellescapes($2);
608 }
609 # Printer for spooler-less printing, PDQ, or LPRng
610 if ($argstr =~ s/\x01-P(\x01|)([^\x01]+)\x01/\x01/) {
611     $printer = removeshellescapes($2);
612 }
613
614 # Were we called from a PDQ wrapper?
615 if ($argstr =~ s/\x01--pdq\x01/\x01/) {
616     # We have PDQ
617     $spooler = 'pdq';
618 }
619
620 # Were we called to build the PDQ driver declaration file?
621 # "--appendpdq=<file>" appends the data to the <file>,
622 # "--genpdq=<file>" creates/overwrites <file> for the data, and
623 # "--genpdq" writes to standard output
624 my $genpdqfile = "";
625 if (($argstr =~ s/\x01--(gen)(raw|)pdq(\x01|=|)([^\x01]*)\x01/\x01/) ||
626     ($argstr =~ s/\x01--(append)(raw|)pdq(\x01|=|)([^\x01]+)\x01/\x01/)) {
627     # Determine output file name
628     if (!$4) {
629         $genpdqfile = ">&STDOUT";
630     } else {
631         if ($1 eq 'gen') {
632             $genpdqfile = "> " . removeshellescapes($4);
633         } else {
634             $genpdqfile = ">> " . removeshellescapes($4);
635         }
636     }
637     # Do we want to have a PDQ driver declaration for a raw printer?
638     if ($2 eq 'raw') {
639         my $time = time();
640         my @pdqfile =
641 "driver \"Raw-Printer-$time\" {
642   # This PDQ driver declaration file was generated automatically by
643   # foomatic-rip to allow raw (filter-less) printing.
644   language_driver all {
645     # We accept all file types and pass them through without any changes
646     filetype_regx \"\"
647     convert_exec {
648       ln -s \$INPUT \$OUTPUT
649     }
650   }
651   filter_exec {
652     ln -s \$INPUT \$OUTPUT
653   }
654 }";
655         open PDQFILE, $genpdqfile or
656             rip_die("Cannot write PDQ driver declaration file",
657                     $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
658         print PDQFILE join('', @pdqfile);
659         close PDQFILE;
660         exit $EXIT_PRINTED;
661     }
662     # We have PDQ
663     $spooler = 'pdq';
664 }
665
666
667 # remove extra spacing if running as LPRng filter
668 $added_lf = "" if $spooler eq 'lprng';
669
670 ## Command line arguments without name
671
672 # Remaining arguments
673 my @rargs = split(/\x01/, $argstr);
674 shift @rargs;
675
676 # Load definitions for PPR error messages, check whether we run as
677 # PPR interface or as PPR RIP
678 my( $ppr_printer, $ppr_address, $ppr_options, $ppr_jobbreak, $ppr_feedback,
679         $ppr_codes, $ppr_jobname, $ppr_routing, $ppr_for, $ppr_filetype,
680         $ppr_filetoprint );
681 if ($spooler eq 'ppr') {
682     # Read interface.sh so we will know the correct exit codes and
683     # also signal.sh for the signal codes
684     my $deffound = 0; # Did we find one of the definition files
685     my @definitions;
686     for my $file (("lib/interface.sh", "lib/signal.sh")) {
687         
688         open FILE, "< $file" || do {
689             print $logh "error opening $file.\n";
690             next;
691         };
692         
693         $deffound = 1;
694         while(my $line = <FILE>) {
695             # Translate the shell script to Perl
696             if (($line !~ m/^\s*$/) && ($line !~ m/^\s*\#/)) {
697                 $line =~ s/^\s*([^\#\s]*)/\$$1;/;
698                 push (@definitions, $line);
699             }
700         }
701         close FILE;
702     }
703
704     if ($deffound) {
705         # Apply the definitions loaded from PPR
706         eval join('',@definitions) || do {
707             print $logh "unable to evaluate definitions\n";
708             rip_die ("Error in definitions evaluation",
709                      $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
710         };
711     }
712
713     # Check whether we run as a PPR interface (if not, we run as a PPR RIP)
714     if (($rargs[3] =~ /^\s*\d\d?\s*$/) &&
715         ($rargs[5] =~ /^\s*\d\d?\s*$/) &&
716         (($#rargs == 10) || ($#rargs == 9) || ($#rargs == 7))) {
717         # PPR calls interfaces with many command line parameters,
718         # where the forth and the sixth is a small integer
719         # number. In addition, we have 8 (PPR <= 1.31), 10
720         # (PPR>=1.32), 11 (PPR >= 1.50) command line parameters.
721         # We also check whether the current working directory is a
722         # PPR directory.
723         
724         # Get all command line parameters
725         $ppr_printer = removeshellescapes($rargs[0]);
726         $ppr_address = $rargs[1];
727         $ppr_options = removeshellescapes($rargs[2]);
728         $ppr_jobbreak = $rargs[3];
729         $ppr_feedback = $rargs[4];
730         $ppr_codes = $rargs[5];
731         $ppr_jobname = removeshellescapes($rargs[6]);
732         $ppr_routing = removeshellescapes($rargs[7]);
733         $ppr_for = $rargs[8];
734         $ppr_filetype = $rargs[9];
735         $ppr_filetoprint = removeshellescapes($rargs[10]);
736         
737         # Common job parameters
738         $printer = $ppr_printer;
739         $jobtitle = $ppr_jobname;
740         if ((!$jobtitle) && ($ppr_filetoprint)) {
741             $jobtitle = $ppr_filetoprint;
742         }
743         $optstr .= "$ppr_options $ppr_routing";
744         
745         # Get the path of the PPD file from the queue configuration
746         $ppdfile = `LANG=en_US; ppad show $ppr_printer | grep PPDFile`;
747         $ppdfile = removeshellescapes($ppdfile);
748         $ppdfile =~ s/PPDFile:\s+//;
749         if ($ppdfile !~ m!^/!) {
750             $ppdfile = "../../share/ppr/PPDFiles/$ppdfile";
751         }
752         chomp($ppdfile);
753         
754         # We have PPR and run as an interface
755         $spooler = 'ppr_int';
756     }
757 }
758
759 # CUPS
760 my( $cups_jobid, $cups_user, $cups_jobtitle, $cups_copies, $cups_options,
761     $cups_filename );
762 if ($spooler eq 'cups') {
763
764     # Use CUPS font path ("FontPath" in /etc/cups/cupsd.conf)
765     if ($ENV{'CUPS_FONTPATH'}) {
766         $ENV{'GS_LIB'} = $ENV{'CUPS_FONTPATH'} .
767             ($ENV{'GS_LIB'} ? ":$ENV{'GS_LIB'}" : "");
768     } else {
769         if ($ENV{'CUPS_DATADIR'}) {
770             $ENV{'GS_LIB'} = "$ENV{'CUPS_DATADIR'}/fonts" .
771                 ($ENV{'GS_LIB'} ? ":$ENV{'GS_LIB'}" : "");
772         }
773     }
774
775     # Get all command line parameters
776     $cups_jobid = removeshellescapes($rargs[0]);
777     $cups_user = removeshellescapes($rargs[1]);
778     $cups_jobtitle = removeshellescapes($rargs[2]);
779     $cups_copies = removeshellescapes($rargs[3]);
780     $cups_options = removeshellescapes($rargs[4]);
781     $cups_filename = removeshellescapes($rargs[5]);
782
783     # Common job parameters
784     #$printer = $cups_printer;
785     $jobid = $cups_jobid;
786     $jobtitle = $cups_jobtitle;
787     $jobuser = $cups_user;
788     $copies = $cups_copies;
789     $optstr .= $cups_options;
790
791     # Check for and handle inputfile vs stdin
792     if ((defined($cups_filename)) && ($cups_filename) &&
793         ($cups_filename ne '-')) {
794         # We get the input from a file
795         @filelist = ($cups_filename);
796         print $logh "Getting input from file $cups_filename\n";
797     }
798 }
799
800 # Solaris LP spooler
801 if ($spooler eq 'solaris') {
802     # Get all command line parameters
803     # $printer =                                    # argv[0]
804     #                                           ($rargs[0] =~ m!^.*/([^/]+)$!);
805     # $request_id = removeshellescapes($rargs[0]);  # argv[1]
806     # $user_name = removeshellescapes($rargs[1]);   # argv[2]
807     $jobtitle = removeshellescapes($rargs[2]);      # argv[3]
808     # $copies = removeshellescapes($rargs[3]);      # argv[4] # handled by the
809     #                                                           interface script
810     $optstr .= removeshellescapes($rargs[4]);       # argv[5]
811     ($#rargs > 4) &&                                # argv[6...]
812         (@filelist = @rargs[5, $#rargs]);
813 }
814
815 # LPD/LPRng/GNUlpr
816 if (($spooler eq 'lpd') ||
817     ($spooler eq 'lprng' and !$ppdfile) || 
818     ($spooler eq 'gnulpr')) {
819
820     # Get PPD file name as the last command line argument
821     $ppdfile = $rargs[$#rargs];
822
823 }
824
825
826 # No spooler, CPS, or PDQ
827 if (($spooler eq 'direct') || ($spooler eq 'cps') || ($spooler eq 'pdq')) {
828     # Which files do we want to print?
829     @filelist = map { removeshellescapes($_) } @rargs;
830 }
831
832
833
834 ## Additional spooler-specific preparations
835
836 # CUPS
837
838 if ($spooler eq 'cups') {
839
840     # This piece of PostScript code (initial idea 2001 by Michael
841     # Allerhand (michael.allerhand at ed dot ac dot uk, vastly
842     # improved by Till Kamppeter in 2002) lets GhostScript output
843     # the page accounting information which CUPS needs on standard
844     # error.
845     # Redesign by Helge Blischke (2004-11-17):
846     # - As the PostScript job itself may define BeginPage and/or EndPage
847     #   procedures, or the alternate pstops filter may have inserted
848     #   such procedures, we make sure that the accounting routine 
849     #   will safely coexist with those. To achieve this, we force
850     #   - the accountint stuff to be inserted at the very end of the
851     #     PostScript job's setup section,
852     #   - the accounting stuff just using the return value of the 
853     #     existing EndPage procedure, if any (and providing a default one
854     #     if not).
855     # - As PostScript jobs may contain calls to setpagedevice "between"
856     #   pages, e.g. to change media type, do in-job stapling, etc.,
857     #   we cannot rely on the "showpage count since last pagedevice
858     #   activation" but instead count the physical pages by ourselves
859     #   (in a global dictionary).
860
861     if (defined $conf{ps_accounting}) {
862         $ps_accounting = $conf{ps_accounting};
863     }
864     $accounting_prolog = $ps_accounting ? "[{
865 %% Code for writing CUPS accounting tags on standard error
866
867 /cupsPSLevel2 % Determine whether we can do PostScript level 2 or newer
868     systemdict/languagelevel 2 copy
869     known{get exec}{pop pop 1}ifelse 2 ge
870 def
871
872 cupsPSLevel2
873 {                                       % in case of level 2 or higher
874         currentglobal true setglobal    % define a dictioary foomaticDict
875         globaldict begin                % in global VM and establish a
876         /foomaticDict                   % pages count key there
877         <<
878                 /PhysPages 0
879         >>def
880         end
881         setglobal
882 }if
883
884 /cupsGetNumCopies { % Read the number of Copies requested for the current
885                     % page
886     cupsPSLevel2
887     {
888         % PS Level 2+: Get number of copies from Page Device dictionary
889         currentpagedevice /NumCopies get
890     }
891     {
892         % PS Level 1: Number of copies not in Page Device dictionary
893         null
894     }
895     ifelse
896     % Check whether the number is defined, if it is \"null\" use #copies 
897     % instead
898     dup null eq {
899         pop #copies
900     }
901     if
902     % Check whether the number is defined now, if it is still \"null\" use 1
903     % instead
904     dup null eq {
905         pop 1
906     } if
907 } bind def
908
909 /cupsWrite { % write a string onto standard error
910     (%stderr) (w) file
911     exch writestring
912 } bind def
913
914 /cupsFlush      % flush standard error to make it sort of unbuffered
915 {
916         (%stderr)(w)file flushfile
917 }bind def
918
919 cupsPSLevel2
920 {                               % In language level 2, we try to do something reasonable
921   <<
922     /EndPage
923     [                                   % start the array that becomes the procedure
924       currentpagedevice/EndPage 2 copy known
925       {get}                                     % get the existing EndPage procedure
926       {pop pop {exch pop 2 ne}bind}ifelse       % there is none, define the default
927       /exec load                                % make sure it will be executed, whatever it is
928       /dup load                                 % duplicate the result value
929       {                                 % true: a sheet gets printed, do accounting
930         currentglobal true setglobal            % switch to global VM ...
931         foomaticDict begin                      % ... and access our special dictionary
932         PhysPages 1 add                 % count the sheets printed (including this one)
933         dup /PhysPages exch def         % and save the value
934         end                                     % leave our dict
935         exch setglobal                          % return to previous VM
936         (PAGE: )cupsWrite                       % assemble and print the accounting string ...
937         16 string cvs cupsWrite                 % ... the sheet count ...
938         ( )cupsWrite                            % ... a space ...
939         cupsGetNumCopies                        % ... the number of copies ...
940         16 string cvs cupsWrite                 % ...
941         (\\n)cupsWrite                          % ... a newline
942         cupsFlush
943       }/if load
944                                         % false: current page gets discarded; do nothing        
945     ]cvx bind                           % make the array executable and apply bind
946   >>setpagedevice
947 }
948 {
949     % In language level 1, we do no accounting currently, as there is no global VM
950     % the contents of which are undesturbed by save and restore. 
951     % If we may be sure that showpage never gets called inside a page related save / restore pair
952     % we might implement an hack with showpage similar to the one above.
953 }ifelse
954
955 } stopped cleartomark
956 " : "";
957
958     # On which queue are we printing?
959     # CUPS gives the PPD file the same name as the printer queue,
960     # so we can get the queue name from the name of the PPD file.
961     $ppdfile =~ m!^(.*/)([^/]+)\.ppd$!;
962     $printer = $2;
963 }
964
965 # No spooler, CPS, or PDQ
966
967 if (($spooler eq 'direct') || ($spooler eq 'cps') || ($spooler eq 'pdq')) {
968
969     # Path for personal Foomatic configuration
970     my $user_default_path = "$ENV{'HOME'}/.foomatic";
971
972     if (!$ppdfile) {
973         if (!$printer) {
974             # No printer definition file selected, check whether we have a
975             # default printer defined.
976             for my $conf_file (("./.directconfig",
977                                 "./directconfig",
978                                 "./.config",
979                                 "$user_default_path/direct/.config",
980                                 "$user_default_path/direct.conf",
981                                 "$configpath/direct/.config",
982                                 "$configpath/direct.conf")) {
983                 if (open CONFIG, "< $conf_file") {
984                     while (my $line = <CONFIG>) {
985                         chomp $line;
986                         if ($line =~ /^default\s*:\s*([^:\s]+)\s*$/) {
987                             $printer = $1;
988                             last;
989                         }
990                     }
991                     close CONFIG;
992                 }
993                 if ($printer) {
994                     last;
995                 }
996             }
997         }
998
999         # Neither in a config file nor on the command line a printer was
1000         # selected.
1001         if (!$printer) {
1002             rip_die("No printer definition (option \"-P <name>\") " .
1003                     "specified!", $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
1004         }
1005         
1006         # Search for the PPD file
1007         
1008         # Search also common spooler-specific locations, this way a printer
1009         # configured under a certain spooler can also be used without
1010         # spooler
1011
1012         if (-r $printer) {
1013             $ppdfile = $printer;
1014         # CPS can have the PPD in the spool directory
1015         } elsif (($spooler eq 'cps') &&
1016                  (-r "/var/spool/lpd/${printer}/${printer}.ppd")) {
1017             $ppdfile = "/var/spool/lpd/${printer}/${printer}.ppd";
1018         } elsif (($spooler eq 'cps') &&
1019                  (-r "/var/local/spool/lpd/${printer}/${printer}.ppd")) {
1020             $ppdfile = "/var/local/spool/lpd/${printer}/${printer}.ppd";
1021         } elsif (($spooler eq 'cps') &&
1022                  (-r "/var/local/lpd/${printer}/${printer}.ppd")) {
1023             $ppdfile = "/var/local/lpd/${printer}/${printer}.ppd";
1024         } elsif (($spooler eq 'cps') &&
1025                  (-r "/var/spool/lpd/${printer}.ppd")) {
1026             $ppdfile = "/var/spool/lpd/${printer}.ppd";
1027         } elsif (($spooler eq 'cps') &&
1028                  (-r "/var/local/spool/lpd/${printer}.ppd")) {
1029             $ppdfile = "/var/local/spool/lpd/${printer}.ppd";
1030         } elsif (($spooler eq 'cps') &&
1031                  (-r "/var/local/lpd/${printer}.ppd")) {
1032             $ppdfile = "/var/local/lpd/${printer}.ppd";
1033         } elsif (-r "${printer}.ppd") { # current dir
1034             $ppdfile = "${printer}.ppd";
1035         } elsif (-r "$user_default_path/${printer}.ppd") { # user dir
1036             $ppdfile = "$user_default_path/${printer}.ppd";
1037         } elsif (-r "$configpath/direct/${printer}.ppd") { # system dir
1038             $ppdfile = "$configpath/direct/${printer}.ppd";
1039         } elsif (-r "$configpath/${printer}.ppd") { # system dir
1040             $ppdfile = "$configpath/${printer}.ppd";
1041         } elsif (-r "/etc/cups/ppd/${printer}.ppd") { # CUPS config dir
1042             $ppdfile = "/etc/cups/ppd/${printer}.ppd";
1043         } elsif (-r "/usr/local/etc/cups/ppd/${printer}.ppd") {
1044             $ppdfile = "/usr/local/etc/cups/ppd/${printer}.ppd";
1045         } elsif (-r "/usr/share/ppr/PPDFiles/${printer}.ppd") { # PPR PPDs
1046             $ppdfile = "/usr/share/ppr/PPDFiles/${printer}.ppd";
1047         } elsif (-r "/usr/local/share/ppr/PPDFiles/${printer}.ppd") {
1048             $ppdfile = "/usr/local/share/ppr/PPDFiles/${printer}.ppd";
1049         } else {
1050             rip_die ("There is no readable PPD file for the printer " .
1051                      "$printer, is it configured?",
1052                      $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
1053         }
1054     }
1055 }
1056
1057
1058
1059 ## Files to be printed (can be more than one for spooler-less printing)
1060
1061 # Empty file list -> print STDIN
1062 if ($#filelist < 0) {
1063     @filelist = ("<STDIN>");
1064 }
1065
1066 # Check file list
1067 my $file;
1068 my $filecnt = 0;
1069 for $file (@filelist) {
1070     if ($file ne "<STDIN>") {
1071         if ($file =~ /^-/) {
1072             rip_die ("Invalid argument: $file",
1073                      $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
1074         } elsif (! -r $file) {
1075             print $logh "File $file does not exist/is not readable\n";
1076             splice(@filelist, $filecnt, 1);
1077             $filecnt --;
1078         }
1079     }
1080     $filecnt ++;
1081 }
1082
1083
1084
1085 ## When we print without spooler or with CPS do not log onto STDERR unless 
1086 ## the "-v" ('Verbose') is set or the debug mode is used
1087 if ((($spooler eq 'direct') || ($spooler eq 'cps') || ($genpdqfile)) && 
1088     (!$verbose) && (!$debug)) {
1089     close $logh;
1090     open LOG, "> /dev/null";
1091     $logh = *LOG;
1092
1093     use IO::Handle;
1094     $logh->autoflush(1);
1095 }
1096
1097
1098
1099 ## Start logging
1100 if (!$debug) {
1101     # If we are in debug mode, we do this earlier.
1102     print $logh "foomatic-rip version $ripversion running...\n";
1103     # Print the command line only in debug mode, Mac OS X adds very many
1104     # options so that CUPS cannot handle the output of the command line
1105     # in its log files. If CUPS encounters a line with more than 1024
1106     # characters sent into its log files, it aborts the job with an error.
1107     if (($debug) || ($spooler ne 'cups')) {
1108         print $logh "called with arguments: '", join("', '",@ARGV), "'\n";
1109     }
1110 }
1111
1112
1113
1114 ## PPD file
1115
1116 # Load the PPD file and build a data structure for the renderer's
1117 # command line and the options
1118 open PPD, "< $ppdfile" || do {
1119     print $logh "error opening $ppdfile.\n";
1120     rip_die ("Unable to open PPD file $ppdfile",
1121              $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
1122 };
1123
1124 print $logh "Parsing PPD file ...\n";
1125
1126 my $dat = {};              # data structure for the options
1127 my $currentargument = "";  # We are currently reading this argument
1128
1129 # If we have an old Foomatic 2.0.x PPD file, read its built-in Perl
1130 # data structure into @datablob and the default values in %ppddefaults
1131 # Then delete the $dat structure, replace it by the one "eval"ed from
1132 # @datablob, and correct the default settings according to the ones of
1133 # the main PPD structure
1134 my @datablob;
1135 my $jclprefixset = 0;
1136
1137 # Parse the PPD file
1138 sub undossify( $ );
1139 while(<PPD>) {
1140     # foomatic-rip should also work with PPD file downloaded under Windows.
1141     $_ = undossify($_);
1142     # Parse keywords
1143     if (m!^\*NickName:\s*\"(.*)$!) {
1144         # "*NickName: <code>"
1145         my $line = $1;
1146         # Store the value
1147         # Code string can have multiple lines, read all of them
1148         my $cmd = "";
1149         while ($line !~ m!\"!) {
1150             if ($line =~ m!&&$!) {
1151                 # line continues in next line
1152                 $cmd .= substr($line, 0, -2);
1153             } else {
1154                 # line ends here
1155                 $cmd .= "$line\n";
1156             }
1157             # Read next line
1158             $line = <PPD>;
1159             chomp $line;
1160         }
1161         $line =~ m!^([^\"]*)\"!;
1162         $cmd .= $1;
1163         $model = unhtmlify($cmd);
1164     } elsif (m!^\*FoomaticIDs:\s*\"?\s*(\S+?)\s+(\S+?)\s*\"?\s*$!) {
1165         # "*FoomaticIDs: <printer ID> <driver ID>"
1166         my $id = $1;
1167         my $driver = $2;
1168         # Store the values
1169         $dat->{'id'} = $id;
1170         $dat->{'driver'} = $driver;
1171     } elsif (m!^\*FoomaticRIPPostPipe:\s*\"(.*)$!) {
1172         # "*FoomaticRIPPostPipe: <code>"
1173         my $line = $1;
1174         # Store the value
1175         # Code string can have multiple lines, read all of them
1176         my $cmd = "";
1177         while ($line !~ m!\"!) {
1178             if ($line =~ m!&&$!) {
1179                 # line continues in next line
1180                 $cmd .= substr($line, 0, -2);
1181             } else {
1182                 # line ends here
1183                 $cmd .= "$line\n";
1184             }
1185             # Read next line
1186             $line = <PPD>;
1187             chomp $line;
1188         }
1189         $line =~ m!^([^\"]*)\"!;
1190         $cmd .= $1;
1191         $postpipe = unhtmlify($cmd);
1192     } elsif (m!^\*FoomaticRIPCommandLine:\s*\"(.*)$!) {
1193         # "*FoomaticRIPCommandLine: <code>"
1194         my $line = $1;
1195         # Store the value
1196         # Code string can have multiple lines, read all of them
1197         my $cmd = "";
1198         while ($line !~ m!\"!) {
1199             if ($line =~ m!&&$!) {
1200                 # line continues in next line
1201                 $cmd .= substr($line, 0, -2);
1202             } else {
1203                 # line ends here
1204                 $cmd .= "$line\n";
1205             }
1206             # Read next line
1207             $line = <PPD>;
1208             chomp $line;
1209         }
1210         $line =~ m!^([^\"]*)\"!;
1211         $cmd .= $1;
1212         $dat->{'cmd'} = unhtmlify($cmd);
1213     } elsif (m!^\*FoomaticNoPageAccounting:\s*\"?\s*(\S+?)\s*\"?\s*$!) {
1214         # "*FoomaticRIPNoPageAccounting: <boolean value>"
1215         my $value = $1;
1216         # Apply the value
1217         if ($value =~ /^True$/i) {
1218             # Driver is not compatible with page accounting according to the
1219             # Foomatic database, so turn it off for this driver
1220             $ps_accounting = 0;
1221             $accounting_prolog = '';
1222             print $logh "CUPS page accounting disabled by driver.\n";
1223         }
1224     } elsif (m!^\*cupsFilter:\s*\"(.*)$!) {
1225         # "*cupsFilter: <code>"
1226         my $line = $1;
1227         # Store the value
1228         # Code string can have multiple lines, read all of them
1229         my $cmd = "";
1230         while ($line !~ m!\"!) {
1231             if ($line =~ m!&&$!) {
1232                 # line continues in next line
1233                 $cmd .= substr($line, 0, -2);
1234             } else {
1235                 # line ends here
1236                 $cmd .= "$line\n";
1237             }
1238             # Read next line
1239             $line = <PPD>;
1240             chomp $line;
1241         }
1242         $line =~ m!^([^\"]*)\"!;
1243         $cmd .= $1;
1244         my $cupsfilterline = unhtmlify($cmd);
1245         if ($cupsfilterline =~ /^\s*(\S+)\s+\d+\s+(\S+)\s*$/) {
1246             print $logh "*cupsFilter: \"$cupsfilterline\"\n"; 
1247             # Make a hash by mime type for all CUPS filters set in this PPD
1248             $dat->{'cupsfilter'}{$1} = $2;
1249         }
1250     } elsif (m!^\*CustomPageSize\s+True:\s*\"(.*)$!) {
1251         # "*CustomPageSize True: <code>"
1252         my $setting = "Custom";
1253         my $translation = "Custom Size";
1254         my $line = $1;
1255         # Make sure that the argument is in the data structure
1256         checkarg ($dat, "PageSize");
1257         checkarg ($dat, "PageRegion");
1258         # Make sure that the setting is in the data structure
1259         checksetting ($dat, "PageSize", $setting);
1260         checksetting ($dat, "PageRegion", $setting);
1261         $dat->{'args_byname'}{'PageSize'}{'vals_byname'}{$setting}{'comment'} = $translation;
1262         $dat->{'args_byname'}{'PageRegion'}{'vals_byname'}{$setting}{'comment'} = $translation;
1263         # Store the value
1264         # Code string can have multiple lines, read all of them
1265         my $code = "";
1266         while ($line !~ m!\"!) {
1267             if ($line =~ m!&&$!) {
1268                 # line continues in next line
1269                 $code .= substr($line, 0, -2);
1270             } else {
1271                 # line ends here
1272                 $code .= "$line\n";
1273             }
1274             # Read next line
1275             $line = <PPD>;
1276             chomp $line;
1277         }
1278         $line =~ m!^([^\"]*)\"!;
1279         $code .= $1;
1280         if ($code !~ m!^%% FoomaticRIPOptionSetting!m) {
1281             $dat->{'args_byname'}{'PageSize'}{'vals_byname'}{$setting}{'driverval'} = $code;
1282             $dat->{'args_byname'}{'PageRegion'}{'vals_byname'}{$setting}{'driverval'} = $code;
1283         }
1284     } elsif (m!^\*(JCL|)OpenUI\s+\*([^:]+):\s*(\S+)\s*$!) {
1285         # "*[JCL]OpenUI *<option>[/<translation>]: <type>"
1286         my $argnametrans = $2;
1287         my $argtype = $3;
1288         my $argname;
1289         my $translation = "";
1290         if ($argnametrans =~ m!^([^:/\s]+)/([^:]*)$!) {
1291             $argname = $1;
1292             $translation = $2;
1293         } else {
1294             $argname = $argnametrans;
1295         }
1296         # Make sure that the argument is in the data structure
1297         checkarg ($dat, $argname);
1298         # Store the values
1299         $dat->{'args_byname'}{$argname}{'comment'} = $translation;
1300         # Set the argument type only if not defined yet, a
1301         # definition in "*FoomaticRIPOption" has priority
1302         if ( !($dat->{'args_byname'}{$argname}{'type'}) ) {
1303             if ($argtype eq "PickOne") {
1304                 $dat->{'args_byname'}{$argname}{'type'} = 'enum';
1305             } elsif ($argtype eq "PickMany") {
1306                 $dat->{'args_byname'}{$argname}{'type'} = 'pickmany';
1307             } elsif ($argtype eq "Boolean") {
1308                 $dat->{'args_byname'}{$argname}{'type'} = 'bool';
1309             }
1310         }
1311         # Mark in which argument we are currently, so that we can find
1312         # the entries for the choices
1313         $currentargument = $argname;
1314     } elsif (m!^\*(JCL|)CloseUI:\s+\*([^:/\s]+)\s*$!) {
1315         # "*[JCL]CloseUI *<option>"
1316         my $argname = $2;
1317         # Unmark the current argument to do not mis-interpret any keywords
1318         # as choices
1319         $currentargument = "";
1320     } elsif ((m!^\*FoomaticRIPOption ([^/:\s]+):\s*\"?\s*(\S+?)\s+(\S+)\s+(\S)\s*\"?\s*$!) ||
1321              (m!^\*FoomaticRIPOption ([^/:\s]+):\s*\"?\s*(\S+?)\s+(\S+)\s+(\S)\s+(\S+?)\s*\"?\s*$!)){
1322         # "*FoomaticRIPOption <option>: <type> <style> <spot> [<order>]"
1323         # <order> only used for 1-choice enum options
1324         my $argname = $1;
1325         my $argtype = $2;
1326         my $argstyle = $3;
1327         my $spot = $4;
1328         my $order = $5;
1329         # Make sure that the argument is in the data structure
1330         checkarg ($dat, $argname);
1331         # Store the values
1332         $dat->{'args_byname'}{$argname}{'type'} = $argtype;
1333         if ($argstyle eq "PS") {
1334             $dat->{'args_byname'}{$argname}{'style'} = 'G';
1335         } elsif ($argstyle eq "CmdLine") {
1336             $dat->{'args_byname'}{$argname}{'style'} = 'C';
1337         } elsif ($argstyle eq "JCL") {
1338             $dat->{'args_byname'}{$argname}{'style'} = 'J';
1339             $dat->{'jcl'} = 1;
1340         } elsif ($argstyle eq "Composite") {
1341             $dat->{'args_byname'}{$argname}{'style'} = 'X';
1342         }
1343         $dat->{'args_byname'}{$argname}{'spot'} = $spot;
1344         # $order only defined here for 1-choice enum options
1345         if ($order) {
1346             $dat->{'args_byname'}{$argname}{'order'} = $order;
1347         }
1348     } elsif (m!^\*FoomaticRIPOptionPrototype\s+([^/:\s]+):\s*\"(.*)$!) {
1349         # "*FoomaticRIPOptionPrototype <option>: <code>"
1350         # Used for numerical and string options only
1351         my $argname = $1;
1352         my $line = $2;
1353         # Make sure that the argument is in the data structure
1354         checkarg ($dat, $argname);
1355         # Store the value
1356         # Code string can have multiple lines, read all of them
1357         my $proto = "";
1358         while ($line !~ m!\"!) {
1359             if ($line =~ m!&&$!) {
1360                 # line continues in next line
1361                 $proto .= substr($line, 0, -2);
1362             } else {
1363                 # line ends here
1364                 $proto .= "$line\n";
1365             }
1366             # Read next line
1367             $line = <PPD>;
1368             chomp $line;
1369         }
1370         $line =~ m!^([^\"]*)\"!;
1371         $proto .= $1;
1372         $dat->{'args_byname'}{$argname}{'proto'} = unhtmlify($proto);
1373     } elsif (m!^\*FoomaticRIPOptionRange\s+([^/:\s]+):\s*\"?\s*(\S+?)\s+(\S+?)\s*\"?\s*$!) {
1374         # "*FoomaticRIPOptionRange <option>: <min> <max>"
1375         # Used for numerical options only
1376         my $argname = $1;
1377         my $min = $2;
1378         my $max = $3;
1379         # Make sure that the argument is in the data structure
1380         checkarg ($dat, $argname);
1381         # Store the values
1382         $dat->{'args_byname'}{$argname}{'min'} = $min;
1383         $dat->{'args_byname'}{$argname}{'max'} = $max;
1384     } elsif (m!^\*FoomaticRIPOptionMaxLength\s+([^/:\s]+):\s*\"?\s*(\S+?)\s*\"?\s*$!) {
1385         # "*FoomaticRIPOptionMaxLength <option>: <length>"
1386         # Used for string options only
1387         my $argname = $1;
1388         my $maxlength = $2;
1389         # Make sure that the argument is in the data structure
1390         checkarg ($dat, $argname);
1391         # Store the value
1392         $dat->{'args_byname'}{$argname}{'maxlength'} = $maxlength;
1393     } elsif (m!^\*FoomaticRIPOptionAllowedChars\s+([^/:\s]+):\s*\"(.*)$!) {
1394         # "*FoomaticRIPOptionAllowedChars <option>: <code>"
1395         # Used for string options only
1396         my $argname = $1;
1397         my $line = $2;
1398         # Store the value
1399         # Code string can have multiple lines, read all of them
1400         my $code = "";
1401         while ($line !~ m!\"!) {
1402             if ($line =~ m!&&$!) {
1403                 # line continues in next line
1404                 $code .= substr($line, 0, -2);
1405             } else {
1406                 # line ends here
1407                 $code .= "$line\n";
1408             }
1409             # Read next line
1410             $line = <PPD>;
1411             chomp $line;
1412         }
1413         $line =~ m!^([^\"]*)\"!;
1414         $code .= $1;
1415         # Make sure that the argument is in the data structure
1416         checkarg ($dat, $argname);
1417         # Store the value
1418         $dat->{'args_byname'}{$argname}{'allowedchars'} = unhtmlify($code);
1419     } elsif (m!^\*FoomaticRIPOptionAllowedRegExp\s+([^/:\s]+):\s*\"(.*)$!) {
1420         # "*FoomaticRIPOptionAllowedRegExp <option>: <code>"
1421         # Used for string options only
1422         my $argname = $1;
1423         my $line = $2;
1424         # Store the value
1425         # Code string can have multiple lines, read all of them
1426         my $code = "";
1427         while ($line !~ m!\"!) {
1428             if ($line =~ m!&&$!) {
1429                 # line continues in next line
1430                 $code .= substr($line, 0, -2);
1431             } else {
1432                 # line ends here
1433                 $code .= "$line\n";
1434             }
1435             # Read next line
1436             $line = <PPD>;
1437             chomp $line;
1438         }
1439         $line =~ m!^([^\"]*)\"!;
1440         $code .= $1;
1441         # Make sure that the argument is in the data structure
1442         checkarg ($dat, $argname);
1443         # Store the value
1444         $dat->{'args_byname'}{$argname}{'allowedregexp'} =
1445             unhtmlify($code);
1446     } elsif (m!^\*OrderDependency:\s*(\S+)\s+(\S+)\s+\*([^:/\s]+)\s*$!) {
1447         # "*OrderDependency: <order> <section> *<option>"
1448         my $order = $1;
1449         my $section = $2;
1450         my $argname = $3;
1451         # Make sure that the argument is in the data structure
1452         checkarg ($dat, $argname);
1453         # Store the values
1454         $dat->{'args_byname'}{$argname}{'order'} = $order;
1455         $dat->{'args_byname'}{$argname}{'section'} = $section;
1456     } elsif (m!^\*Default([^/:\s]+):\s*([^/:\s]+)\s*$!) {
1457         # "*Default<option>: <value>"
1458         my $argname = $1;
1459         my $default = $2;
1460         # Make sure that the argument is in the data structure
1461         checkarg ($dat, $argname);
1462         # Store the value
1463         $dat->{'args_byname'}{$argname}{'default'} = $default;
1464     } elsif (m!^\*FoomaticRIPDefault([^/:\s]+):\s*\"?\s*([^/:\s]+?)\s*\"?\s*$!) {
1465         # "*FoomaticRIPDefault<option>: <value>"
1466         # Used for numerical options only
1467         my $argname = $1;
1468         my $default = $2;
1469         # Make sure that the argument is in the data structure
1470         checkarg ($dat, $argname);
1471         # Store the value
1472         $dat->{'args_byname'}{$argname}{'fdefault'} = $default;
1473     } elsif (m!^\*$currentargument\s+([^:]+):\s*\"(.*)$!) {
1474         # "*<option> <choice>[/<translation>]: <code>"
1475         my $settingtrans = $1;
1476         my $line = $2;
1477         my $translation = "";
1478         my $setting = "";
1479         if ($settingtrans =~ m!^([^:/\s]+)/([^:]*)$!) {
1480             $setting = $1;
1481             $translation = $2;
1482         } else {
1483             $setting = $settingtrans;
1484         }
1485         # Make sure that the argument is in the data structure
1486         checkarg ($dat, $currentargument);
1487         # Make sure that the setting is in the data structure (enum options)
1488         my $bool =
1489             ($dat->{'args_byname'}{$currentargument}{'type'} eq 'bool');
1490         if ($bool) {
1491             if (lc($setting) eq "true") {
1492                 if (!$dat->{'args_byname'}{$currentargument}{'comment'}) {
1493                     $dat->{'args_byname'}{$currentargument}{'comment'} =
1494                         $translation;
1495                 }
1496                 $dat->{'args_byname'}{$currentargument}{'comment_true'} =
1497                     $translation;
1498             } else {
1499                 $dat->{'args_byname'}{$currentargument}{'comment_false'} =
1500                     $translation;
1501             }
1502         } else {
1503             checksetting ($dat, $currentargument, $setting);
1504             # Make sure that this argument has a default setting, even if 
1505             # none is defined in this PPD file
1506             if (!defined ($dat->{'args_byname'}{$currentargument}{'default'})) {
1507                 $dat->{'args_byname'}{$currentargument}{'default'} = $setting;
1508             }
1509             $dat->{'args_byname'}{$currentargument}{'vals_byname'}{$setting}{'comment'} = $translation;
1510         }
1511         # Store the value
1512         # Code string can have multiple lines, read all of them
1513         my $code = "";
1514         while ($line !~ m!\"!) {
1515             if ($line =~ m!&&$!) {
1516                 # line continues in next line
1517                 $code .= substr($line, 0, -2);
1518             } else {
1519                 # line ends here
1520                 $code .= "$line\n";
1521             }
1522             # Read next line
1523             $line = <PPD>;
1524             chomp $line;
1525         }
1526         $line =~ m!^([^\"]*)\"!;
1527         $code .= $1;
1528         if ($code !~ m!^%% FoomaticRIPOptionSetting!) {
1529             if ($bool) {
1530                 if (lc($setting) eq "true") {
1531                     $dat->{'args_byname'}{$currentargument}{'proto'} = $code;
1532                 } else {
1533                     $dat->{'args_byname'}{$currentargument}{'protof'} = $code;
1534                 }
1535             } else {
1536                 $dat->{'args_byname'}{$currentargument}{'vals_byname'}{$setting}{'driverval'} = $code;
1537             }
1538         }
1539     } elsif ((m!^\*FoomaticRIPOptionSetting\s+([^/:=\s]+)=([^/:=\s]+):\s*\"(.*)$!) ||
1540              (m!^\*FoomaticRIPOptionSetting\s+([^/:=\s]+):\s*\"(.*)$!)) {
1541         # "*FoomaticRIPOptionSetting <option>[=<choice>]: <code>"
1542         # For boolean options <choice> is not given
1543         my $argname = $1;
1544         my $setting = $2;
1545         my $line = $3;
1546         my $bool = 0;
1547         if (!$line) {
1548             $line = $setting;
1549             $bool = 1;
1550         }
1551         # Make sure that the argument is in the data structure
1552         checkarg ($dat, $argname);
1553         # Make sure that the setting is in the data structure (enum options)
1554         if (!$bool) {
1555             checksetting ($dat, $argname, $setting);
1556             # Make sure that this argument has a default setting, even if 
1557             # none is defined in this PPD file
1558             if (!defined ($dat->{'args_byname'}{$argname}{'default'})) {
1559                 $dat->{'args_byname'}{$argname}{'default'} = $setting;
1560             }
1561         }
1562         # Store the value
1563         # Code string can have multiple lines, read all of them
1564         my $code = "";
1565         while ($line !~ m!\"!) {
1566             if ($line =~ m!&&$!) {
1567                 # line continues in next line
1568                 $code .= substr($line, 0, -2);
1569             } else {
1570                 # line ends here
1571                 $code .= "$line\n";
1572             }
1573             # Read next line
1574             $line = <PPD>;
1575             chomp $line;
1576         }
1577         $line =~ m!^([^\"]*)\"!;
1578         $code .= $1;
1579         if ($bool) {
1580             $dat->{'args_byname'}{$argname}{'proto'} = unhtmlify($code);
1581         } else {
1582             $dat->{'args_byname'}{$argname}{'vals_byname'}{$setting}{'driverval'} = unhtmlify($code);
1583         }
1584     } elsif (m!^\*(Foomatic|)JCL(Begin|ToPSInterpreter|End|Prefix):\s*\"(.*)$!) {
1585         # "*(Foomatic|)JCL(Begin|ToPSInterpreter|End|Prefix): <code>"
1586         # The printer supports PJL/JCL when there is such a line 
1587         $dat->{'jcl'} = 1;
1588         my $item = $2;
1589         my $line = $3;
1590         # Store the value
1591         # Code string can have multiple lines, read all of them
1592         my $code = "";
1593         while ($line !~ m!\"!) {
1594             if ($line =~ m!&&$!) {
1595                 # line continues in next line
1596                 $code .= substr($line, 0, -2);
1597             } else {
1598                 # line ends here
1599                 $code .= "$line\n";
1600             }
1601             # Read next line
1602             $line = <PPD>;
1603             chomp $line;
1604         }
1605         $line =~ m!^([^\"]*)\"!;
1606         $code .= $1;
1607         if ($item eq 'Begin') {
1608             $jclbegin = unhexify($code);
1609             $jclprefix = "" if (!$jclprefixset) && ($jclbegin !~ /PJL/s);
1610         } elsif ($item eq 'ToPSInterpreter') {
1611             $jcltointerpreter = unhexify($code);
1612         } elsif ($item eq 'End') {
1613             $jclend = unhexify($code);
1614         } elsif ($item eq 'Prefix') {
1615             $jclprefix = unhexify($code);
1616             $jclprefixset = 1;
1617         }
1618     } elsif (m!^\*\% COMDATA \#(.*)$!) {
1619         # If we have an old Foomatic 2.0.x PPD file, collect its Perl data
1620         push (@datablob, $1);
1621     }
1622 }
1623 close PPD;
1624
1625 # If we have an old Foomatic 2.0.x PPD file use its Perl data structure
1626 if ($#datablob >= 0) {
1627     print $logh "${added_lf}You are using an old Foomatic 2.0 PPD file, consider " .
1628         "upgrading.${added_lf}\n";
1629     my $VAR1;
1630     if (eval join('',@datablob)) {
1631         # Overtake default settings from the main structure of the PPD file
1632         for my $arg (@{$dat->{'args'}}) {
1633             if ($arg->{'default'}) {
1634                 $VAR1->{'argsbyname'}{$arg->{'name'}}{'default'} = 
1635                     $arg->{'default'};
1636             }
1637         }
1638         undef $dat;
1639         $dat = $VAR1;
1640         $dat->{'jcl'} = $dat->{'pjl'};
1641     } else {
1642         # Perl structure broken
1643         print $logh "${added_lf}Unable to evaluate datablob, print job may come " .
1644             "out incorrectly or not at all.${added_lf}\n";
1645     }
1646 }
1647
1648
1649
1650 ## We do not need to parse the PostScript job when we don't have
1651 ## any options. If we have options, we must check whether the
1652 ## default settings from the PPD file are valid and correct them
1653 ## if nexessary.
1654
1655 my $dontparse = 0;
1656 if ((!defined(@{$dat->{'args'}})) ||
1657     ($#{$dat->{'args'}} < 0)) {
1658     # We don't have any options, so we do not need to parse the
1659     # PostScript data
1660     $dontparse = 1;
1661 } else {
1662     # Let the default value of a boolean option being 0 or 1 instead of
1663     # "True" or "False", range-check the defaults of all options and
1664     # issue warnings if the values are not valid
1665     checkoptions($dat, 'default');
1666
1667     # Adobe's PPD specs do not support numerical
1668     # options. Therefore the numerical options are mapped to
1669     # enumerated options in the PPD file and their characteristics
1670     # as a numerical option are stored in "*Foomatic..."
1671     # keywords. A default must be between the enumerated
1672     # fixed values. The default
1673     # value must be given by a "*FoomaticRIPDefault<option>:
1674     # <value>" line in the PPD file. But this value is only valid
1675     # if the "official" default given by a "*Default<option>:
1676     # <value>" line (it must be one of the enumerated values)
1677     # points to the enumerated value which is closest to this
1678     # value. This way a user can select a default value with a
1679     # tool only supporting PPD files but not Foomatic extensions.
1680     # This tool only modifies the "*Default<option>: <value>" line
1681     # and if the "*FoomaticRIPDefault<option>: <value>" had always
1682     # priority, the user's change in "*Default<option>: <value>"
1683     # would have no effect.
1684
1685     for my $arg (@{$dat->{'args'}}) {
1686         if ($arg->{'fdefault'}) {
1687             if ($arg->{'default'}) {
1688                 if ($arg->{'type'} =~ /^(int|float)$/) {
1689                     if ($arg->{'fdefault'} < $arg->{'min'}) {
1690                         $arg->{'fdefault'} = $arg->{'min'};
1691                     }
1692                     if ($arg->{'fdefault'} > $arg->{'max'}) {
1693                         $arg->{'fdefault'} = $arg->{'max'};
1694                     }
1695                     if ($arg->{'type'} eq 'int') {
1696                         $arg->{'fdefault'} = POSIX::floor($arg->{'fdefault'});
1697                     }
1698                     my $mindiff = abs($arg->{'max'} - $arg->{'min'});
1699                     my $closestvalue;
1700                     for my $val (@{$arg->{'vals'}}) {
1701                         if (abs($arg->{'fdefault'} - $val->{'value'}) <
1702                             $mindiff) {
1703                             $mindiff = 
1704                                 abs($arg->{'fdefault'} - $val->{'value'});
1705                             $closestvalue = $val->{'value'};
1706                         }
1707                     }
1708                     if (($arg->{'default'} == $closestvalue) ||
1709                         (abs($arg->{'default'} - $closestvalue) /
1710                          $closestvalue < 0.001)) {
1711                         $arg->{'default'} = $arg->{'fdefault'};
1712                     }
1713                 }
1714             } else {
1715                 $arg->{'default'} = $arg->{'fdefault'};
1716             }
1717         }
1718     }
1719 }
1720
1721 # Is our PPD for a CUPS raster driver
1722 if (my $cupsfilter = $dat->{'cupsfilter'}{"application/vnd.cups-raster"}) {
1723
1724     # Search filter in cupsfilterpath
1725     # The %Y is a placeholder for the option settings
1726     my $havefilter = 0;
1727     for (split(':', $cupsfilterpath)) {
1728         if (-x "$_/$cupsfilter") {
1729             $havefilter=1;
1730             $cupsfilter = "$_/$cupsfilter 0 '' '' 0 '%Y%X'";
1731             last;
1732         }
1733     }
1734
1735     if (!$havefilter) {
1736
1737         # We do not have the required filter, so we assume that
1738         # rendering this job is supposed to be done on a remote
1739         # server. So we do not define a renderer command line and
1740         # embed only the option settings (as we had a PostScript
1741         # printer). This way the settings are # taken into account
1742         # when the job is rendered on the server.
1743         print $logh "${added_lf}CUPS filter for this PPD file not found " .
1744             "assuming that job will be rendered on a remote server. Only " .
1745             "the PostScript of the options will be inserted into the " .
1746             "PostScript data stream.${added_lf}\n";
1747
1748     } else {
1749
1750         # use pstoraster script if available, otherwise run GhostScript
1751         # directly
1752         my $pstoraster = "pstoraster";
1753         my $havepstoraster = 0;
1754         for (split(':', $cupsfilterpath)) {
1755             if (-x "$_/$pstoraster") {
1756                 $havepstoraster=1;
1757                 $pstoraster = "$_/$pstoraster 0 '' '' 0 '%X'";
1758                 last;
1759             }
1760         }
1761
1762         if (!$havepstoraster) {
1763
1764             # Build GhostScript command line
1765             $pstoraster = "gs -dQUIET -dDEBUG -dPARANOIDSAFER -dNOPAUSE -dBATCH -dNOMEDIAATTRS -sDEVICE=cups -sOutputFile=-%W -"
1766             
1767         }
1768
1769         # build GhostScript/CUPS driver command line
1770         $dat->{'cmd'} = "$pstoraster | $cupsfilter";
1771
1772         # Set environment variables
1773         $ENV{'PPD'} = $ppdfile;
1774         
1775     }
1776 }
1777
1778 # Was the RIP command line defined in the PPD file? If not, we assume a
1779 # PostScript printer and do not render/translate the input data
1780 if (!defined($dat->{'cmd'})) {
1781     $dat->{'cmd'} = "cat%A%B%C%D%E%F%G%H%I%J%K%L%M%Z";
1782     if ($dontparse) {
1783         # No command line, no options, we have a raw queue, don't check
1784         # whether the input is PostScript and ignore the "docs" option,
1785         # simply pass the input data to the backend.
1786         $dontparse = 2;
1787         $model = "Raw queue";
1788     }
1789 }
1790
1791
1792
1793 ## Summary for debugging
1794 print $logh "${added_lf}Parameter Summary\n";
1795 print $logh "-----------------${added_lf}\n";
1796 print $logh "Spooler: $spooler\n";
1797 print $logh "Printer: $printer\n";
1798 print $logh "Shell: $modern_shell\n";
1799 print $logh "PPD file: $ppdfile\n";
1800 print $logh "ATTR file: $attrpath\n";
1801 print $logh "Printer model: $model\n";
1802 # Print the options string only in debug mode, Mac OS X adds very many
1803 # options so that CUPS cannot handle the output of the option string
1804 # in its log files. If CUPS encounters a line with more than 1024 characters
1805 # sent into its log files, it aborts the job with an error.
1806 if (($debug) || ($spooler ne 'cups')) {
1807     print $logh "Options: $optstr\n";
1808 }
1809 print $logh "Job title: $jobtitle\n";
1810 print $logh "File(s) to be printed: ${added_lf}@filelist${added_lf}\n";
1811 print $logh "GhostScript extra search path ('GS_LIB'): $ENV{'GS_LIB'}\n"
1812     if $ENV{'GS_LIB'};
1813
1814
1815
1816 ## Parse options from command line ($optstr)
1817
1818 # Before we start, save the defaults for printing documentation pages
1819
1820 copyoptions($dat, 'default', 'userval');
1821
1822
1823 # The options are "foo='bar nut'", "foo", "nofoo", "'bar nut'", or
1824 # "foo:'bar nut'" (when GPR was used) all with spaces between...
1825 # In addition they can be preceeded by page ranges, separated with a
1826 # colon.
1827
1828 my @opts;
1829
1830 # Variable for PPR's backend interface name (parallel, tcpip, atalk, ...)
1831
1832 my $backend = "";
1833
1834 # Array to collect unknown options so that they can get passed to the
1835 # backend interface of PPR. For other spoolers we ignore them.
1836
1837 my @backendoptions = ();
1838
1839 # "foo='bar nut'"
1840 while ($optstr =~ s!(((even|odd|[\d,-]+):|)\w+=[\'\"].*?[\'\"]) ?!!i) {
1841     push (@opts, $1);
1842 }
1843
1844 # "foo:'bar nut'" (GPR separates option and setting with a colon ":")
1845 while ($optstr =~ s!(((even|odd|[\d,-]+):|)\w+:[\'\"].*?[\'\"]) ?!!i) {
1846 #while ($optstr =~ s!(\w+=[\'\"].*?[\'\"])!!i) {
1847     push (@opts, $1);
1848 }
1849
1850 # "'bar nut'", "'foo=bar nut'", "'foo:bar nut'"
1851 while ($optstr =~ s!([\'\"].+?[\'\"]) ?!!) {
1852     my $opt = $1;
1853     $opt =~ s/[\'\"]//g; # Make only sure that we didn't quote
1854                          # the option for a second time when we read
1855                          # rge options from the command line or
1856                          # environment variable
1857     push (@opts, $opt);
1858     
1859 }
1860
1861 # "foo", "nofoo"
1862 push(@opts, split(/ /,$optstr));
1863
1864 # Now actually process those pesky options...
1865
1866 for (@opts) {
1867     print $logh "Pondering option '$_'\n";
1868
1869     # "docs" option to print help page
1870     if ((lc($_) =~ /^\s*docs\s*$/) ||
1871         (lc($_) =~ /^\s*docs\s*=\s*true\s*$/)) {
1872         # The second one is necessary becuase CUPS 1.1.15 or newer sees
1873         # "docs" as boolean option and modifies it to "docs=true"
1874         $do_docs = 1;
1875         next;
1876     }
1877
1878     # "profile" option to supply a color correction profile to a
1879     # CUPS raster driver
1880     if (lc($_) =~ /^\s*profile=(\S+)\s*$/) {
1881         $cupscolorprofile=$1;
1882         $dat->{'cmd'} =~ s!\%X!profile=$cupscolorprofile!g;
1883         $dat->{'cmd'} =~ s!\%W! -c\"<</cupsProfile($cupscolorprofile)>>setpagedevice\"!g;
1884         next;
1885     }
1886
1887     # Is the command line option limited to certain page ranges? If so,
1888     # mark the setting with a hash key containing the ranges
1889     my $optionset;
1890     if (s/^(even|odd|[\d,-]+)://i) {
1891         $optionset = "pages:$1";
1892     } else {
1893         $optionset = 'userval';
1894     }
1895
1896     # Solaris options that have no reason to be
1897     if (/^nobanner$/ || /^dest=.+$/ || /^protocol=.+$/) {
1898         next;
1899     }
1900
1901     my $arg;
1902     if ((m!([^=]+)=\'?(.*)\'?!) || (m!([^=:]+):\'?(.*)\'?!)) {
1903         my ($aname, $avalue) = ($1, $2);
1904
1905         if (($optionset =~ /pages/) &&
1906             ($arg = argbyname($aname)) &&
1907             ((!defined($arg->{'section'})) ||
1908              ($arg->{'section'} !~ /^(Any|Page)Setup/))) {
1909             print $logh "This option is not a \"PageSetup\" or " .
1910                 "\"AnySetup\" option, so it cannot be restricted to " .
1911                 "a page range.\n";
1912             next;
1913         }
1914
1915         # At first look for the "backend" option to determine the PPR
1916         # backend to use
1917         if (($aname =~ m!^backend$!i) && ($spooler eq 'ppr_int')) {
1918             # Backend interface name
1919             $backend = $avalue;
1920         } elsif ($aname =~ m!^media$!i) {
1921
1922             # Standard arguments?
1923             # media=x,y,z
1924             # sides=one|two-sided-long|short-edge
1925
1926             # Rummage around in the media= option for known media, source, 
1927             # etc types.
1928             # We ought to do something sensible to make the common manual
1929             # boolean option work when specified as a media= tray thing.
1930             # 
1931             # Note that this fails miserably when the option value is in
1932             # fact a number; they all look alike.  It's unclear how many
1933             # drivers do that.  We may have to standardize the verbose
1934             # names to make them work as selections, too.
1935
1936             my @values = split(',',$avalue);
1937             for (@values) {
1938                 my $val;
1939                 if ($dat->{'args_byname'}{'PageSize'} and
1940                     $val=valbyname($dat->{'args_byname'}{'PageSize'},$_)) {
1941                     $dat->{'args_byname'}{'PageSize'}{$optionset} = 
1942                         $val->{'value'};
1943                     # Keep "PageRegion" in sync
1944                     if ($dat->{'args_byname'}{'PageRegion'} and
1945                         $val=valbyname($dat->{'args_byname'}{'PageRegion'},
1946                                        $_)) {
1947                         $dat->{'args_byname'}{'PageRegion'}{$optionset} = 
1948                             $val->{'value'};
1949                     }
1950                 } elsif ($dat->{'args_byname'}{'PageSize'} 
1951                          and /^Custom/) {
1952                     $dat->{'args_byname'}{'PageSize'}{$optionset} = $_;
1953                     # Keep "PageRegion" in sync
1954                     if ($dat->{'args_byname'}{'PageRegion'}) {
1955                         $dat->{'args_byname'}{'PageRegion'}{$optionset} = 
1956                             $_;
1957                     }
1958                 } elsif ($dat->{'args_byname'}{'MediaType'} and
1959                          $val=valbyname($dat->{'args_byname'}{'MediaType'},
1960                                         $_)) {
1961                     $dat->{'args_byname'}{'MediaType'}{$optionset} =
1962                         $val->{'value'};
1963                 } elsif ($dat->{'args_byname'}{'InputSlot'} and
1964                          $val=valbyname($dat->{'args_byname'}{'InputSlot'},
1965                                         $_)) {
1966                     $dat->{'args_byname'}{'InputSlot'}{$optionset} = 
1967                         $val->{'value'};
1968                 } elsif (lc($_) eq 'manualfeed') {
1969                     # Special case for our typical boolean manual
1970                     # feeder option if we didn't match an InputSlot above
1971                     if (defined($dat->{'args_byname'}{'ManualFeed'})) {
1972                         $dat->{'args_byname'}{'ManualFeed'}{$optionset} = 1;
1973                     }
1974                 } else {
1975                     print $logh "Unknown \"media\" component: \"$_\".\n";
1976                 }
1977             }
1978         } elsif ($aname =~ m!^sides$!i) {
1979             # Handle the standard duplex option, mostly
1980             if ($avalue =~ m!^two-sided!i) {
1981                 if (defined($dat->{'args_byname'}{'Duplex'})) {
1982                     # Default to long-edge binding here, for the case that
1983                     # there is no binding setting
1984                     $dat->{'args_byname'}{'Duplex'}{$optionset} = 
1985                         'DuplexNoTumble';
1986                     # Check the binding: "long edge" or "short edge"
1987                     if ($avalue =~ m!long-edge!i) {
1988                         if (defined($dat->{'args_byname'}{'Binding'})) {
1989                             $dat->{'args_byname'}{'Binding'}{$optionset} =
1990       $dat->{'args_byname'}{'Binding'}{'vals_byname'}{'LongEdge'}{'value'};
1991                         } else {
1992                             $dat->{'args_byname'}{'Duplex'}{$optionset} = 
1993                                 'DuplexNoTumble';
1994                         }
1995                     } elsif ($avalue =~ m!short-edge!i) {
1996                         if (defined($dat->{'args_byname'}{'Binding'})) {
1997                             $dat->{'args_byname'}{'Binding'}{$optionset} =
1998       $dat->{'args_byname'}{'Binding'}{'vals_byname'}{'ShortEdge'}{'value'};
1999                         } else {
2000                             $dat->{'args_byname'}{'Duplex'}{$optionset} = 
2001                                 'DuplexTumble';
2002                         }
2003                     }
2004                 }
2005             } elsif ($avalue =~ m!^one-sided!i) {
2006                 if (defined($dat->{'args_byname'}{'Duplex'})) {
2007                     $dat->{'args_byname'}{'Duplex'}{$optionset} = 'None';
2008                 }
2009             }
2010
2011             # We should handle the other half of this option - the
2012             # BindEdge bit.  Also, are there well-known ipp/cups
2013             # options for Collate and StapleLocation?  These may be
2014             # here...
2015
2016         } else {
2017             # Various non-standard printer-specific options
2018             if ($arg = argbyname($aname)) {
2019                 if (defined(my $newvalue =
2020                     checkoptionvalue($dat, $aname, $avalue, 0))) {
2021                     # If the choice is valid, use it, otherwise
2022                     # ignore it.
2023                     $arg->{$optionset} = $newvalue;
2024                     # If this argument is PageSize or PageRegion,
2025                     # also set the other
2026                     syncpagesize($dat, $aname, $avalue, $optionset);
2027                 } else {
2028                     # Invalid choice, make log entry
2029                     print $logh "Invalid choice $aname=$avalue.\n";
2030                 }
2031             } elsif ($spooler eq 'ppr_int') {
2032                 # Unknown option, pass it to PPR's backend interface
2033                 push (@backendoptions, "$aname=$avalue");
2034             } else {
2035                 # Unknown option, make log entry
2036                 print $logh "Unknown option $aname=$avalue.\n";
2037             }
2038         }
2039     } elsif (m!^([\d\.]+)x([\d\.]+)([A-Za-z]*)$!) {
2040         my ($w, $h, $u) = ($1, $2, $3);
2041         # Custom paper size
2042         if (($w != 0) && ($h != 0) &&
2043             ($arg=argbyname("PageSize")) &&
2044             (defined($arg->{'vals_byname'}{'Custom'}))) {
2045             $arg->{$optionset} = "Custom.${w}x${h}${u}";
2046             # Keep "PageRegion" in sync
2047             if ($dat->{'args_byname'}{'PageRegion'}) {
2048                 $dat->{'args_byname'}{'PageRegion'}{$optionset} = 
2049                     $arg->{$optionset};
2050             }
2051         }
2052     } elsif ((m!^\s*no(.+)\s*$!i) and ($arg=argbyname($1))) {
2053         # standard bool args:
2054         # landscape; what to do here?
2055         # duplex; we should just handle this one OK now?
2056         $arg->{$optionset} = 0;
2057     } elsif (m!^\s*(.+)\s*$!) {
2058         if ($arg=argbyname($1)) {
2059             $arg->{$optionset} = 1;
2060         } else {
2061             print $logh "Unknown boolean option \"$1\".\n";
2062         }
2063     }
2064 }
2065 $do_docs = 1 if( $show_docs );
2066
2067
2068 ## Were we called to build the PDQ driver declaration file?
2069 my @pdqfile;
2070 if ($genpdqfile) {
2071     @pdqfile = buildpdqdriver($dat, 'userval');
2072     open PDQFILE, $genpdqfile or
2073         rip_die("Cannot write PDQ driver declaration file",
2074                 $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
2075     print PDQFILE join('', @pdqfile);
2076     close PDQFILE;
2077     exit $EXIT_PRINTED;
2078 }
2079
2080
2081
2082 ## Set the $postpipe
2083
2084 # $postpipe when running as a PPR RIP
2085 if ($spooler eq 'ppr') {
2086     # The PPR RIP sends the data output to /dev/fd/3 instead of to STDOUT
2087     if (-w "/dev/fd/3") {
2088         $postpipe = "| cat - > /dev/fd/3";
2089     } else {
2090         $postpipe = "| cat - >&3";
2091     }
2092 }
2093
2094 # Set up PPR backend (if we run as a PPR interface).
2095 if ($spooler eq 'ppr_int') {
2096
2097     # Is the chosen backend installed and executable
2098     if (!-x "interfaces/$backend") {
2099         my $pwd = cwd;
2100         print $logh "The backend interface $pwd/interfaces/$backend " .
2101             "does not exist/is not executable!\n";
2102         rip_die ("The backend interface $pwd/interfaces/$backend " .
2103                  "does not exist/is not executable!",
2104                  $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
2105     }
2106
2107     # foomatic-rip cannot use foomatic-rip as backend
2108     if ($backend eq "foomatic-rip") {
2109         print $logh "\"foomatic-rip\" cannot use itself as backend " .
2110             "interface!\n";
2111         ppr_die ($ppr_printer,
2112                  "\"foomatic-rip\" cannot use itself as backend interface!",
2113                  $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
2114     }
2115
2116     # Put the backend interface into the $postpipe
2117     $postpipe = "| ( interfaces/$backend \"$ppr_printer\" ".
2118         "\"$ppr_address\" \"" . join(" ",@backendoptions) .
2119         "\" \"$ppr_jobbreak\" \"$ppr_feedback\" " .
2120         "\"$ppr_codes\" \"$ppr_jobname\" \"$ppr_routing\" " .
2121         "\"$ppr_for\" \"\" )";
2122
2123 }
2124
2125 # CUPS and PDQ have their own backends, they do not need a $postpipe
2126 if (($spooler eq 'cups') || ($spooler eq 'pdq')) {
2127     # No $postpipe for CUPS or PDQ, even if one is defined in the PPD file
2128     $postpipe = "";
2129 }
2130
2131 # CPS needs always a $postpipe, set the default one for local printing
2132 # if none is set
2133 if (($spooler eq 'cps') && !$postpipe) {
2134     $postpipe = "| cat - > \$LPDDEV";
2135 }
2136
2137 if ($postpipe) {
2138     print $logh "${added_lf}Output will be redirected to:\n$postpipe${added_lf}\n";
2139 }
2140
2141
2142
2143 ## Print documentation page when asked for
2144 my ($docgeneratorhandle, $docgeneratorpid,$retval);
2145 if ($do_docs) {
2146     # Don't print the supplied files, STDIN will be redirected to the
2147     # documentation page generator
2148     @filelist = ("<STDIN>");
2149     # Start the documentation page generator
2150     ($docgeneratorhandle, $docgeneratorpid) =
2151         getdocgeneratorhandle($dat);
2152     if ($retval != $EXIT_PRINTED) {
2153         rip_die ("Error opening documentation page generator",
2154                  $retval);
2155     }
2156     # Read the further data from the documentation page generator and
2157     # not from STDIN
2158     if (!close STDIN && $! != $ESPIPE) {
2159         rip_die ("Couldn't close STDIN",
2160                  $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
2161     }
2162     if (!open (STDIN, "<&$docgeneratorhandle")) {
2163         rip_die ("Couldn't dup \$docgeneratorhandle",
2164                  $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
2165     }
2166         if( $show_docs ){
2167                 while( <$docgeneratorhandle> ){
2168                         print;
2169                 }
2170                 exit(0);
2171         }
2172 }
2173
2174
2175
2176
2177 ## In debug mode save the data supposed to be fed into the
2178 ## renderer also into a file, reset the file here
2179
2180 if ($debug) {
2181     modern_system("> ${logfile}.ps");
2182 }
2183
2184
2185
2186 ## From here on we have to repeat all the rest of the program for
2187 ## every file to print
2188
2189 for $file (@filelist) {
2190
2191     print $logh
2192 "${added_lf}================================================\n${added_lf}".
2193 "File: $file\n${added_lf}" .
2194 "================================================\n${added_lf}";
2195
2196
2197
2198     ## If we do not print standard input, open the file to print
2199     if ($file ne "<STDIN>") {
2200         if (! -r $file) {
2201             print $logh "File $file missing or not readable, skipping.\n";
2202             next;
2203         }
2204         close STDIN;
2205         open STDIN, "< $file" || do {
2206             print $logh "Cannot open $file, skipping.\n";
2207             next;
2208         }
2209     }
2210
2211
2212
2213     ## Do we have a raw queue
2214     if ($dontparse == 2) {
2215         # Raw queue, simply pass the input into the $postpipe (or to STDOUT
2216         # when there is no $postpipe)
2217         print $logh "Raw printing, executing \"cat $postpipe\"${added_lf}\n";
2218         modern_system("cat $postpipe");
2219         next;
2220     }
2221
2222
2223
2224     ## First, for arguments with a default, stick the default in as
2225     ## the initial value for the "header" option set, this option set
2226     ## consists of the PPD defaults, the options specified on the
2227     ## command line, and the options set in the header part of the
2228     ## PostScript file (all before the first page begins).
2229
2230     copyoptions($dat, 'userval', 'header');
2231
2232
2233
2234     ## Next, examine the PostScript job for traces of command-line and
2235     ## JCL options. PPD-aware applications and spoolers stuff option
2236     ## settings directly into the file, they do not necessarily send
2237     ## PPD options by the command line. Also stuff in PostScript code
2238     ## to apply option settings given by the command line and to set
2239     ## the defaults given in the PPD file.
2240
2241     # Examination strategy: read lines from STDIN until the first
2242     # %%Page: comment appears and save them as @psheader. This is the
2243     # page-independent header part of the PostScript file. The
2244     # PostScript interpreter (renderer) must execute this part once
2245     # before rendering any assortment of pages. Then pages can be
2246     # printed in any arbitrary selection or order. All option
2247     # settings we find here will be collected in the default option
2248     # set for the RIP command line.
2249
2250     # Now the pages will be read and sent to the renderer, one after
2251     # the other. Every page is read into memory until the
2252     # %%EndPageSetup comment appears (or a certain amount of lines was
2253     # read). So we can get option settings only valid for this
2254     # page. If we have such settings we set them in the modified
2255     # command set for this page.
2256
2257     # If the renderer is not running yet (first page) we start it with
2258     # the command line built from the current modified command set and
2259     # send the first page to it, in the end we leave the renderer
2260     # running and keep input and output pipes open, so that it can
2261     # accept further pages. If the renderer is still running from
2262     # the previous page and the current modified command set is the
2263     # same as the one for the previous page, we send the page. If
2264     # the command set is different, we close the renderer, re-start
2265     # it with the command line built from the new modified command
2266     # set, send the header again, and then the page.
2267
2268     # After the last page the trailer (%%Trailer) is sent.
2269
2270     # The output pipe of this program stays open all the time so that
2271     # the spooler does not assume that the job has finished when the
2272     # renderer is re-started.
2273
2274     # Non DSC-conforming documents will be read until a certain line
2275     # number is reached. Command line or JCL options inserted later
2276     # will be ignored.
2277
2278     # If options are implemented by PostScript code supposed to be
2279     # stuffed into the job's PostScript data we stuff the code for all
2280     # these options into our job data, So all default settings made in
2281     # the PPD file (the user can have edited the PPD file to change
2282     # them) are taken care of and command line options get also
2283     # applied. To give priority to settings made by applications we
2284     # insert the options's code in the beginnings of their respective
2285     # sections, so that sommething, which is already inserted, gets
2286     # executed after our code. Missing sections are automatically
2287     # created. In non-DSC-conforming files we insert the option code
2288     # in the beginning of the file. This is the same policy as used by
2289     # the "pstops" filter of CUPS.
2290
2291     # If CUPS is the spooler, the option settings were already
2292     # inserted by the "pstops" filter, so we don't insert them
2293     # again. The only thing we do is correcting settings of numerical
2294     # options when they were set to a value not available as choice in
2295     # the PPD file, As "pstops" does not support "real" numerical
2296     # options, it sees these settings as an invalid choice and stays
2297     # with the default setting. In this case we correct the setting in
2298     # the first occurence of the option's code, as this one is the one
2299     # added by CUPS, later occurences come from applications and
2300     # should not be touched.
2301
2302     # If the input is not PostScript (if there is no "%!" after
2303     # $maxlinestopsstart lines) a file conversion filter will
2304     # automatically be applied to the incoming data, so that we will
2305     # process the resulting PostScript here. This way we have always
2306     # PostScript data here and so we can apply the printer/driver
2307     # features described in the PPD file.
2308
2309     # Supported file conversion filters are "a2ps", "enscript",
2310     # "mpage", and spooler-specific filters. All filters convert
2311     # plain text to PostScript, "a2ps" also other formats. The
2312     # conversion filter is always used when one prints the
2313     # documentation pages, as they are created as plain text,
2314     # when CUPS is the spooler "pstops" is executed after the
2315     # filter so that the default option settings from the PPD file
2316     # and CUPS-specific options as N-up get applied. On regular
2317     # printouts one gets always PostScript when CUPS or PPR is
2318     # the spooler, so the filter is only used for regular
2319     # printouts under LPD, LPRng, GNUlpr or without spooler.
2320
2321     my $maxlines = 1000;            # Maximum number of lines to be read
2322                                     # when the documenent is not
2323                                     # DSC-conforming. "$maxlines = 0"
2324                                     # means that all will be read
2325                                     # and examined. If it is
2326                                     # discovered that the input file
2327                                     # is DSC-conforming, this will
2328                                     # be set to 0.
2329
2330     my $maxlinestopsstart = 200;    # That many lines are allowed until the
2331                                     # "%!" indicating PS comes. These
2332                                     # additional lines in the
2333                                     # beginning are usually JCL
2334                                     # commands. The lines will be
2335                                     # ignored by our parsing but
2336                                     # passed through.
2337
2338     my $maxlinesforpageoptions=200; # Unfortunately, CUPS does not bracket
2339                                     # "PageSetup" option with
2340                                     # "%%BeginPageSetup" and
2341                                     # "%%EndPageSetup", so the options
2342                                     # can simply stand after the
2343                                     # page header and before the
2344                                     # page code, without special
2345                                     # marking. So buffer this amount
2346                                     # of lines before printing the
2347                                     # page to check for options.
2348
2349     my $maxnondsclinesinheader=1000; # If there is a block of more lines
2350                                     # than this in the document
2351                                     # header which is not in the
2352                                     # "%%BeginProlog...%%EndProlog"
2353                                     # or
2354                                     # "%%BeginSetup...%%EndSetup"
2355                                     # sections, the document is not
2356                                     # considered as DSC-conforming
2357                                     # and the rest gets passed
2358                                     # through to the renderer without
2359                                     # further parsing for options.
2360
2361     my $nondsclines = 0;            # Amount of lines found which are not in
2362                                     # a section (see 
2363                                     # $maxnondsclinesinheader).
2364
2365     my $nonpslines = 0;             # lines before "%!" found yet.
2366
2367     my $more_stuff = 1;             # there is more stuff in stdin.
2368
2369     my $linect = 0;                 # how many lines have we examined?
2370
2371     my $onelinebefore = "";         # The line before the current line
2372                                     # (Non-DSC comments are ignored)
2373
2374     my $twolinesbefore = "";        # The line two lines before the current 
2375                                     # line (Non-DSC comments are ignored)
2376
2377     my $linesafterlastbeginfeature = ""; # All code lines after the last
2378                                     # "%%BeginFeature:"
2379
2380     my @psheader = ();              # The header of the PostScript file, 
2381                                     # to be sent after each start of the
2382                                     # renderer
2383
2384     my @psfifo = ();                # The input FIFO, data which we have
2385                                     # pulled from stdin for examination,
2386                                     # but not sent to the renderer yet.
2387
2388     my $passthru = 0;               # 0: write data into @psfifo; 1: pass
2389                                     # data directly to the renderer
2390
2391     my $isdscjob = 0;               # Is the job DSC conforming
2392
2393     my $inheader = 1;               # Are we still in the header, before
2394                                     # first "%%Page:" comment?
2395
2396     my $optionset = 'header';       # Where do the option settings, which 
2397                                     # we have found, go?
2398
2399     my $optionsalsointoheader = 0;  # 1: We are in a "%%BeginSetup...
2400                                     # %%EndSetup" section after the first
2401                                     # "%%Page:..." line (OpenOffice.org
2402                                     # does this and intends the options here
2403                                     # apply to the whole document and not
2404                                     # only to the current page). We have to
2405                                     # add all lines also to the end of the
2406                                     # @psheader now and we have to set
2407                                     # non-PostScript options also in the
2408                                     # "header" optionset. 0: otherwise.
2409
2410     my $nestinglevel = 0;           # Are we in the main document (0) or
2411                                     # in an embedded document bracketed by
2412                                     # "%%BeginDocument" and "%%EndDocument"
2413                                     # (>0) We do not parse the PostScript
2414                                     # in an embedded document.
2415
2416     my $inpageheader = 0;           # Are we in the header of a page,
2417                                     # between "%%BeginPageSetup" and
2418                                     # "%%EndPageSetup" (1) or not (0).
2419
2420     my $lastpassthru = 0;           # State of $passthru in previous line
2421                                     # (to allow debug output when $passthru
2422                                     # switches.
2423
2424     my $ignorepageheader = 0;       # Will be set to 1 as soon as active 
2425                                     # code (not between "%%BeginPageSetup" 
2426                                     # and "%%EndPageSetup") appears after a
2427                                     # "%%Page:" comment. In this case
2428                                     # "%%BeginPageSetup" and
2429                                     # "%%EndPageSetup" is not allowed any 
2430                                     # more on this page and will be ignored.
2431                                     # Will be set to 0 when a new "%%Page:" 
2432                                     # comment appears.
2433
2434     my $printprevpage = 0;          # We set this when encountering
2435                                     # "%%Page:" and the previous page is not
2436                                     # printed yet. Then it will be printed and 
2437                                     # the new page will be prepared in the
2438                                     # next run of the loop (we don't read a
2439                                     # new line and don't increase the
2440                                     # $linect then).
2441
2442     $fileconverterhandle = undef;   # File handle to the fileconverter process
2443
2444     $fileconverterpid = 0;          # PID of the fileconverter process
2445
2446     $rendererhandle = undef;        # File handle to the renderer process
2447
2448     $rendererpid = 0;               # PID of the renderer process
2449
2450     my $prologfound = 0;            # Did we find the
2451                                     # "%%BeginProlog...%%EndProlog" section?
2452
2453     my $setupfound = 0;             # Did we find the
2454                                     # "%%BeginSetup...%%EndSetup" section?
2455
2456     my $pagesetupfound = 0;         # special page setup handling needed
2457
2458     my $inprolog = 0;               # We are between "%%BeginProlog" and
2459                                     # "%%EndProlog".
2460
2461     my $insetup = 0;                # We are between "%%BeginSetup" and
2462                                     # "%%EndSetup".
2463
2464     my $infeature = 0;              # We are between "%%BeginFeature" and
2465                                     # "%%EndFeature".
2466
2467     my $postscriptsection = 'jclsetup'; # In which section of the PostScript
2468                                     # file are we currently?
2469
2470     $nondsclines = 0;            # Number of subsequent lines found which
2471                                     # are at a non-DSC-conforming place,
2472                                     # between the sections of the header.
2473
2474     my $optionreplaced = 0;         # Will be set to 1 when we are in an
2475                                     # option ("%%BeginFeature...
2476                                     # %%EndFeature") which we have replaced.
2477
2478     $jobhasjcl = 0;                 # When the job does not start with
2479                                     # PostScript directly, but is a
2480                                     # PostScript job, we set this to 1
2481                                     # to avoid adding the JCL options
2482                                     # for the second time.
2483
2484     my $insertoptions = 1;          # If we find out that a file with
2485                                     # a DSC magic string
2486                                     # ("%!PS-Adobe-") is not really
2487                                     # DSC-conforming, we insert the
2488                                     # options directly after the line
2489                                     # with the magic string. We use
2490                                     # this variable to store the
2491                                     # number of the line with the
2492                                     # magic string.
2493
2494     my $currentpage = 0;            # The page which we are currently
2495                                     # printing.
2496
2497     my $ooo110 = 0;                 # Flag to work around an application 
2498                                     # bug.
2499
2500     my $saved = 0;                  # DSC line not processed yet
2501     
2502     if ($dontparse) {
2503         # We do not parse the PostScript to find Foomatic options, we check
2504         # only whether we have PostScript.
2505         $maxlines = 1;
2506     }
2507
2508     print $logh "Reading PostScript input ...\n";
2509
2510     my $line;                       # Line to be read from stdin
2511     do {
2512         my $ignoreline = 0;         # Comment line to be ignored when
2513                                     # determining the last active line 
2514                                     # and the one before the last
2515
2516         if (($printprevpage) || ($saved) || ($line=<STDIN>)) {
2517             $saved = 0;
2518
2519             if ($linect == $nonpslines) {
2520                 # In the beginning should be the postscript leader,
2521                 # sometimes after some JCL commands
2522                 if ($line !~ m/^.?%!/) { # There can be a Windows control 
2523                                          # character before "%!"
2524                     $nonpslines ++;
2525                     if ($maxlines == $nonpslines) {
2526                         $maxlines ++;
2527                     }
2528                     $jobhasjcl = 1;
2529                     if ($nonpslines > $maxlinestopsstart) {
2530                         # This is not a PostScript job, we must convert it
2531                         print $logh "${added_lf}Job does not start with \"%!\", " . 
2532                              "is it PostScript?\n" .
2533                              "Starting file converter\n";
2534                         # Reset all variables but conserve the data which
2535                         # we have already read.
2536                         $jobhasjcl = 0;
2537                         $linect =  0;
2538                         $nonpslines = 1; # Take into account that the line
2539                                          # of this run of the loop will be
2540                                          # put into @psheader, so the
2541                                          # first line read by the file
2542                                          # converter is already the second
2543                                          # line.
2544                         $maxlines = 1001;
2545                         $onelinebefore = "";
2546                         $twolinesbefore = "";
2547                         my $alreadyread = join('', @psheader, @psfifo) . 
2548                             $line;
2549                         $line = "";
2550                         @psheader = ();
2551                         @psfifo = ();
2552                         # Start the file conversion filter
2553                         if (!$fileconverterpid) {
2554                             ($fileconverterhandle, $fileconverterpid) =
2555                                 getfileconverterhandle
2556                                 ($dat, $alreadyread);
2557                             if ($retval != $EXIT_PRINTED) {
2558                                 rip_die ("Error opening file converter",
2559                                          $retval);
2560                             }
2561                         } else {
2562                             rip_die("File conversion filter probably " .
2563                                     "crashed",
2564                                     $EXIT_JOBERR);
2565                         }
2566                         # Read the further data from the file converter and
2567                         # not from STDIN
2568                         if (!close STDIN && $! != $ESPIPE) {
2569                             rip_die ("Couldn't close STDIN",
2570                                      $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
2571                         }
2572                         if (!open (STDIN, "<&$fileconverterhandle")) {
2573                             rip_die ("Couldn't dup \$fileconverterhandle",
2574                                      $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
2575                         }
2576                     }
2577                 } else {
2578                     # Do we have a DSC-conforming document?
2579                     if ($line =~ m/^.?%!PS-Adobe-/) {
2580                         # Do not stop parsing the document
2581                         if (!$dontparse) {
2582                             $maxlines = 0;
2583                             $isdscjob = 1;
2584                             $insertoptions = $linect + 1;
2585                             # We have written into @psfifo before,
2586                             # now we continue in @psheader and move
2587                             # over the data which is already in @psfifo
2588                             push (@psheader, @psfifo);
2589                             @psfifo = ();
2590                         }
2591                         print $logh 
2592                             "--> This document is DSC-conforming!\n";
2593                     } else {
2594                         # Job is not DSC-conforming, stick in all PostScript
2595                         # option settings in the beginning
2596                         $line .= makeprologsection($dat, $optionset, 1);
2597                         $line .= makesetupsection($dat, $optionset, 1);
2598                         $line .= makepagesetupsection($dat, $optionset, 1);
2599                         $prologfound = 1;
2600                         $setupfound = 1;
2601                         $pagesetupfound = 1;
2602                     }
2603                 }
2604             } else {
2605                 if ($line =~ /^\%/) {
2606                     if ($line =~ m/^\s*\%\%BeginDocument[: ]/) {
2607                         # Beginning of an embedded document
2608                         # Note that Adobe Acrobat has a bug and so uses
2609                         # "%%BeginDocument " instead of "%%BeginDocument:"
2610                         $nestinglevel ++;
2611                         print $logh "Embedded document, " .
2612                             "nesting level now: $nestinglevel\n";
2613                     } elsif (($line =~ m/^\s*\%\%EndDocument/) &&
2614                              ($nestinglevel > 0)) {
2615                         # End of an embedded document
2616                         $nestinglevel --;
2617                         print $logh "End of Embedded document, " .
2618                             "nesting level now: $nestinglevel\n";
2619                     } elsif (($line =~ m/^\s*\%\%Creator[: ](.*)$/) &&
2620                              ($nestinglevel == 0)) {
2621                         # Here we set flags to treat particular bugs of the
2622                         # PostScript produced by certain applications
2623                         my $creator = $1;
2624                         if ($creator =~ /^\s*OpenOffice.org\s+1.1.\d+\s*$/) {
2625                             # OpenOffice.org 1.1.x
2626                             # The option settings supposed to affect the
2627                             # whole document are put into the "%%PageSetup"
2628                             # section of the first page
2629                             print $logh "Document created with " .
2630                                 "OpenOffice.org 1.1.x\n";
2631                             $ooo110 = 1;
2632                         }
2633                     } elsif (($line =~ m/^\%\%BeginProlog/) &&
2634                              ($nestinglevel == 0)) {
2635                         # Note: Below is another place where a "Prolog"
2636                         # section start will be considered. There we assume
2637                         # start of the "Prolog" if the job is DSC-Conformimg,
2638                         # but an arbitrary comment starting with "%%Begin", but
2639                         # not a comment explicitly treated here, is found. This
2640                         # is done because many "dvips" (TeX/LaTeX) files miss
2641                         # the "%%BeginProlog" comment.
2642                         # Beginning of Prolog
2643                         print $logh "${added_lf}-----------\nFound: \%\%BeginProlog\n";
2644                         $inprolog = 1;
2645                         $postscriptsection = 'prolog' if $inheader;
2646                         $nondsclines = 0;
2647                         # Insert options for "Prolog"
2648                         if (!$prologfound) {
2649                             $line .= makeprologsection($dat, $optionset, 0);
2650                         }
2651                         $prologfound = 1;
2652                     } elsif (($line =~ m/^\%\%EndProlog/) &&
2653                              ($nestinglevel == 0)) {
2654                         # End of Prolog
2655                         print $logh "Found: \%\%EndProlog\n";
2656                         $inprolog = 0;
2657                         $insertoptions = $linect + 1;
2658                     } elsif (($line =~ m/^\%\%BeginSetup/) &&
2659                              ($nestinglevel == 0)) {
2660                         # Beginning of Setup
2661                         print $logh "${added_lf}-----------\nFound: \%\%BeginSetup\n";
2662                         $insetup = 1;
2663                         # We need to distinguish with the $inheader variable
2664                         # here whether we are in the header or on a page, as
2665                         # OpenOffice.org inserts a "%%BeginSetup...%%EndSetup"
2666                         # section after the first "%%Page:..." line and assumes
2667                         # this section to be valid for all pages.
2668                         $postscriptsection = 'setup' if $inheader;
2669                         $nondsclines = 0;
2670                         if ($inheader) {
2671                             # If there was no "Prolog" but there are
2672                             # options for the "Prolog", push a "Prolog"
2673                             # with these options onto the @psfifo here
2674                             if (!$prologfound) {
2675                                 # "Prolog" missing, insert it here
2676                                 $line =
2677                                     makeprologsection($dat, $optionset, 1) .
2678                                     $line;
2679                                 # Now we have a "Prolog"
2680                                 $prologfound = 1;
2681                             }
2682                             # Insert options for "DocumentSetup" or "AnySetup"
2683                             if ($spooler ne 'cups') {
2684                                 # For non-CUPS spoolers or no spooler at all, 
2685                                 # we leave everything as it is.
2686                                 if (!$setupfound) {
2687                                     $line .= 
2688                                         makesetupsection($dat, $optionset, 0);
2689                                 }
2690                                 $setupfound = 1;
2691                             }
2692                         } else {
2693                             # Found option settings must be stuffed into both
2694                             # the header and the currrent page now. They will
2695                             # be written into both the "header" and the
2696                             # "currentpage" optionsets and the PostScript code
2697                             # lines of this section will not only go into the
2698                             # output stream, but also added to the end of the
2699                             # @psheader, so that they get repeated (to preserve
2700                             # the embedded PostScript option settings) on a 
2701                             # restart of the renderer due to command line 
2702                             # option changes
2703                             $optionsalsointoheader = 1;
2704                             print $logh "\"%%BeginSetup\" in page header\n";
2705                         }
2706                     } elsif (($line =~ m/^\%\%EndSetup/) &&
2707                              ($nestinglevel == 0)) {
2708                         # End of Setup
2709                         print $logh "Found: \%\%EndSetup\n";
2710                         $insetup = 0;
2711                         if ($inheader) {
2712                             if ($spooler eq 'cups') {
2713                                 # In case of CUPS, we must insert the
2714                                 # accounting stuff just before the
2715                                 # %%EndSetup comment in order to leave any
2716                                 # EndPage procedures that have been
2717                                 # defined by either the pstops filter or
2718                                 # the PostScript job itself fully
2719                                 # functional.
2720                                 if (!$setupfound) {
2721                                     $line = makesetupsection($dat, 
2722                                                              $optionset, 0) . 
2723                                                                  $line;  
2724                                 }
2725                                 $setupfound = 1;
2726                             }
2727                             $insertoptions = $linect + 1;
2728                         } else {
2729                             # The "%%BeginSetup...%%EndSetup" which
2730                             # OpenOffice.org has inserted after the first
2731                             # "%%Page:..." line ends here, so the following
2732                             # options go only onto the current page again
2733                             $optionsalsointoheader = 0;
2734                         }
2735                     } elsif (($line =~ m/^\%\%Page:(.*)$/) &&
2736                              ($nestinglevel == 0)) {
2737                         if ((!$lastpassthru) && (!$inheader)) {
2738                             # In the last line we were not in passthru mode,
2739                             # so the last page is not printed. Prepare to do
2740                             # it now.
2741                             $printprevpage = 1;
2742                             # Print the previous page
2743                             $passthru = 1;
2744                             print $logh "New page found but previous not " . 
2745                                 "printed, print it now.\n";
2746                         } else {
2747                             # The previous page is printed, so we can prepare
2748                             # the current one
2749                             $printprevpage = 0;
2750                             print $logh "${added_lf}-----------\nNew page: $1\n";
2751                             # Count pages
2752                             $currentpage ++;
2753                             # We consider the beginning of the page already as
2754                             # page setup section, as some apps do not use
2755                             # "%%PageSetup" tags.
2756                             $postscriptsection = 'pagesetup';
2757                             # Save PostScript state before beginning the page
2758                             #$line .= "/foomatic-saved-state save def\n";
2759                             # Here begins a new page
2760                             if ($inheader) {
2761                                 # One last update for the header
2762                                 buildcommandline($dat, $optionset);
2763                                 # Here we add some stuff which still belongs
2764                                 # into the header
2765                                 my $stillforheader;
2766                                 # If there was no "Setup" but there are
2767                                 # options for the "Setup", push a "Setup"
2768                                 # with these options onto the @psfifo here
2769                                 if (!$setupfound) {
2770                                     # "Setup" missing, insert it here
2771                                     $stillforheader = 
2772                                         makesetupsection($dat, $optionset, 1) .
2773                                         $stillforheader;
2774                                     # Now we have a "Setup"
2775                                     $setupfound = 1;
2776                                 }
2777                                 # If there was no "Prolog" but there are
2778                                 # options for the "Prolog", push a "Prolog"
2779                                 # with these options onto the @psfifo here
2780                                 if (!$prologfound) {
2781                                     # "Prolog" missing, insert it here
2782                                     $stillforheader = 
2783                                         makeprologsection($dat, $optionset,
2784                                                           1) .
2785                                         $stillforheader;
2786                                     # Now we have a "Prolog"
2787                                     $prologfound = 1;
2788                                 }
2789                                 # Now we push this onto the header
2790                                 push (@psheader, $stillforheader);
2791                                 # The first page starts, so the header ends
2792                                 $inheader = 0;
2793                                 $nondsclines = 0;
2794                                 # Option setting should go into the
2795                                 # page-specific option set now
2796                                 $optionset = 'currentpage';
2797                             } else {
2798                                 # Restore PostScript state after completing the
2799                                 # previous page:
2800                                 # 
2801                                 #   foomatic-saved-state restore
2802                                 #   %%Page: ...
2803                                 #   /foomatic-saved-state save def
2804                                 #
2805                                 # Print this directly, so that if we need to
2806                                 # restart the renderer for this page due to
2807                                 # a command line change this is done under the
2808                                 # old instance of the renderer
2809                                 #print $rendererhandle
2810                                 #    "foomatic-saved-state restore\n";
2811
2812                                 # Save the option settings of the previous page
2813                                 copyoptions($dat, 'currentpage',
2814                                             'previouspage');
2815                                 deleteoptions($dat, 'currentpage');
2816                             }
2817                             # Initialize the option set
2818                             copyoptions($dat, 'header', 'currentpage');
2819                             # Set command line options which apply only
2820                             # given pages
2821                             setoptionsforpage($dat, 'currentpage', $currentpage);
2822                             $pagesetupfound = 0;
2823                             if ($spooler eq 'cups') {
2824                                 # Remove the "notfirst" flag from all options
2825                                 # forseen for the "PageSetup" section, because
2826                                 # when these are numerical options for CUPS.
2827                                 # they have to be set to the correct value
2828                                 # for every page
2829                                 for my $arg (@{$dat->{'args'}}) {
2830                                     if (($arg->{'section'} eq 'PageSetup') &&
2831                                         (defined($arg->{'notfirst'}))) {
2832                                         delete($arg->{'notfirst'});
2833                                     }
2834                                 }
2835                             }
2836                             # Now the page header comes, so buffer the data,
2837                             # because we must perhaps shut down and restart 
2838                             # the renderer
2839                             $passthru = 0;
2840                             $ignorepageheader = 0;
2841                             $optionsalsointoheader = 0;
2842                         }
2843                     } elsif (($line =~ m/^\%\%BeginPageSetup/) &&
2844                              ($nestinglevel == 0) &&
2845                              (!$ignorepageheader))  {
2846                         # Start of the page header, up to %%EndPageSetup
2847                         # nothing of the page will be drawn, page-specific
2848                         # option settngs (as letter-head paper for page 1)
2849                         # go here
2850                         print $logh "${added_lf}Found: \%\%BeginPageSetup\n";
2851                         $passthru = 0;
2852                         $inpageheader = 1;              
2853                         $postscriptsection = 'pagesetup';
2854                         if (($ooo110) && ($currentpage == 1)) {
2855                             $optionsalsointoheader = 1;
2856                         } else {
2857                             $optionsalsointoheader = 0;
2858                         }
2859                         # Insert PostScript option settings
2860                         # (options for section "PageSetup".
2861                         if ($isdscjob) {
2862                             $line .= 
2863                                 makepagesetupsection($dat, $optionset,
2864                                                      0);
2865                             $pagesetupfound = 1;
2866                         }
2867                     } elsif (($line =~ m/^\%\%EndPageSetup/) &&
2868                              ($nestinglevel == 0) &&
2869                              (!$ignorepageheader)) {
2870                         # End of the page header, the page is ready to be
2871                         # printed
2872                         print $logh "Found: \%\%EndPageSetup\n";
2873                         print $logh "End of page header\n";
2874                         # We cannot for sure say that the page header ends here
2875                         # OpenOffice.org puts (due to a bug) a "%%BeginSetup...
2876                         # %%EndSetup" section after the first "%%Page:...". It
2877                         # is possible that CUPS inserts a "%%BeginPageSetup...
2878                         # %%EndPageSetup" before this section, which means that
2879                         # the options in the "%%BeginSetup...%%EndSetup"
2880                         # section are after the "%%EndPageSetup", so we
2881                         # continue for searching options up to the buffer size
2882                         # limit $maxlinesforpageoptions.
2883                         $passthru = 0;
2884                         $inpageheader = 0;
2885                         $optionsalsointoheader = 0;
2886                     } elsif ((($line =~ m/^\%\%(BeginFeature):\s*\*?([^\*\s=]+)\s+()(\S[^\r\n]*)\r?\n?$/) ||
2887                               ($line =~ m/^\s*\%\%\s*(FoomaticRIPOptionSetting):\s*([^\*\s=]+)\s*=\s*(\@?)([^\@\s][^\r\n]*)\r?\n?$/)) &&
2888                              ($nestinglevel == 0) &&
2889                              (!$optionreplaced) &&
2890                              ((!$passthru) || (!$isdscjob))) {
2891                         my ($linetype, $option, $fromcomposite, $value) = 
2892                             ($1, $2, $3, $4);
2893
2894                         # Mark that we are in a "Feature" section
2895                         if ($linetype eq 'BeginFeature') {
2896                             $infeature = 1;
2897                             $linesafterlastbeginfeature = "";
2898                         }
2899
2900                         # OK, we have an option.  If it's not a
2901                         # *ostscript-style option (ie, it's command-line or
2902                         # JCL) then we should note that fact, since the
2903                         # attribute-to-filter option passing in CUPS is kind of
2904                         # funky, especially wrt boolean options.  
2905
2906                         print $logh "Found: $line";
2907                         if (my $arg=argbyname($option)) {
2908                             print $logh "   Option: $option=" .
2909                                 ($fromcomposite ? "From" : "") . $value;
2910                             if (($spooler eq 'cups') &&
2911                                 ($linetype eq 'BeginFeature') &&
2912                                 (!defined($arg->{'notfirst'})) &&
2913                                 ($arg->{$optionset} ne $value) &&
2914                                 (($inheader) ||
2915                                  ($arg->{section} eq 'PageSetup'))) {
2916
2917                                 # We have the first occurence of an option
2918                                 # setting and the spooler is CUPS, so this
2919                                 # setting is inserted by "pstops" or
2920                                 # "imagetops". The value from the command
2921                                 # line was not inserted by "pstops" or
2922                                 # "imagetops" so it seems to be not under
2923                                 # the choices in the PPD. Possible
2924                                 # reasons:
2925                                 #
2926                                 # - "pstops" and "imagetops" ignore settings 
2927                                 #   of numerical or string options which are
2928                                 #   not one of the choices in the PPD file,
2929                                 #   and inserts the default value instead.
2930                                 #
2931                                 # - On the command line an option was applied
2932                                 #   only to selected pages:
2933                                 #    "-o <page ranges>:<option>=<values>
2934                                 #   This is not supported by CUPS, so not
2935                                 #   taken care of by "pstops".
2936                                 #
2937                                 # We must fix this here by replacing the
2938                                 # setting inserted by "pstops" or "imagetops"
2939                                 # with the exact setting given on the command
2940                                 # line.
2941
2942                                 # $arg->{$optionset} is already 
2943                                 # range-checked, so do not check again here
2944                                 # Insert DSC comment
2945                                 my $dest = ((($inheader) && ($isdscjob)) ?
2946                                             \@psheader : \@psfifo);
2947                                 my $val;
2948                                 if ($arg->{'style'} eq 'G') {
2949                                     # PostScript option, insert the code
2950                                     if ($arg->{'type'} eq 'bool') {
2951                                         # Boolean option
2952                                         push(@{$dest},
2953                                              "%%BeginFeature: *$option " .
2954                                              ($arg->{$optionset} == 1 ?
2955                                               "True" : "False") . "\n");
2956                                         if (defined($arg->{$optionset}) && 
2957                                             $arg->{$optionset} == 1) {
2958                                             push(@{$dest}, $arg->{'proto'} .
2959                                                  "\n");
2960                                         } elsif ($arg->{'protof'}) {
2961                                             push(@{$dest}, $arg->{'protof'} .
2962                                                  "\n");
2963                                         }
2964                                         # We have replaced this option on the 
2965                                         # FIFO
2966                                         $optionreplaced = 1;
2967                                     } elsif ((($arg->{'type'} eq 'enum') ||
2968                                               ($arg->{'type'} eq 'string') ||
2969                                               ($arg->{'type'} eq
2970                                                'password')) &&
2971                                              (defined($val =
2972                                                       $arg->{'vals_byname'}{$arg->{$optionset}}))) {
2973                                         # Enumerated choice of string or enum 
2974                                         # option
2975                                         push(@{$dest},
2976                                              "%%BeginFeature: " .
2977                                              "*$option $arg->{$optionset}\n");
2978                                         push(@{$dest}, $val->{'driverval'} . "\n");
2979                                         # We have replaced this option on the 
2980                                         # FIFO
2981                                         $optionreplaced = 1;
2982                                     } elsif ((($arg->{'type'} eq 'string') ||
2983                                               ($arg->{'type'} eq 
2984                                                'password')) &&
2985                                              ($arg->{$optionset} eq 'None')) {
2986                                         # 'None' is mapped to the empty string 
2987                                         # in string options
2988                                         push(@{$dest},
2989                                              "%%BeginFeature: " .
2990                                              "*$option $arg->{$optionset}\n");
2991                                         my $driverval = $arg->{'proto'};
2992                                         $driverval =~ s/\%s//g;
2993                                         push(@{$dest}, $driverval . "\n");
2994                                         # We have replaced this option on the 
2995                                         # FIFO
2996                                         $optionreplaced = 1;
2997                                     } elsif (($arg->{'type'} eq 'int') ||
2998                                              ($arg->{'type'} eq 'float') ||
2999                                              ($arg->{'type'} eq 'string') ||
3000                                              ($arg->{'type'} eq 'password')) {
3001                                         # Setting for numerical or string
3002                                         # option which is not under the
3003                                         # enumerated choices
3004                                         push(@{$dest},
3005                                              "%%BeginFeature: " .
3006                                              "*$option $arg->{$optionset}\n");
3007                                         my $sprintfproto = $arg->{'proto'};
3008                                         $sprintfproto =~ s/\%(?!s)/\%\%/g;
3009                                         push(@{$dest},
3010                                              sprintf($sprintfproto,
3011                                                      $arg->{$optionset}) .
3012                                              "\n");
3013                                         # We have replaced this option on the 
3014                                         # FIFO
3015                                         $optionreplaced = 1;
3016                                     }
3017                                 } else {
3018                                     # Command line or JCL option
3019                                     push(@{$dest},
3020                                          "%% FoomaticRIPOptionSetting: " .
3021                                          "$option=$arg->{$optionset}\n");
3022                                 # We have replaced this option on the 
3023                                 # FIFO
3024                                 $optionreplaced = 1;
3025                             }
3026                                 print $logh " --> Correcting numerical/string " .
3027                                     "option to $option=$arg->{$optionset}" .
3028                                     " (Command line argument)\n" if
3029                                     $optionreplaced;
3030                             }
3031                             # Mark that we have already found this option
3032                             $arg->{'notfirst'} = 1;
3033                             if (!$optionreplaced) {
3034                                 if ($arg->{'style'} ne 'G') {
3035                                     # "Controlled by '<Composite>'" setting of
3036                                     # a member option of a composite option
3037                                     if ($fromcomposite) {
3038                                         $value = "From$value";
3039                                     }
3040                                     # Non-PostScript option
3041                                     # Check whether it is valid
3042                                     if (defined(my $newvalue =
3043                                                 checkoptionvalue($dat, $option,
3044                                                                  $value, 0))) {
3045                                         print $logh " --> Setting option\n";
3046                                         # Valid choice, set it.
3047                                         $arg->{$optionset} = $newvalue;
3048                                         if ($optionsalsointoheader) {
3049                                             $arg->{'header'} = $newvalue;
3050                                         }
3051                                         if (($arg->{'type'} eq 'enum') &&
3052                                             (($option eq 'PageSize') ||
3053                                              ($option eq 'PageRegion')) &&
3054                                             ($newvalue =~ /^Custom/) &&
3055                                             ($linetype eq 
3056                                              'FoomaticRIPOptionSetting')) {
3057                                             # Custom page size
3058                                             $linesafterlastbeginfeature =~ 
3059                                                 /^[\s\r\n]*([\d\.]+)[\s\r\n]+([\d\.]+)[\s\r\n]+/s;
3060                                             my ($w, $h) = ($1, $2);
3061                                             if (($w) && ($h) && 
3062                                                 ($w != 0) && ($h != 0)) {
3063                                                 $newvalue =
3064                                                     "$newvalue.${w}x$h";
3065                                                 $arg->{$optionset} = $newvalue;
3066                                                 if ($optionsalsointoheader) {
3067                                                     $arg->{'header'} =
3068                                                         $newvalue;
3069                                                 }
3070                                             }
3071                                         }
3072                                         # For a composite option insert the
3073                                         # code from the member options with
3074                                         # current setting "From<composite>"
3075                                         # The code from the member options
3076                                         # is chosen according to the setting 
3077                                         # of the composite option.
3078                                         if (($arg->{'style'} eq 'X') &&
3079                                             ($linetype eq 
3080                                              'FoomaticRIPOptionSetting')) {
3081                                             buildcommandline($dat, $optionset);
3082                                             $line .=
3083                                                 $arg->{$postscriptsection};
3084                                         }
3085                                         # If this argument is PageSize or 
3086                                         # PageRegion, also set the other
3087                                         syncpagesize($dat, $option, $newvalue, 
3088                                                      $optionset);
3089                                         if ($optionsalsointoheader) {
3090                                             syncpagesize($dat, $option, 
3091                                                          $newvalue, 'header');
3092                                         }
3093                                     } else {
3094                                         # Invalid option, log it.
3095                                         print $logh " --> Invalid option " .
3096                                             "setting found in job\n";
3097                                     }
3098                                 } elsif ($fromcomposite) {
3099                                     # PostScript option, but we have to look up
3100                                     # the PostScript code to be inserted from
3101                                     # the setting of a composite option, as
3102                                     # this option is set to "Controlled by 
3103                                     # '<Composite>'".
3104                                     # Set the option
3105                                     if (defined(my $newvalue =
3106                                                 checkoptionvalue
3107                                                 ($dat, $option,
3108                                                  "From$value", 0))) {
3109                                         print $logh " --> Looking up setting " .
3110                                             "in composite option '$value'\n";
3111                                         # Valid choice, set it.
3112                                         $arg->{$optionset} = $newvalue;
3113                                         if ($optionsalsointoheader) {
3114                                             $arg->{'header'} = $newvalue;
3115                                         }
3116                                         # Update composite options
3117                                         buildcommandline($dat, $optionset);
3118                                         # Substitute PostScript comment by
3119                                         # the real code
3120                                         $line = $arg->{'compositesubst'};
3121                                     } else {
3122                                         # Invalid option, log it.
3123                                         print $logh " --> Invalid option " .
3124                                             "setting found in job\n";
3125                                     }
3126                                 } else {
3127                                     # it is a PostScript style option with
3128                                     # the code readily inserted, no option
3129                                     # for the renderer command line/JCL to set,
3130                                     # no lookup of a composite option needed,
3131                                     # so nothing to do here...
3132                                     print $logh 
3133                                         " --> Option will be set by " .
3134                                         "PostScript interpreter\n";
3135                                 }
3136                             }
3137                         } else {
3138                             # This option is unknown to us.  WTF?
3139                             print $logh "Unknown option $option=$value found " .
3140                                 "in the job\n";
3141                         }
3142                     } elsif (($line =~ m/^\%\%EndFeature/) &&
3143                              ($nestinglevel == 0)) {
3144                         # End of Feature
3145                         $infeature = 0;
3146                         # If the option setting was replaced, it ends here,
3147                         # too, and the next option is not necessarily also
3148                         # replaced.
3149                         $optionreplaced = 0;
3150                         $linesafterlastbeginfeature = "";
3151                     } elsif (($line =~ m/^\%\%Begin/) &&
3152                              ($isdscjob) &&
3153                              (!$prologfound) &&
3154                              ($nestinglevel == 0)) {
3155                         # In some PostScript files (especially when generated
3156                         # by "dvips" of TeX/LaTeX) the "%%BeginProlog" is
3157                         # missing, so assume that it was before the current
3158                         # line (the first line starting with "%%Begin".
3159                         print $logh "Job claims to be DSC-conforming, but " . 
3160                             "\"%%BeginProlog\" was missing before first " .
3161                             "line with another \"%%Begin...\" comment " .
3162                             "(is this a TeX/LaTeX/dvips-generated PostScript " .
3163                             "file?). Assuming start of \"Prolog\" here.\n";
3164                         # Beginning of Prolog
3165                         $inprolog = 1;
3166                         $nondsclines = 0;
3167                         # Insert options for "Prolog" before the current line
3168                         if (!$prologfound) {
3169                             $line =
3170                                 "%%BeginProlog\n" .
3171                                 makeprologsection($dat, $optionset, 0) .
3172                                 $line;
3173                         }
3174                         $prologfound = 1;
3175                     } elsif (($line =~ m/^\s*\%(\%?)RBINumCopies:\s*(\d+)\s*$/) &&
3176                              ($nestinglevel == 0)) {
3177                         # RBINumCopies entry
3178                         $rbinumcopies = $2;
3179                         print $logh "Found: %${1}RBINumCopies: $rbinumcopies\n";
3180                     } elsif (($line =~ m/^\s*\%/) || ($line =~ m/^\s*$/)) {
3181                         # This is an unknown PostScript comment or a blank
3182                         # line, no active code
3183                         $ignoreline = 1;
3184                     }
3185                 } else {
3186                     # This line is active PostScript code
3187                     if ($infeature) {
3188                         # Collect coe in a "%%BeginFeature: ... %%EndFeature"
3189                         # section, to get the values for a custom option
3190                         # setting
3191                         $linesafterlastbeginfeature .= $line;
3192                     }
3193                     if ($inheader) {
3194                         if ((!$inprolog) && (!$insetup)) {
3195                             # Outside the "Prolog" and "Setup" section
3196                             # a correct DSC-conforming document has no
3197                             # active PostScript code, so consider the
3198                             # file as non-DSC-conforming when there are
3199                             # too many of such lines.
3200                             $nondsclines ++;
3201                             if ($nondsclines > $maxnondsclinesinheader) {
3202                                 # Consider document as not DSC-conforming
3203                                 print $logh "This job seems not to be " .
3204                                     "DSC-conforming, DSC-comment for " .
3205                                     "next section not found, stopping " .
3206                                     "to parse the rest, passing it " .
3207                                     "directly to the renderer.\n";
3208                                 # Stop scanning for further option settings
3209                                 $maxlines = 1;
3210                                 $isdscjob = 0;
3211                                 # Insert defaults and command line settings
3212                                 # in the beginning of the job or after the
3213                                 # last valid section
3214                                 splice(@psheader, $insertoptions, 0,
3215                                        ($prologfound ? () :
3216                                         makeprologsection($dat, $optionset, 
3217                                                           1)),
3218                                        ($setupfound ? () :
3219                                         makesetupsection($dat, $optionset,
3220                                                          1)),
3221                                        ($pagesetupfound ? () :
3222                                         makepagesetupsection($dat,
3223                                                              $optionset, 
3224                                                              1)));
3225                                 $prologfound = 1;
3226                                 $setupfound = 1;
3227                                 $pagesetupfound = 1;
3228                             }
3229                         }
3230                     } else {
3231                         if (!$inpageheader) {
3232                             # PostScript code inside a page, but not between
3233                             # "%%BeginPageSetup" and "%%EndPageSetup", so 
3234                             # we are perhaps already drawing onto a page now
3235                             if ($onelinebefore =~ m/^\%\%Page:/) {
3236                                 print $logh "No page header or page " .
3237                                     "header not DSC-conforming\n";
3238                             }
3239                             # Stop buffering lines to search for options 
3240                             # placed not DSC-conforming
3241                             if (scalar(@psfifo) >= 
3242                                 $maxlinesforpageoptions) {
3243                                 print $logh "Stopping search for " .
3244                                     "page header options\n";
3245                                 $passthru = 1;
3246                                 # If there comes a page header now, ignore 
3247                                 # it
3248                                 $ignorepageheader = 1;
3249                                 $optionsalsointoheader = 0;
3250                             }
3251                             # Insert PostScript option settings
3252                             # (options for section "PageSetup".
3253                             if ($isdscjob && !$pagesetupfound) {
3254                                 $line .= 
3255                                     makepagesetupsection($dat, $optionset,
3256                                                          1);
3257                                 $pagesetupfound = 1;
3258                             }
3259                         }
3260                     }
3261                 }
3262             }
3263             
3264             # Debug info
3265             if ($lastpassthru != $passthru) {
3266                 if ($passthru) {
3267                     print $logh "Found: $line" . 
3268                         " --> Output goes directly to the renderer now.\n${added_lf}";
3269                 } else {
3270                     print $logh "Found: $line" . 
3271                         " --> Output goes to the FIFO buffer now.${added_lf}\n";
3272                 }
3273             }
3274
3275             # We are in an option which was replaced, do not output
3276             # the current line.
3277             if ($optionreplaced) {
3278                 $line = "";
3279             }
3280
3281             # If we are in a "%%BeginSetup...%%EndSetup" section after
3282             # the first "%%Page:..." and the current line belongs to
3283             # an option setting, we have to copy the line also to the
3284             # @psheader.
3285             if (($optionsalsointoheader) && 
3286                 (($infeature) || ($line =~ m/^\%\%EndFeature/))) {
3287                 push (@psheader, $line);
3288             }
3289
3290             # Store or send the current line
3291             if (($inheader) && ($isdscjob)) {
3292                 # We are still in the PostScript header, collect all lines 
3293                 # in @psheader
3294                 push (@psheader, $line);
3295             } else {
3296                 if (($passthru) && ($isdscjob)) {
3297                     if (!$lastpassthru) {
3298                         # We enter passthru mode with this line, so the
3299                         # command line can have changed, check it and
3300                         # close the renderer if needed
3301                         if (($rendererpid) &&
3302                             (!optionsequal($dat, 'currentpage',
3303                                            'previouspage', 0))) {
3304                             print $logh "Command line/JCL options " .
3305                                 "changed, restarting renderer\n";
3306                             $retval = closerendererhandle
3307                                 ($rendererhandle, $rendererpid);
3308                             if ($retval != $EXIT_PRINTED) {
3309                                 rip_die ("Error closing renderer",
3310                                          $retval);
3311                             }
3312                             $rendererpid = 0;
3313                         }
3314                     }
3315                     # Flush @psfifo and send line directly to the renderer
3316                     if (!$rendererpid) {
3317                         # No renderer running, start it
3318                         ($rendererhandle, $rendererpid) =
3319                             getrendererhandle
3320                             ($dat, join('', @psheader, @psfifo));
3321                         if ($retval != $EXIT_PRINTED) {
3322                             rip_die ("Error opening renderer",
3323                                      $retval);
3324                         }
3325                         # @psfifo is sent out, flush it.
3326                         @psfifo = ();
3327                     }
3328                     if ($#psfifo >= 0) {
3329                         # Send @psfifo to renderer
3330                         print $rendererhandle join('', @psfifo);
3331                         # flush @psfifo
3332                         @psfifo = ();
3333                     }
3334                     # Send line to renderer
3335                     if (!$printprevpage) {
3336                         print $rendererhandle $line;
3337                         
3338                         while ($line=<STDIN>)
3339                         {
3340                           if ($line =~ /^\%\%[A-Za-z\s]{3,}/) {
3341                             print $logh "Found: $line" . 
3342                                         " --> Continue DSC parsing now.${added_lf}\n";
3343                             $saved = 1;
3344                             last;
3345                           } else {
3346                             print $rendererhandle $line;
3347                             $linect++;
3348                           }  
3349                         }
3350                     }
3351                 } else {
3352                     # Push the line onto the stack for later spitting up...
3353                     push (@psfifo, $line);
3354                 }
3355             }
3356             
3357             if (!$printprevpage) {
3358                 $linect++;
3359             }
3360
3361         } else {
3362             # EOF!
3363             $more_stuff = 0;
3364             # No PostScript header in the whole file? Then it's not
3365             # PostScript, convert it.
3366             # We open the file converter here when the file has less
3367             # lines than the amount which we search for the PostScript
3368             # header ($maxlinestopsstart).
3369             if ($linect <= $nonpslines) {
3370                 # This is not a PostScript job, we must convert it
3371                 print $logh "${added_lf}Job does not start with \"%!\", " . 
3372                     "is it PostScript?\n" .
3373                     "Starting file converter\n";
3374                 # Reset all variables but conserve the data which
3375                 # we have already read.
3376                 $jobhasjcl = 0;
3377                 $linect = 0;
3378                 $nonpslines = 0;
3379                 $maxlines = 1000;
3380                 $onelinebefore = "";
3381                 $twolinesbefore = "";
3382                 my $alreadyread = join('', @psheader, @psfifo);
3383                 @psheader = ();
3384                 @psfifo = ();
3385                 $line = "";
3386                 # Start the file conversion filter
3387                 if (!$fileconverterpid) {
3388                     ($fileconverterhandle, $fileconverterpid) =
3389                         getfileconverterhandle($dat, $alreadyread);
3390                     if ( defined($retval) and $retval != $EXIT_PRINTED) {
3391                         rip_die ("Error opening file converter",
3392                                  $retval);
3393                     }
3394                 } else {
3395                     rip_die("File conversion filter probably " .
3396                             "crashed",
3397                             $EXIT_JOBERR);
3398                 }
3399                 # Read the further data from the file converter and
3400                 # not from STDIN
3401                 if (!close STDIN && $! != $ESPIPE) {
3402                     rip_die ("Couldn't close STDIN",
3403                              $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
3404                 }
3405                 if (!open (STDIN, "<&$fileconverterhandle")) {
3406                     rip_die ("Couldn't dup \$fileconverterhandle",
3407                              $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
3408                 }
3409                 # Now we have new (converted) stuff in STDIN, so
3410                 # continue in the loop
3411                 $more_stuff = 1;
3412             }
3413         }
3414
3415         $lastpassthru = $passthru;
3416         
3417         if ((!$ignoreline) && (!$printprevpage)) {
3418             $twolinesbefore = $onelinebefore;
3419             $onelinebefore = $line;
3420         }
3421
3422     } while ((($maxlines == 0) or ($linect < $maxlines)) and
3423              ($more_stuff != 0));
3424
3425     # Some buffer still containing data? Send it out to the renderer.
3426     if (($more_stuff != 0) || ($inheader) || ($#psfifo >= 0)) {
3427         # Flush @psfifo and send the remaining data to the renderer, this
3428         # only happens with non-DSC-conforming jobs or non-Foomatic PPDs
3429         if ($more_stuff) {
3430             print $logh "Stopped parsing the PostScript data, ".
3431                 "sending rest directly to renderer.\n";
3432         } else {
3433             print $logh "Flushing FIFO.\n";
3434         }
3435         if ($inheader) {
3436             # One last update for the header
3437             buildcommandline($dat, $optionset);
3438             # No page initialized yet? Copy the "header" option set into the
3439             # "currentpage" option set, so that the renderer will find the
3440             # options settings.
3441             copyoptions($dat, 'header', 'currentpage');
3442             $optionset = 'currentpage';
3443             # If not done yet, insert defaults and command line settings
3444             # in the beginning of the job or after the last valid section
3445             splice(@psheader, $insertoptions, 0,
3446                    ($prologfound ? () :
3447                     makeprologsection($dat, $optionset, 1)),
3448                    ($setupfound ? () :
3449                     makesetupsection($dat, $optionset, 1)),
3450                    ($pagesetupfound ? () :
3451                     makepagesetupsection($dat, $optionset, 1)));
3452             $prologfound = 1;
3453             $setupfound = 1;
3454             $pagesetupfound = 1;
3455         }
3456         if (($rendererpid) &&
3457             (!optionsequal($dat, 'currentpage',
3458                            'previouspage', 0))) {
3459             print $logh "Command line/JCL options " .
3460                 "changed, restarting renderer\n";
3461             $retval = closerendererhandle
3462                 ($rendererhandle, $rendererpid);
3463             if ($retval != $EXIT_PRINTED) {
3464                 rip_die ("Error closing renderer",
3465                          $retval);
3466             }
3467             $rendererpid = 0;
3468         }
3469         if (!$rendererpid) {
3470             ($rendererhandle, $rendererpid) =
3471                 getrendererhandle($dat, join('', @psheader, @psfifo));
3472             if ($retval != $EXIT_PRINTED) {
3473                 rip_die ("Error opening renderer",
3474                          $retval);
3475             }
3476             # We have sent @psfifo now
3477             @psfifo = ();
3478         }
3479         if ($#psfifo >= 0) {
3480             # Send @psfifo to renderer
3481             print $rendererhandle join('', @psfifo);
3482             # flush @psfifo
3483             @psfifo = ();
3484         }
3485         # Print the rest of the input data
3486         if ($more_stuff) {
3487             while (<STDIN>) {
3488                 print $rendererhandle $_;
3489             }
3490         }
3491     }
3492
3493     # At every "%%Page:..." comment we have saved the PostScript state
3494     # and we have increased the page number. So if the page number is
3495     # non-zero we had at least one "%%Page:..." comment and so we have
3496     # to give a restore the PostScript state.
3497     #if ($currentpage > 0) {
3498     #    print $rendererhandle "foomatic-saved-state restore\n";
3499     #}
3500     
3501     # Close the renderer
3502     if ($rendererpid) {
3503         $retval = closerendererhandle ($rendererhandle, $rendererpid);
3504         if ($retval != $EXIT_PRINTED) {
3505             rip_die ("Error closing renderer",
3506                      $retval);
3507         }
3508         $rendererpid = 0;
3509     }
3510
3511     # Close the file converter (if it was used)
3512     if ($fileconverterpid) {
3513         $retval = closefileconverterhandle
3514             ($fileconverterhandle, $fileconverterpid);
3515         if ($retval != $EXIT_PRINTED) {
3516             rip_die ("Error closing file converter",
3517                      $retval);
3518         }
3519         $fileconverterpid = 0;
3520     }
3521 }
3522
3523
3524 ## Close the documentation page generator
3525 if ($docgeneratorpid) {
3526     $retval = closedocgeneratorhandle
3527         ($docgeneratorhandle, $docgeneratorpid);
3528     if ($retval != $EXIT_PRINTED) {
3529         rip_die ("Error closing documentation page generator",
3530                  $retval);
3531     }
3532     $docgeneratorpid = 0;
3533 }
3534
3535
3536
3537 ## Close last input file
3538 close STDIN;
3539
3540
3541
3542 ## Only for debugging
3543 if ($debug && 1) {
3544     use Data::Dumper;
3545     local $Data::Dumper::Purity=1;
3546     local $Data::Dumper::Indent=1;
3547     print $logh Dumper($dat);
3548 }
3549
3550
3551
3552 ## The End
3553 print $logh "${added_lf}Closing foomatic-rip.\n";
3554 close $logh;
3555
3556 exit $retval;
3557
3558
3559
3560 ## Functions to let foomatic-rip fork to do several tasks in parallel.
3561
3562 # To do the filtering without loading the whole file into memory we work
3563 # on a data stream, we read the data line by line analyse it to decide what
3564 # filters to use and start the filters if we have found out which we need.
3565 # We buffer the data only as long as we didn't determing which filters to
3566 # use for this piece of data and with which options. There are no temporary
3567 # files used.
3568
3569 # foomatic-rip splits into up to 6 parallel processes to do the whole
3570 # filtering (listed in the order of the data flow):
3571
3572 #    KID0: Generate documentation pages (only jobs with "docs" option)
3573 #    KID2: Put together already read data and current input stream for
3574 #          feeding into the file conversion filter (only non-PostScript
3575 #          and "docs" jobs)
3576 #    KID1: Run the file conversion filter to convert non-PostScript
3577 #          input into PostScript (only non-PostScript and "docs" jobs)
3578 #    MAIN: Prepare the job auto-detecting the spooler, reading the PPD,
3579 #          extracting the options from the command line, and parsing
3580 #          the job data itself. It analyses the job data to check
3581 #          whether it is PostScript and starts KID1/KID2 if not, it
3582 #          also stuffs PostScript code from option settings into the
3583 #          PostScript data stream. It starts the renderer (KID3/KID4)
3584 #          as soon as it knows its command line and restarts it when
3585 #          page-specific option settings need another command line
3586 #          or different JCL commands.
3587 #    KID3: The rendering process. In most cases GhostScript, "cat"
3588 #          for native PostScript printers with their manufacturer's
3589 #          PPD files.
3590 #    KID4: Put together the JCL commands and the renderer's output
3591 #          and send all that either to STDOUT or pipe it into the
3592 #          command line defined with $postpipe.
3593
3594 ## This function runs the renderer command line (and if defined also
3595 ## the postpipe) and returns a file handle for stuffing in the
3596 ## PostScript data.
3597 sub getrendererhandle {
3598
3599     my ($dat, $prepend) = @_;
3600
3601     print $logh "${added_lf}Starting renderer\n";
3602
3603     # Reset return value of the renderer
3604     $retval = $EXIT_PRINTED;
3605
3606     # Set up a pipe for the kids to pass their exit stat to the main process
3607     pipe KID_MESSAGE, KID_MESSAGE_IN;
3608
3609     # When one kid fails put the exit stat here
3610     $kidfailed = 0;
3611
3612     # When a kid exits successfully, mark it here
3613     $kid3finished = 0;
3614     $kid4finished = 0;
3615
3616     # Build the command line and get the JCL commands
3617     buildcommandline($dat, 'currentpage');
3618     my $commandline = $dat->{'currentcmd'};
3619     my @jclprepend = @{$dat->{'jclprepend'}} if defined $dat->{'jclprepend'};
3620     my @jclappend  = @{$dat->{'jclappend'}}  if defined $dat->{'jclappend'};
3621
3622     use IO::Handle;
3623     pipe KID3_IN, KID3;
3624     KID3->autoflush(1);
3625     $kid3 = fork();
3626     if (!defined($kid3)) {
3627         close KID3;
3628         close KID3_IN;
3629         print $logh "$0: cannot fork for kid3!\n";
3630         rip_die ("can't fork for kid3",
3631                  $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
3632     }
3633     if ($kid3) {
3634
3635         # we are the parent; return a glob to the filehandle
3636         close KID3_IN;
3637
3638         # Feed in the PostScript header and the FIFO contents
3639         print KID3 $prepend;
3640
3641         KID3->flush();
3642         return ( *KID3, $kid3 );
3643
3644     } else {
3645         $kidgeneration += 1;
3646
3647         close KID3;
3648
3649         $SIG{PIPE} = 'DEFAULT';
3650         pipe KID4_IN, KID4;
3651         KID4->autoflush(1);
3652         $kid4 = fork();
3653         if (!defined($kid4)) {
3654             close KID4;
3655             close KID4_IN;
3656             print $logh "$0: cannot fork for kid4!\n";
3657             close KID_MESSAGE;
3658             print KID_MESSAGE_IN "3 $EXIT_PRNERR_NORETRY_BAD_SETTINGS\n";
3659             close KID_MESSAGE_IN;
3660             rip_die ("can't fork for kid4",
3661                      $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
3662         }
3663         
3664         if ($kid4) {
3665             # parent, child of primary task; we are |commandline|
3666             close KID4_IN;
3667
3668             print $logh "renderer PID kid4=$kid4\n";
3669             print $logh "renderer command: $commandline\n";
3670             
3671             if (!close STDIN && $! != $ESPIPE) {
3672                 close KID3_IN;
3673                 close KID4;
3674                 close KID_MESSAGE;
3675                 print KID_MESSAGE_IN
3676                     "3 $EXIT_PRNERR_NORETRY_BAD_SETTINGS\n";
3677                 close KID_MESSAGE_IN;
3678                 rip_die ("Couldn't close STDIN in $kid4",
3679                          $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
3680             }
3681             if (!open (STDIN, "<&KID3_IN")) {
3682                 close KID3_IN;
3683                 close KID4;
3684                 close KID_MESSAGE;
3685                 print KID_MESSAGE_IN
3686                     "3 $EXIT_PRNERR_NORETRY_BAD_SETTINGS\n";
3687                 close KID_MESSAGE_IN;
3688                 rip_die ("Couldn't dup KID3_IN",
3689                          $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
3690             }
3691             if (!close STDOUT) {
3692                 close KID3_IN;
3693                 close KID4;
3694                 close KID_MESSAGE;
3695                 print KID_MESSAGE_IN
3696                     "3 $EXIT_PRNERR_NORETRY_BAD_SETTINGS\n";
3697                 close KID_MESSAGE_IN;
3698                 rip_die ("Couldn't close STDOUT in $kid4",
3699                          $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
3700             }
3701             if (!open (STDOUT, ">&KID4")) {
3702                 close KID3_IN;
3703                 close KID4;
3704                 close KID_MESSAGE;
3705                 print KID_MESSAGE_IN
3706                     "3 $EXIT_PRNERR_NORETRY_BAD_SETTINGS\n";
3707                 close KID_MESSAGE_IN;
3708                 rip_die ("Couldn't dup KID4",
3709                          $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
3710             }
3711             if ($debug) {
3712                 if (!open (STDERR, ">&$logh")) {
3713                     close KID3_IN;
3714                     close KID4;
3715                     close KID_MESSAGE;
3716                     print KID_MESSAGE_IN
3717                         "3 $EXIT_PRNERR_NORETRY_BAD_SETTINGS\n";
3718                     close KID_MESSAGE_IN;
3719                     rip_die ("Couldn't dup logh to stderr",
3720                              $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
3721                 }
3722             }
3723
3724             # Massage commandline to execute foomatic-gswrapper
3725             my $havewrapper = 0;
3726             for (split(':', $ENV{'PATH'})) {
3727                 if (-x "$_/foomatic-gswrapper") {
3728                     $havewrapper=1;
3729                     last;
3730                 }
3731             }
3732             if ($havewrapper) {
3733                 $commandline =~ s!^\s*gs\s!foomatic-gswrapper !g;
3734                 $commandline =~ s!(\|\s*)gs\s!\|foomatic-gswrapper !g;
3735                 $commandline =~ s!(;\s*)gs\s!; foomatic-gswrapper !g;
3736             }
3737
3738             # If the renderer command line contains the "echo"
3739             # command, replace the "echo" by the user-chosen $myecho
3740             # (important for non-GNU systems where GNU echo is in a
3741             # special path
3742             $commandline =~ s!^\s*echo\s!$myecho !g;
3743             $commandline =~ s!(\|\s*)echo\s!\|$myecho !g;
3744             $commandline =~ s!(;\s*)echo\s!; $myecho !g;
3745
3746             # In debug mode save the data supposed to be fed into the
3747             # renderer also into a file
3748             if ($debug) {
3749                 $commandline = "tee -a ${logfile}.ps | ( $commandline )";
3750             }
3751             
3752             # Actually run the thing...
3753             modern_system("$commandline");
3754             if ($? != 0) {
3755                 my $rendererretval = $? >> 8;
3756                 print $logh "renderer return value: $rendererretval\n";
3757                 my $renderersignal = $? & 127;
3758                 print $logh "renderer received signal: $rendererretval\n";
3759                 close STDOUT;
3760                 close KID4;
3761                 close STDIN;
3762                 close KID3_IN;
3763                 # Handle signals
3764                 if ($renderersignal == SIGUSR1) {
3765                     $retval = $EXIT_PRNERR;
3766                 } elsif ($renderersignal == SIGUSR2) {
3767                     $retval = $EXIT_PRNERR_NORETRY;
3768                 } elsif ($renderersignal == SIGTTIN) {
3769                     $retval = $EXIT_ENGAGED;
3770                 }
3771                 if ($retval != $EXIT_PRINTED) {
3772                     close KID_MESSAGE;
3773                     print KID_MESSAGE_IN "3 $retval\n";
3774                     close KID_MESSAGE_IN;
3775                     exit $retval;
3776                 }
3777                 # Evaluate renderer result
3778                 if ($rendererretval == 0) {
3779                     # Success, exit with 0 and inform main process
3780                     close KID_MESSAGE;
3781                     print KID_MESSAGE_IN "3 $EXIT_PRINTED\n";
3782                     close KID_MESSAGE_IN;
3783                     exit $EXIT_PRINTED;
3784                 } elsif ($rendererretval == 1) {
3785                     # Syntax error? PostScript error?
3786                     close KID_MESSAGE;
3787                     print KID_MESSAGE_IN "3 $EXIT_JOBERR\n";
3788                     close KID_MESSAGE_IN;
3789                     rip_die ("Possible error on renderer command line or PostScript error. Check options.",
3790                              $EXIT_JOBERR);
3791                 } elsif ($rendererretval == 139) {
3792                     # Seems to indicate a core dump
3793                     close KID_MESSAGE;
3794                     print KID_MESSAGE_IN "3 $EXIT_JOBERR\n";
3795                     close KID_MESSAGE_IN;
3796                     rip_die ("The renderer may have dumped core.",
3797                              $EXIT_JOBERR);
3798                 } elsif ($rendererretval == 141) {
3799                     # Broken pipe, presumably additional filter interface
3800                     # exited.
3801                     close KID_MESSAGE;
3802                     print KID_MESSAGE_IN "3 $EXIT_PRNERR\n";
3803                     close KID_MESSAGE_IN;
3804                     rip_die ("A filter used in addition to the renderer" .
3805                              " itself may have failed.",
3806                              $EXIT_PRNERR);
3807                 } elsif (($rendererretval == 243) || ($retval == 255)) {
3808                     # PostScript error?
3809                     close KID_MESSAGE;
3810                     print KID_MESSAGE_IN "3 $EXIT_JOBERR\n";
3811                     close KID_MESSAGE_IN;
3812                     exit $EXIT_JOBERR;
3813                 } else {
3814                     # Unknown error
3815                     close KID_MESSAGE;
3816                     print KID_MESSAGE_IN "3 $EXIT_PRNERR\n";
3817                     close KID_MESSAGE_IN;
3818                     rip_die ("The renderer command line returned an" .
3819                              " unrecognized error code $rendererretval.",
3820                              $EXIT_PRNERR);
3821                 }
3822             }
3823             close STDOUT;
3824             close KID4;
3825             close STDIN;
3826             close KID3_IN;
3827             # When arrived here the renderer command line was successful
3828             # So exit with zero exit value here and inform the main process
3829             close KID_MESSAGE;
3830             # Wait for postpipe/output child
3831             waitpid($kid4, 0);
3832             if ($? != 0) {
3833                 print KID_MESSAGE_IN "3 $EXIT_SIGNAL\n";
3834             } else {
3835                 print KID_MESSAGE_IN "3 $EXIT_PRINTED\n";
3836             }
3837             close KID_MESSAGE_IN;
3838             print $logh "KID3 finished with $?\n";
3839             exit $EXIT_PRINTED;
3840         } else {
3841             $kidgeneration += 1;
3842
3843             # child, trailing task on the pipe; we write jcl stuff
3844             close KID4;
3845             close KID3_IN;
3846
3847             my $fileh = *STDOUT;
3848
3849             # Do we have a $postpipe, if yes, launch the command(s) and
3850             # point our output into it/them
3851             if ($postpipe) {
3852                 if (!open PIPE,$postpipe) {
3853                     close KID4_IN;
3854                     close KID_MESSAGE;
3855                     print KID_MESSAGE_IN
3856                         "4 $EXIT_PRNERR_NORETRY_BAD_SETTINGS\n";
3857                     close KID_MESSAGE_IN;
3858                     rip_die ("cannot execute postpipe $postpipe",
3859                              $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
3860                 }
3861                 $fileh = *PIPE;
3862             }
3863
3864             # Debug output
3865             print $logh "JCL: " . join("", @jclprepend) . "<job data> ${added_lf}" .
3866                 join("", @jclappend) . "\n";
3867
3868             # wrap the JCL around the job data, if there are any
3869             # options specified...
3870             # Should the driver already have inserted JCL commands we merge
3871             # our JCL header with the one from the driver
3872             my $driverjcl = 0;
3873             if ( @jclprepend > 1 ) {
3874                 # JCL header read from renderer output
3875                 my @jclheader = ();
3876                 # Determine magic string of JCL in use (usually "@PJL")
3877                 # For that we take the first part of the second JCL line up
3878                 # to the first space
3879                 if ($jclprepend[1] =~ /^(\S+)/) {
3880                     my $jclstr = $1;
3881                     # Read from the renderer output until the first non-JCL
3882                     # line appears
3883                     while (my $line = <KID4_IN>) {
3884                         push(@jclheader, $line);
3885                         last if ($line !~ /$jclstr/);
3886                     }
3887                     # If we had read at least two lines, at least one is
3888                     # a JCL header, so do the merging
3889                     if (@jclheader > 1) {
3890                         $driverjcl = 1;
3891                         # Discard the first and the last entry of the
3892                         # @jclprepend array, we only need the option settings
3893                         # to merge them in
3894                         pop(@jclprepend);
3895                         shift(@jclprepend);
3896                         # Line after which we insert new JCL commands in the
3897                         # JCL header of the job
3898                         my $insert = 1;
3899                         # Go through every JCL command in @jclprepend
3900                         for my $line (@jclprepend) {
3901                             # Search the command in the JCL header from the
3902                             # driver. As search term use only the string from
3903                             # the beginning of the line to the "=", so the
3904                             # command will also be found when it has another
3905                             # value
3906                             $line =~ /^([^=]+)/;
3907                             my $cmd = $1;
3908                             $cmd =~ s/^\s*(.*?)\s*$/$1/;
3909                             my $cmdfound = 0;
3910                             for (@jclheader) {
3911                                 # If the command is there, replace it
3912                                 $_ =~ s/$cmd\b.*(\r\n|\n|\r)/$line/ and 
3913                                     $cmdfound = 1;
3914                             }
3915                             if (!$cmdfound) {
3916                                 # If the command is not found, insert it
3917                                 if (@jclheader > 2) {
3918                                     # @jclheader has more than one line,
3919                                     # insert the new command beginning
3920                                     # right after the first line and continuing
3921                                     # after the previous inserted command
3922                                     splice(@jclheader, $insert, 0, $line);
3923                                     $insert ++;
3924                                 } else {
3925                                     # If we have only one line of JCL it
3926                                     # is probably something like the
3927                                     # "@PJL ENTER LANGUAGE=..." line
3928                                     # which has to be in the end, but
3929                                     # it also contains the
3930                                     # "<esc>%-12345X" which has to be in the
3931                                     # beginning of the job. So we split the
3932                                     # line right before the $jclstr and
3933                                     # append our command to the end of the
3934                                     # first part and let the second part
3935                                     # be a second JCL line.
3936                                     $jclheader[0] =~ 
3937                                         /^(.*?)($jclstr.*(\r\n|\n|\r))/;
3938                                     my $first = "$1$line";
3939                                     my $second = "$2";
3940                                     my $third = $jclheader[1];
3941                                     @jclheader = ($first, $second, $third);
3942                                 }
3943                             }
3944                         }
3945                         # Now pass on the merged JCL header
3946                         print $fileh @jclheader;
3947                     } else {
3948                         # The driver didn't create a JCL header, simply
3949                         # prepend ours and then pass on the line which we
3950                         # already have read
3951                         print $fileh @jclprepend, @jclheader;
3952                     }
3953                 } else {
3954                     # No merging of JCL header possible, simply prepend it
3955                     print $fileh @jclprepend;
3956                 }
3957             }
3958
3959             # The rest of the job data
3960             my $buf;
3961             while (read(KID4_IN, $buf, 1024)) {
3962                 print $fileh $buf;
3963             }
3964
3965             # A JCL trailer
3966             if (( @jclprepend > 1 ) && (!$driverjcl)) {
3967                 print $fileh @jclappend;
3968             }
3969             
3970             if (!close $fileh) {
3971                 close KID4_IN;
3972                 close KID_MESSAGE;
3973                 print KID_MESSAGE_IN
3974                     "4 $EXIT_PRNERR_NORETRY_BAD_SETTINGS\n";
3975                 close KID_MESSAGE_IN;
3976                 rip_die ("error closing $fileh",
3977                          $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
3978             }
3979             close KID4_IN;
3980
3981             print $logh "tail process done writing data to STDOUT\n";
3982
3983             # Handle signals of the backend interface
3984             if ($retval != $EXIT_PRINTED) {
3985                 close KID_MESSAGE;
3986                 print KID_MESSAGE_IN "4 $retval\n";
3987                 close KID_MESSAGE_IN;
3988                 exit $retval;
3989             }
3990
3991             # Successful exit, inform main process
3992             close KID_MESSAGE;
3993             print KID_MESSAGE_IN "4 $EXIT_PRINTED\n";
3994             close KID_MESSAGE_IN;
3995
3996             print $logh "KID4 finished\n";
3997             exit($EXIT_PRINTED);
3998         }
3999     }
4000 }
4001
4002
4003
4004 ## Close the renderer process and wait until all kid processes finish.
4005
4006 sub closerendererhandle {
4007
4008     my ($rendererhandle, $rendererpid) = @_;
4009
4010     print $logh "${added_lf}Closing renderer\n";
4011
4012     # Do it!
4013     close $rendererhandle;
4014
4015     # Wait for all kid processes to finish or one kid process to fail
4016     close KID_MESSAGE_IN;
4017     while ((!$kidfailed) &&
4018            !(($kid3finished) &&
4019              ($kid4finished))) {
4020         my $message = <KID_MESSAGE>;
4021         chomp $message;
4022         if ($message =~ /(\d+)\s+(\d+)/) {
4023             my $kid_id = $1;
4024             my $exitstat = $2;
4025             print $logh "KID$kid_id exited with status $exitstat\n";
4026             if ($exitstat > 0) {
4027                 $kidfailed = $exitstat;
4028             } elsif ($kid_id == 3) {
4029                 $kid3finished = 1;
4030             } elsif ($kid_id == 4) {
4031                 $kid4finished = 1;
4032             }
4033         }
4034     }
4035
4036     close KID_MESSAGE;
4037
4038     # If a kid failed, return the exit stat of this kid
4039     if ($kidfailed != 0) {
4040         $retval = $kidfailed;
4041     }
4042
4043     print $logh "Renderer exit stat: $retval\n";
4044     # Wait for renderer child
4045     waitpid($rendererpid, 0);
4046     print $logh "Renderer process finished\n";
4047     return ($retval);
4048 }
4049
4050
4051
4052 ## This function is only used when the input data is not
4053 ## PostScript. Then it runs a filter which converts non-PostScript
4054 ## files into PostScript. The user can choose which filter he wants
4055 ## to use. The filter command line is provided by $fileconverter.
4056
4057 sub getfileconverterhandle {
4058
4059     # Already read data must be converted, too
4060     my ($dat, $alreadyread) = @_;
4061
4062     print $logh "${added_lf}Starting converter for non-PostScript files\n";
4063
4064     # Determine with which command non-PostScript files are converted
4065     # to PostScript
4066     if ($fileconverter eq "") {
4067         if ($spoolerfileconverters->{$spooler}) {
4068             $fileconverter = $spoolerfileconverters->{$spooler};
4069         } else {
4070             for my $c (@fileconverters) {
4071                 ($c =~ m/^\s*(\S+)\s+/) || ($c = m/^\s*(\S+)$/);
4072                 my $command = $1;
4073                 if( -x $command ){
4074                     $fileconverter = $command;
4075                 } else {
4076                 for (split(':', $ENV{'PATH'})) {
4077                     if (-x "$_/$command") {
4078                         $fileconverter = $c;
4079                         last;
4080                     }
4081                 }
4082                 }
4083                 if ($fileconverter ne "") {
4084                     last;
4085                 }
4086             }
4087         }
4088         if ($fileconverter eq "") {
4089             $fileconverter = "echo \"Cannot convert file to " .
4090                 "PostScript!\" 1>&2";
4091         }
4092     }
4093
4094     # Insert the page size into the $fileconverter
4095     if ($fileconverter =~ /\@\@([^@]+)\@\@PAGESIZE\@\@/) {
4096         # We always use the "header" option swt here, with a
4097         # non-PostScript file we have no "currentpage"
4098         my $optstr = $1;
4099         my $arg;
4100         my $sizestr = (($arg = $dat->{'args_byname'}{'PageSize'})
4101                        ? $arg->{'header'}
4102                        : "");
4103         if ($sizestr) {
4104             # Use wider margins so that the pages come out completely on
4105             # every printer model (especially HP inkjets)
4106             if ($fileconverter =~ /^\s*(a2ps)\s+/) {
4107                 if (lc($sizestr) eq "letter") {
4108                     $sizestr = "Letterdj";
4109                 } elsif (lc($sizestr) eq "a4") {
4110                     $sizestr = "A4dj";
4111                 }
4112             }
4113             $optstr .= $sizestr;
4114         } else {
4115             $optstr = "";
4116         }
4117         $fileconverter =~ s/\@\@([^@]+)\@\@PAGESIZE\@\@/$optstr/;
4118     }
4119
4120     # Insert the job title into the $fileconverter
4121     if ($fileconverter =~ /\@\@([^@]+)\@\@JOBTITLE\@\@/) {
4122         if ($do_docs) {
4123             $jobtitle =
4124                 "Documentation for the $model";
4125         }
4126         my $titlearg = $1;
4127         my ($arg, $optstr);
4128         ($arg = $jobtitle) =~ s/\"/\\\"/g;
4129         if (($titlearg =~ /\"/) || $arg) {
4130             $optstr = $titlearg . ($titlearg =~ /\"/ ? '' : '"') .
4131                 ($arg ? "$arg\"" : '"');
4132         } else {
4133             $optstr = "";
4134         }
4135         $fileconverter =~ s/\@\@([^@]+)\@\@JOBTITLE\@\@/$optstr/;
4136     }
4137
4138     # Apply "pstops" when having used a file converter under CUPS, so
4139     # CUPS can stuff the default settings into the PostScript output
4140     # of the file converter (so all CUPS settings get also applied when
4141     # one prints the documentation pages (all other files we get
4142     # already converted to PostScript by CUPS).
4143     if ($spooler eq 'cups') {
4144         $fileconverter .=
4145             " | ${programdir}pstops '$rargs[0]' '$rargs[1]' '$rargs[2]' " .
4146             "'$rargs[3]' '$rargs[4]'";
4147     }
4148
4149     # Variables for the kid processes reporting their state
4150
4151     # Set up a pipe for the kids to pass their exit stat to the main process
4152     pipe KID_MESSAGE_CONV, KID_MESSAGE_CONV_IN;
4153
4154     # When one kid fails put the exit stat here
4155     $convkidfailed = 0;
4156
4157     # When a kid exits successfully, mark it here
4158     $kid1finished = 0;
4159     $kid2finished = 0;
4160
4161     use IO::Handle;
4162     pipe KID1_IN, KID1;
4163     KID1->autoflush(1);
4164     my $kid1 = fork();
4165     if (!defined($kid1)) {
4166         close KID1;
4167         close KID1_IN;
4168         print $logh "$0: cannot fork for kid1!\n";
4169         rip_die ("can't fork for kid1",
4170                  $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
4171     }
4172
4173     if ($kid1) {
4174
4175         # we are the parent; return a glob to the filehandle
4176         close KID1;
4177
4178         return ( *KID1_IN, $kid1 );
4179
4180     } else {
4181         $kidgeneration += 1;
4182
4183         # We go on reading the job data and stuff it into the file
4184         # converter
4185         close KID1_IN;
4186
4187         $SIG{PIPE} = 'DEFAULT';
4188         pipe KID2_IN, KID2;
4189         KID2->autoflush(1);
4190         $kid2 = fork();
4191         if (!defined($kid2)) {
4192             print $logh "$0: cannot fork for kid2!\n";
4193             close KID1;
4194             close KID2;
4195             close KID2_IN;
4196             close KID_MESSAGE_CONV;
4197             print KID_MESSAGE_CONV_IN 
4198                 "1 $EXIT_PRNERR_NORETRY_BAD_SETTINGS\n";
4199             rip_die ("can't fork for kid2",
4200                      $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
4201         }
4202         
4203         if ($kid2) {
4204             # parent, child of primary task; we are |$fileconverter|
4205             close KID2;
4206
4207             print $logh "file converter PID kid2=$kid2\n";
4208             if (($debug) || ($spooler ne 'cups')) {
4209                 print $logh "file converter command: $fileconverter\n";
4210             }
4211             
4212             if (!close STDIN && $! != $ESPIPE) {
4213                 close KID1;
4214                 close KID2_IN;
4215                 close KID_MESSAGE_CONV;
4216                 print KID_MESSAGE_CONV_IN 
4217                     "1 $EXIT_PRNERR_NORETRY_BAD_SETTINGS\n";
4218                 close KID_MESSAGE_CONV_IN;
4219                 rip_die ("Couldn't close STDIN in $kid2",
4220                          $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
4221             }
4222             if (!open (STDIN, "<&KID2_IN")) {
4223                 close KID1;
4224                 close KID2_IN;
4225                 close KID_MESSAGE_CONV;
4226                 print KID_MESSAGE_CONV_IN 
4227                     "1 $EXIT_PRNERR_NORETRY_BAD_SETTINGS\n";
4228                 close KID_MESSAGE_CONV_IN;
4229                 rip_die ("Couldn't dup KID2_IN",
4230                          $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
4231             }
4232             if (!close STDOUT) {
4233                 close KID1;
4234                 close KID2_IN;
4235                 close KID_MESSAGE_CONV;
4236                 print KID_MESSAGE_CONV_IN
4237                     "1 $EXIT_PRNERR_NORETRY_BAD_SETTINGS\n";
4238                 close KID_MESSAGE_CONV_IN;
4239                 rip_die ("Couldn't close STDOUT in $kid2",
4240                          $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
4241             }
4242             if (!open (STDOUT, ">&KID1")) {
4243                 close KID1;
4244                 close KID2_IN;
4245                 close KID_MESSAGE_CONV;
4246                 print KID_MESSAGE_CONV_IN
4247                     "1 $EXIT_PRNERR_NORETRY_BAD_SETTINGS\n";
4248                 close KID_MESSAGE_CONV_IN;
4249                 rip_die ("Couldn't dup KID1",
4250                          $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
4251             }
4252             if ($debug) {
4253                 if (!open (STDERR, ">&$logh")) {
4254                     close KID1;
4255                     close KID2_IN;
4256                     close KID_MESSAGE_CONV;
4257                     print KID_MESSAGE_CONV_IN
4258                         "1 $EXIT_PRNERR_NORETRY_BAD_SETTINGS\n";
4259                     close KID_MESSAGE_CONV_IN;
4260                     rip_die ("Couldn't dup logh to stderr",
4261                              $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
4262                 }
4263             }
4264
4265             # Actually run the thing...
4266             modern_system("$fileconverter");
4267             if ($? != 0) {
4268                 my $fileconverterretval = $? >> 8;
4269                 print $logh "file converter return value: " .
4270                     "$fileconverterretval\n";
4271                 my $fileconvertersignal = $? & 127;
4272                 print $logh "file converter received signal: ".
4273                     "$fileconverterretval\n";
4274                 close STDOUT;
4275                 close KID1;
4276                 close STDIN;
4277                 close KID2_IN;
4278                 # Handle signals
4279                 if ($fileconvertersignal == SIGUSR1) {
4280                     $retval = $EXIT_PRNERR;
4281                 } elsif ($fileconvertersignal == SIGUSR2) {
4282                     $retval = $EXIT_PRNERR_NORETRY;
4283                 } elsif ($fileconvertersignal == SIGTTIN) {
4284                     $retval = $EXIT_ENGAGED;
4285                 }
4286                 if ($retval != $EXIT_PRINTED) {
4287                     close KID_MESSAGE_CONV;
4288                     print KID_MESSAGE_CONV_IN "1 $retval\n";
4289                     close KID_MESSAGE_CONV_IN;
4290                     exit $retval;
4291                 }
4292                 # Evaluate fileconverter result
4293                 if ($fileconverterretval == 0) {
4294                     # Success, exit with 0 and inform main process
4295                     close KID_MESSAGE_CONV;
4296                     print KID_MESSAGE_CONV_IN "1 $EXIT_PRINTED\n";
4297                     close KID_MESSAGE_CONV_IN;
4298                     exit $EXIT_PRINTED;
4299                 } else {
4300                     # Unknown error
4301                     close KID_MESSAGE_CONV;
4302                     print KID_MESSAGE_CONV_IN "1 $EXIT_PRNERR\n";
4303                     close KID_MESSAGE_CONV_IN;
4304                     rip_die ("The file converter command line returned " . 
4305                              "an unrecognized error code " .
4306                              "$fileconverterretval.",
4307                              $EXIT_PRNERR);
4308                 }
4309             }
4310             close STDOUT;
4311             close KID1;
4312             close STDIN;
4313             close KID2_IN;
4314             # When arrived here the fileconverter command line was
4315             # successful.
4316             # So exit with zero exit value here and inform the main process
4317             close KID_MESSAGE_CONV;
4318             print KID_MESSAGE_CONV_IN "1 $EXIT_PRINTED\n";
4319             close KID_MESSAGE_CONV_IN;
4320             # Wait for input child
4321             waitpid($kid1, 0);
4322             print $logh "KID1 finished\n";
4323             exit $EXIT_PRINTED;
4324         } else {
4325             $kidgeneration += 1;
4326
4327             # child, first part of the pipe, reading in the data from
4328             # standard input and stuffing it into the file converter
4329             # after putting in the already read data (in $alreadyread)
4330             close KID1;
4331             close KID2_IN;
4332
4333             # At first pass the data which we have already read to the
4334             # filter
4335             print KID2 $alreadyread;
4336             # Then read the rest from standard input
4337             my $buf;
4338             while (read(STDIN, $buf, 1024)) { 
4339                 print KID2 $buf; 
4340             }
4341
4342             if (!close STDIN && $! != $ESPIPE) {
4343                 close KID2;
4344                 close KID_MESSAGE_CONV;
4345                 print KID_MESSAGE_CONV_IN
4346                     "2 $EXIT_PRNERR_NORETRY_BAD_SETTINGS\n";
4347                 close KID_MESSAGE_CONV_IN;
4348                 rip_die ("error closing STDIN",
4349                          $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
4350             }
4351             close KID2;
4352
4353             print $logh "tail process done reading data from STDIN\n";
4354
4355             # Successful exit, inform main process
4356             close KID_MESSAGE_CONV;
4357             print KID_MESSAGE_CONV_IN "2 $EXIT_PRINTED\n";
4358             close KID_MESSAGE_CONV_IN;
4359
4360             print $logh "KID2 finished\n";
4361             exit($EXIT_PRINTED);
4362         }
4363     }
4364 }
4365
4366
4367
4368 ## Close the file conversion process and wait until all kid processes
4369 ## finish.
4370
4371 sub closefileconverterhandle {
4372
4373     my ($fileconverterhandle, $fileconverterpid) = @_;
4374
4375     print $logh "${added_lf}Closing file converter\n";
4376
4377     # Do it!
4378     close $fileconverterhandle;
4379
4380     # Wait for all kid processes to finish or one kid process to fail
4381     close KID_MESSAGE_CONV_IN;
4382     while ((!$convkidfailed) &&
4383            !(($kid1finished) &&
4384              ($kid2finished))) {
4385         my $message = <KID_MESSAGE_CONV>;
4386         chomp $message;
4387         if ($message =~ /(\d+)\s+(\d+)/) {
4388             my $kid_id = $1;
4389             my $exitstat = $2;
4390             print $logh "KID$kid_id exited with status $exitstat\n";
4391             if ($exitstat > 0) {
4392                 $convkidfailed = $exitstat;
4393             } elsif ($kid_id == 1) {
4394                 $kid1finished = 1;
4395             } elsif ($kid_id == 2) {
4396                 $kid2finished = 1;
4397             }
4398         }
4399     }
4400
4401     close KID_MESSAGE_CONV;
4402
4403     # If a kid failed, return the exit stat of this kid
4404     if ($convkidfailed != 0) {
4405         $retval = $convkidfailed;
4406     }
4407
4408     print $logh "File converter exit stat: $retval\n";
4409     # Wait for fileconverter child
4410     waitpid($fileconverterpid, 0);
4411     print $logh "File converter process finished\n";
4412     return ($retval);
4413 }
4414
4415
4416
4417 ## Generate the documentation page and return a filehandle to get it
4418
4419 sub getdocgeneratorhandle {
4420
4421     # The data structure with the options
4422     my ($dat) = @_;
4423
4424     print $logh "${added_lf}Generating documentation page for the $model\n";
4425
4426     # Printer queue name
4427     my $printerstr;
4428     if ($printer) {
4429         $printerstr = $printer;
4430     } else {
4431         $printerstr = "<printer>";
4432     }
4433         
4434     # Spooler-specific differences
4435     my ($command,
4436         $enumopt, $enumoptleft, $enumoptequal, $enumoptright,
4437         $boolopt, $booloptfalseprefix, $booloptleft, $booloptequal,
4438         $booloptright,
4439         $numopt, $numoptleft, $numoptequal, $numoptright,
4440         $stropt, $stroptleft, $stroptequal, $stroptright,
4441         $optsep, $trailer, $custompagesize);
4442     if ($spooler eq 'cups') {
4443         ($command,
4444          $enumopt, $enumoptleft, $enumoptequal, $enumoptright,
4445          $boolopt, $booloptfalseprefix, $booloptleft, $booloptequal,
4446          $booloptright,
4447          $numopt, $numoptleft, $numoptequal, $numoptright,
4448          $stropt, $stroptleft, $stroptequal, $stroptright,
4449          $optsep, $trailer, $custompagesize) =
4450              ("lpr -P $printerstr ",
4451               "-o ", "", "=", "",
4452               "-o ", "no", "", "=", "",
4453               "-o ", "", "=", "",
4454               "-o ", "", "=", "",
4455               " "," <file>",
4456               "\n  Custom size: -o PageSize=Custom." .
4457               "<width>x<height>[<unit>]\n" .
4458               "               Units: pt (default), in, cm, mm\n" .
4459               "  Example: -o PageSize=Custom.4.0x6.0in\n");
4460     } elsif ($spooler eq 'lpd') {
4461         ($command,
4462          $enumopt, $enumoptleft, $enumoptequal, $enumoptright,
4463          $boolopt, $booloptfalseprefix, $booloptleft, $booloptequal,
4464          $booloptright,
4465          $numopt, $numoptleft, $numoptequal, $numoptright,
4466          $stropt, $stroptleft, $stroptequal, $stroptright,
4467          $optsep, $trailer, $custompagesize) =
4468              ("lpr -P $printerstr -J \"",
4469               "", "", "=", "",
4470               "", "", "", "=", "",
4471               "", "", "=", "",
4472               "", "", "=", "",
4473               " ", "\" <file>",
4474               "\n  Custom size: PageSize=Custom." .
4475               "<width>x<height>[<unit>]\n" .
4476               "               Units: pt (default), in, cm, mm\n" .
4477               "  Example: PageSize=Custom.4.0x6.0in\n");
4478     } elsif ($spooler eq 'gnulpr') {
4479         ($command,
4480          $enumopt, $enumoptleft, $enumoptequal, $enumoptright,
4481          $boolopt, $booloptfalseprefix, $booloptleft, $booloptequal,
4482          $booloptright,
4483          $numopt, $numoptleft, $numoptequal, $numoptright,
4484          $stropt, $stroptleft, $stroptequal, $stroptright,
4485          $optsep, $trailer, $custompagesize) =
4486              ("lpr -P $printerstr ",
4487               "-o ", "", "=", "",
4488               "-o ", "", "", "=", "",
4489               "-o ", "", "=", "",
4490               "-o ", "", "=", "",
4491               " "," <file>",
4492               "\n  Custom size: -o PageSize=Custom." .
4493               "<width>x<height>[<unit>]\n" .
4494               "               Units: pt (default), in, cm, mm\n" .
4495               "  Example: -o PageSize=Custom.4.0x6.0in\n");
4496     } elsif ($spooler eq 'lprng') {
4497         ($command,
4498          $enumopt, $enumoptleft, $enumoptequal, $enumoptright,
4499          $boolopt, $booloptfalseprefix, $booloptleft, $booloptequal,
4500          $booloptright,
4501          $numopt, $numoptleft, $numoptequal, $numoptright,
4502          $stropt, $stroptleft, $stroptequal, $stroptright,
4503          $optsep, $trailer, $custompagesize) =
4504              ("lpr -P $printerstr ",
4505               "-Z ", "", "=", "",
4506               "-Z ", "", "", "=", "",
4507               "-Z ", "", "=", "",
4508               "-Z ", "", "=", "",
4509               " "," <file>",
4510               "\n  Custom size: -Z PageSize=Custom." .
4511               "<width>x<height>[<unit>]\n" .
4512               "               Units: pt (default), in, cm, mm\n" .
4513               "  Example: -Z PageSize=Custom.4.0x6.0in\n");
4514     } elsif ($spooler eq 'ppr') {
4515         ($command,
4516          $enumopt, $enumoptleft, $enumoptequal, $enumoptright,
4517          $boolopt, $booloptfalseprefix, $booloptleft, $booloptequal,
4518          $booloptright,
4519          $numopt, $numoptleft, $numoptequal, $numoptright,
4520          $stropt, $stroptleft, $stroptequal, $stroptright,
4521          $optsep, $trailer, $custompagesize) =
4522              ("ppr -d $printerstr --ripopts \"",
4523               "", "", "=", "",
4524               "", "", "", "=", "",
4525               "", "", "=", "",
4526               "", "", "=", "",
4527               " ","\" <file>",
4528               "\n  Custom size: PageSize=Custom." .
4529               "<width>x<height>[<unit>]\n" .
4530               "               Units: pt (default), in, cm, mm\n" .
4531               "  Example: PageSize=Custom.4.0x6.0in\n");
4532     } elsif ($spooler eq 'ppr-int') {
4533         ($command,
4534          $enumopt, $enumoptleft, $enumoptequal, $enumoptright,
4535          $boolopt, $booloptfalseprefix, $booloptleft, $booloptequal,
4536          $booloptright,
4537          $numopt, $numoptleft, $numoptequal, $numoptright,
4538          $stropt, $stroptleft, $stroptequal, $stroptright,
4539          $optsep, $trailer, $custompagesize) =
4540              ("ppr -d $printerstr -i \"",
4541               "", "", "=", "",
4542               "", "", "", "=", "",
4543               "", "", "=", "",
4544               "", "", "=", "",
4545               " ","\" <file>",
4546               "\n  Custom size: PageSize=Custom." .
4547               "<width>x<height>[<unit>]\n" .
4548               "               Units: pt (default), in, cm, mm\n" .
4549               "  Example: PageSize=Custom.4.0x6.0in\n");
4550     } elsif ($spooler eq 'cps') {
4551         ($command,
4552          $enumopt, $enumoptleft, $enumoptequal, $enumoptright,
4553          $boolopt, $booloptfalseprefix, $booloptleft, $booloptequal,
4554          $booloptright,
4555          $numopt, $numoptleft, $numoptequal, $numoptright,
4556          $stropt, $stroptleft, $stroptequal, $stroptright,
4557          $optsep, $trailer, $custompagesize) =
4558              ("lpr -P $printerstr ",
4559               "-o ", "", "=", "",
4560               "-o ", "", "", "=", "",
4561               "-o ", "", "=", "",
4562               "-o ", "", "=", "",
4563               " "," <file>",
4564               "\n  Custom size: -o PageSize=Custom." .
4565               "<width>x<height>[<unit>]\n" .
4566               "               Units: pt (default), in, cm, mm\n" .
4567               "  Example: -o PageSize=Custom.4.0x6.0in\n");
4568     } elsif ($spooler eq 'direct') {
4569         ($command,
4570          $enumopt, $enumoptleft, $enumoptequal, $enumoptright,
4571          $boolopt, $booloptfalseprefix, $booloptleft, $booloptequal,
4572          $booloptright,
4573          $numopt, $numoptleft, $numoptequal, $numoptright,
4574          $stropt, $stroptleft, $stroptequal, $stroptright,
4575          $optsep, $trailer, $custompagesize) =
4576              ("$programname -P $printerstr ",
4577               "-o ", "", "=", "",
4578               "-o ", "", "", "=", "",
4579               "-o ", "", "=", "",
4580               "-o ", "", "=", "",
4581               " "," <file>",
4582               "\n  Custom size: -o PageSize=Custom." .
4583               "<width>x<height>[<unit>]\n" .
4584               "               Units: pt (default), in, cm, mm\n" .
4585               "  Example: -o PageSize=Custom.4.0x6.0in\n");
4586     } elsif ($spooler eq 'pdq') {
4587         ($command,
4588          $enumopt, $enumoptleft, $enumoptequal, $enumoptright,
4589          $boolopt, $booloptfalseprefix, $booloptleft, $booloptequal,
4590          $booloptright,
4591          $numopt, $numoptleft, $numoptequal, $numoptright,
4592          $stropt, $stroptleft, $stroptequal, $stroptright,
4593          $optsep, $trailer, $custompagesize) =
4594              ("pdq -P $printerstr ",
4595               "-o", "", "_", "",
4596               "-o", "no", "", "_", "",
4597               "-a", "", "=", "",
4598               "-a", "", "=", "",
4599               " "," <file>",
4600               "\n" .
4601               "Option 'PageWidth':\n". 
4602               "  Page Width (for \"Custom\" page size)\n" .
4603               "  A floating point number argument\n" .
4604               "  Range: 0 <= x <= 100000\n" .
4605               "  Example: -aPageWidth=123.4\n" .
4606               "\n" .
4607               "Option 'PageHeight':\n" .
4608               "  Page Height (for \"Custom\" page size)\n" .
4609               "  A floating point number argument\n" .
4610               "  Range: 0 <= x <= 100000\n" .
4611               "  Example: -aPageHeight=234.5\n" .
4612               "\n" .
4613               "Option 'PageSizeUnit':\n" .
4614               "  Unit (for \"Custom\" page size)\n" .
4615               "  An enumerated choice argument\n" .
4616               "  Possible choices:\n" .
4617               "   o -oPageSizeUnit_pt: Points (1/72 inch)\n" .
4618               "   o -oPageSizeUnit_in: Inches\n" .
4619               "   o -oPageSizeUnit_cm: cm\n" .
4620               "   o -oPageSizeUnit_mm: mm\n" .
4621               "  Example: -oPageSizeUnit_mm\n");
4622     }
4623
4624     # Variables for the kid processes reporting their state
4625
4626     # Set up a pipe for the kids to pass their exit stat to the main process
4627     pipe KID_MESSAGE_DOC, KID_MESSAGE_DOC_IN;
4628
4629     # When the kid fails put the exit stat here
4630     $dockidfailed = 0;
4631
4632     # When the kid exits successfully, mark it here
4633     $kid0finished = 0;
4634
4635     use IO::Handle;
4636     pipe KID0_IN, KID0;
4637     KID0->autoflush(1);
4638     my $kid0 = fork();
4639     if (!defined($kid0)) {
4640         close KID0;
4641         close KID0_IN;
4642         print $logh "$0: cannot fork for kid0!\n";
4643         rip_die ("can't fork for kid0",
4644                  $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
4645     }
4646
4647     if ($kid0) {
4648         # we are the parent; return a glob to the filehandle
4649         close KID0;
4650         print $logh "Documentation page generator PID kid0=$kid0\n";
4651         return ( *KID0_IN, $kid0 );
4652     }
4653
4654     $kidgeneration += 1;
4655
4656     # we are the kid; we generate the documentation page
4657
4658     close KID0_IN;
4659     $SIG{PIPE} = 'DEFAULT';
4660
4661     # Kill data on STDIN to satisfy PPR
4662     if (($spooler eq 'ppr_int') || ($spooler eq 'ppr')) {
4663         while (my $dummy = <STDIN>) {};
4664     }
4665     close STDIN
4666         or print $logh "Error closing STDIN for docs print\n";
4667
4668     # write the job into KID0
4669     select KID0;
4670
4671     print "\nInvokation summary for the $model\n\n";
4672     print "Use the following command line:\n\n";
4673     if ($booloptfalseprefix) {
4674         # I think that what you want to indicate is that the prefix for a false
4675         # boolean has this form:  xxx [no]<switch> or something similar
4676         print "   ${command}${enumopt}${enumoptleft}<option>" .
4677             "${enumoptequal}<choice>${enumoptright}${optsep}" .
4678             "${boolopt}${booloptleft}\[${booloptfalseprefix}\]<switch>" .
4679             "${booloptright}${optsep}" .
4680             "${numopt}${numoptleft}<num. option>${numoptequal}" .
4681             "<value>${numoptright}${optsep}" .
4682             "${stropt}${stroptleft}<string option>${stroptequal}" .
4683             "<string>${stroptright}" .
4684             "${trailer}\n\n";
4685     } else {
4686         print "   ${command}${enumopt}${enumoptleft}<option>" .
4687             "${enumoptequal}<choice>${enumoptright}${optsep}" .
4688             "${boolopt}${booloptleft}<switch>${booloptequal}" .
4689             "<True/False>${booloptright}${optsep}" .
4690             "${numopt}${numoptleft}<num. option>${numoptequal}" .
4691             "<value>${numoptright}${optsep}" .
4692             "${stropt}${stroptleft}<string option>${stroptequal}" .
4693             "<string>${stroptright}" .
4694             "${trailer}\n\n";
4695     }
4696         
4697     print "The following options are available for this printer:\n\n";
4698
4699     for my $arg (@{$dat->{'args'}}) {
4700         my ($name,
4701             $type,
4702             $comment,
4703             $spot,
4704             $default) = ($arg->{'name'},
4705                          $arg->{'type'},
4706                          $arg->{'comment'},
4707                          $arg->{'spot'},
4708                          $arg->{'default'});
4709
4710         # Is this really an option? Otherwise skip it.
4711         next if (!$type);
4712
4713         # We don't need "PageRegion", we have "PageSize"
4714         next if ($name eq "PageRegion");
4715
4716         # Skip enumerated choice options with only one choice
4717         next if (($type eq 'enum') && ($#{$arg->{'vals'}} < 1));
4718
4719         my $commentstr = "";
4720         if ($comment) {
4721             $commentstr = "  $comment\n";
4722         }
4723
4724         my $typestr;
4725         if ($type eq "enum") {
4726             $typestr = "An enumerated choice";
4727         } elsif ($type eq "bool") {
4728             $typestr = "A boolean";
4729         } elsif ($type eq "int") {
4730             $typestr = "An integer number";
4731         } elsif ($type eq "float") {
4732             $typestr = "A floating point number";
4733         } elsif (($type eq "string") || ($type eq "password")) {
4734             $typestr = "A string";
4735         }
4736
4737         print "Option '$name':\n$commentstr  $typestr argument\n";
4738         print "  This options corresponds to a JCL command\n" if ($arg->{'style'} eq 'J');
4739         
4740         if ($type eq 'bool') {
4741             print "  Possible choices:\n";
4742             if ($booloptfalseprefix) {
4743                 print "   o $name: $arg->{'comment_true'}\n";
4744                 print "   o $booloptfalseprefix$name: " .
4745                     "$arg->{'comment_false'}\n";
4746                 if (defined($default)) {
4747                     my $defstr = ($default ? "" : "$booloptfalseprefix");
4748                     print "  Default: $defstr$name\n";
4749                 }
4750                 print "  Example: ${boolopt}${booloptleft}${name}" .
4751                     "${booloptright}\n";
4752             } else {
4753                 print "   o True: $arg->{'comment_true'}\n";
4754                 print "   o False: $arg->{'comment_false'}\n";
4755                 if (defined($default)) {
4756                     my $defstr = ($default ? "True" : "False");
4757                     print "  Default: $defstr\n";
4758                 }
4759                 print "  Example: ${boolopt}${booloptleft}${name}" .
4760                     "${booloptequal}True${booloptright}\n";
4761             }
4762         } elsif ($type eq 'enum') {
4763             print "  Possible choices:\n";
4764             my $exarg;
4765             my $havecustomsize = 0;
4766             for (@{$arg->{'vals'}}) {
4767                 my ($choice, $comment) = ($_->{'value'}, $_->{'comment'});
4768                 print "   o $choice: $comment\n";
4769                 if (($name eq "PageSize") && ($choice eq "Custom")) {
4770                     $havecustomsize = 1;
4771                 }
4772                 $exarg=$choice;
4773             }
4774             if (defined($default)) {
4775                 print "  Default: $default\n";
4776             }
4777             print "  Example: ${enumopt}${enumoptleft}${name}" .
4778                 "${enumoptequal}${exarg}${enumoptright}\n";
4779             if ($havecustomsize) {
4780                 print $custompagesize;
4781             }
4782         } elsif ($type eq 'int' or $type eq 'float') {
4783             my ($max, $min) = ($arg->{'max'}, $arg->{'min'});
4784             my $exarg;
4785             if (defined($max)) {
4786                 print "  Range: $min <= x <= $max\n";
4787                 $exarg=$max;
4788             }
4789             if (defined($default)) {
4790                 print "  Default: $default\n";
4791                 $exarg=$default;
4792             }
4793             if (!$exarg) { $exarg=0; }
4794             print "  Example: ${numopt}${numoptleft}${name}" .
4795                 "${numoptequal}${exarg}${numoptright}\n";
4796         } elsif ($type eq 'string' or $type eq 'password') {
4797             my $maxlength = $arg->{'maxlength'};
4798             if (defined($maxlength)) {
4799                 print "  Maximum length: $maxlength characters\n";
4800             }
4801             if (defined($default)) {
4802                 print "  Default: $default\n";
4803             }
4804             print "  Examples/special settings:\n";
4805             for (@{$arg->{'vals'}}) {
4806                 my ($value, $comment, $driverval, $proto) = 
4807                     ($_->{'value'}, $_->{'comment'}, $_->{'driverval'},
4808                      $arg->{'proto'});
4809                 # Retrieve the original string from the prototype
4810                 # and the driverval
4811                 my $string;
4812                 if ($proto) {
4813                     my $s = index($proto, '%s');
4814                     my $l = length($driverval) - length($proto) + 2;
4815                     if (($s < 0) || ($l < 0)) {
4816                         $string = $driverval;
4817                     } else {
4818                         $string = substr($driverval, $s, $l);
4819                     }
4820                 } else {
4821                     $string = $driverval;
4822                 }
4823                 print "   o ${stropt}${stroptleft}${name}" .
4824                     "${stroptequal}${value}${stroptright}";
4825                 if (($value ne $string) || ($comment ne $value)) {
4826                     print " (";
4827                 }
4828                 if ($value ne $string) {
4829                     if ($string eq '') {
4830                         print "blank string";
4831                     } else {
4832                         print "\"$string\"";
4833                     }
4834                 }
4835                 if (($value ne $string) && ($comment ne $value)) {
4836                     print ", ";
4837                 }
4838                 if ($value ne $comment) {
4839                     print "$comment";
4840                 }
4841                 if (($value ne $string) || ($comment ne $value)) {
4842                     print ")";
4843                 }
4844                 print "\n";
4845             }
4846         }
4847
4848         print "\n";
4849     }
4850     
4851     select STDOUT;
4852     close KID0 
4853         or print $logh "Error closing KID0 for docs print\n";
4854     close STDOUT
4855         or print $logh "Error closing STDOUT for docs print\n";
4856
4857     # Finished successfully, inform main process
4858     close KID_MESSAGE_DOC;
4859     print KID_MESSAGE_DOC_IN "0 $EXIT_PRINTED\n";
4860     close KID_MESSAGE_DOC_IN;
4861
4862     print $logh "KID0 finished\n";
4863     exit($EXIT_PRINTED);
4864
4865 }
4866
4867
4868
4869 ## Close the documentation page generation process and wait until the
4870 ## kid process finishes.
4871
4872 sub closedocgeneratorhandle {
4873
4874     my ($handle, $pid) = @_;
4875
4876     print $logh "${added_lf}Closing documentation page generator\n";
4877
4878     # Do it!
4879     close $handle;
4880
4881     # Wait for the kid process to finish or the kid process to fail
4882     close KID_MESSAGE_DOC_IN;
4883     while ((!$dockidfailed) &&
4884            (!$kid0finished)) {
4885         my $message = <KID_MESSAGE_DOC>;
4886         chomp $message;
4887         if ($message =~ /(\d+)\s+(\d+)/) {
4888             my $kid_id = $1;
4889             my $exitstat = $2;
4890             print $logh "KID$kid_id exited with status $exitstat\n";
4891             if ($exitstat > 0) {
4892                 $dockidfailed = $exitstat;
4893             } elsif ($kid_id eq "0") {
4894                 $kid0finished = 1;
4895             }
4896         }
4897     }
4898
4899     close KID_MESSAGE_DOC;
4900
4901     # If the kid failed, return the exit stat of the kid
4902     if ($dockidfailed != 0) {
4903         $retval = $dockidfailed;
4904     }
4905
4906     print $logh "Documentation page generator exit stat: $retval\n";
4907     # Wait for fileconverter child
4908     waitpid($pid, 0);
4909     print $logh "Documentation page generator process finished\n";
4910     return ($retval);
4911 }
4912
4913
4914
4915 # Find an argument by name in a case-insensitive way
4916 sub argbyname {
4917     my $name = $_[0];
4918
4919     for my $arg (@{$dat->{'args'}}) {
4920         return $arg if (lc($name) eq lc($arg->{'name'}));
4921     }
4922
4923     return undef;
4924 }
4925
4926 sub valbyname {
4927     my ($arg,$name) = @_;
4928
4929     for my $val (@{$arg->{'vals'}}) {
4930         return $val if (lc($name) eq lc($val->{'value'}));
4931     }
4932
4933     return undef;
4934 }
4935
4936 # Write a Good-Bye letter and clean up before committing suicide (send
4937 # error message to caller)
4938
4939 sub rip_die {
4940     my ($message, $exitstat) = @_;
4941     my $errmsg = "$!";
4942     my $errcod = $! + 0;
4943
4944     # Log that we are dying ...
4945     print $logh "Process dying with \"$message\", exit stat: $exitstat\n\terror: $errmsg ($errcod)\n";
4946
4947     print $logh "Cleaning up ...\n";
4948     foreach my $killsignal (15, 9) {
4949
4950         # Kill all registered subshells
4951         foreach my $pid (keys %pids) {
4952             print $logh "Killing process $pid ($pids{$pid}) and its subprocesses with signal $killsignal\n";
4953             # This call kills the process group with group ID $pid, the
4954             # group which was formed from the initial process $pid which
4955             # contains $pid and all its subprocesses
4956             kill(-$killsignal, $pid);
4957             # If the system does not support process groups and therefore
4958             # the call above does not kill anything, kill at least $pid
4959             kill($killsignal, $pid);
4960         }
4961
4962         # Close the documentation page generator (if it was used)
4963         if ($kid0) {
4964             print $logh "Killing process $kid0 (KID0) with signal $killsignal\n";
4965             kill($killsignal, $kid0);
4966         }
4967         
4968         # Close the file converter (if it was used)
4969         if ($kid2) {
4970             print $logh "Killing process $kid2 (KID2) with signal $killsignal\n";
4971             kill($killsignal, $kid2);
4972         }
4973         if ($kid1) {
4974             print $logh "Killing process $kid1 (KID1) with signal $killsignal\n";
4975             kill($killsignal, $kid1);
4976         }
4977
4978         # Close the renderer
4979         if ($kid4) {
4980             print $logh "Killing process $kid4 (KID4) with signal $killsignal\n";
4981             kill($killsignal, $kid4);
4982         }
4983         if ($kid3) {
4984             print $logh "Killing process $kid3 (KID3) with signal $killsignal\n";
4985             kill($killsignal, $kid3);
4986         }
4987
4988         # Wait some time for the processes to close
4989         sleep(5 - $kidgeneration) if $killsignal != 9;
4990     }
4991
4992     # Do the debug dump and the PPR error handling only from the main process
4993     if ($kidgeneration == 0) { # We are the main process
4994
4995         if ($spooler eq 'ppr_int') {
4996             # Special error handling for PPR intefaces
4997             $message =~ s/\\/\\\\/;
4998             $message =~ s/\"/\\\"/;
4999             my @messagelines = split("\n", $message);
5000             my $firstline = "TRUE";
5001             for my $line (@messagelines) {
5002                 modern_system("lib/alert $printer $firstline \"$line\"");
5003                 $firstline = "FALSE";
5004             }
5005         } else {
5006             print STDERR $message . "\n";
5007         }
5008         if ($debug) {
5009             use Data::Dumper;
5010             local $Data::Dumper::Purity=1;
5011             local $Data::Dumper::Indent=1;
5012             print $logh Dumper($dat);
5013         }
5014     }
5015
5016     ## The End
5017     print $logh "${added_lf}Closing foomatic-rip.\n";
5018     close $logh;
5019
5020     exit $exitstat;
5021 }
5022
5023 # Signal handling routines
5024
5025 sub do_nothing {
5026 }
5027
5028 sub set_exit_canceled {
5029     $retval = $EXIT_PRINTED;
5030     rip_die ("Caught termination signal: Job canceled", $retval);
5031 }
5032
5033 sub set_exit_error {
5034     $retval = $EXIT_SIGNAL;
5035     rip_die ("Caught error signal: Error in renderer, driver, or foomatic-rip", $retval);
5036 }
5037
5038 sub set_exit_prnerr {
5039     $retval = $EXIT_PRNERR;
5040 }
5041
5042 sub set_exit_prnerr_noretry {
5043     $retval = $EXIT_PRNERR_NORETRY;
5044 }
5045
5046 sub set_exit_engaged {
5047     $retval = $EXIT_ENGAGED;
5048 }
5049
5050 # Read the config file
5051
5052 sub readConfFile {
5053     my ($file) = @_;
5054
5055     my %conf;
5056     # Read config file if present
5057     if (open CONF, "< $file") {
5058         while (<CONF>)
5059         {
5060             $conf{$1}="$2" if (m/^\s*([^\#\s]\S*)\s*:\s*(.*?)\s*$/);
5061         }
5062         close CONF;
5063     }
5064
5065     return %conf;
5066 }
5067
5068 sub removeunprintables {
5069     # Remove unprintable characters
5070     my $str = $_[0];
5071     $str =~ s/[\x00-\x1f]//g;
5072     return $str;
5073 }
5074
5075 sub removeshellescapes {
5076     # Remove shell escape characters
5077     my $str = $_[0];
5078     $str =~ s/[\|<>&!\$\'\"\#\*\?\(\)\[\]\{\}]//g;
5079     return $str;
5080 }
5081
5082 sub removespecialchars {
5083     # Remove unprintable and shell escape characters
5084     return removeshellescapes(removeunprintables($_[0]));
5085 }
5086
5087 sub unhtmlify {
5088     my $str = $_[0];
5089
5090     # Replace HTML/XML entities by the original characters
5091     $str =~ s/\&apos;/\'/g;
5092     $str =~ s/\&quot;/\"/g;
5093     $str =~ s/\&gt;/\>/g;
5094     $str =~ s/\&lt;/\</g;
5095     $str =~ s/\&amp;/\&/g;
5096
5097     # Replace special entities by job data
5098     $rbinumcopies = $copies if !$rbinumcopies;
5099     $str =~ s/\&job;/$jobid/g;
5100     $str =~ s/\&user;/$jobuser/g;
5101     $str =~ s/\&host;/$jobhost/g;
5102     $str =~ s/\&title;/$jobtitle/g;
5103     $str =~ s/\&copies;/$copies/g;
5104     $str =~ s/\&rbinumcopies;/$rbinumcopies/g;
5105     $str =~ s/\&options;/$optstr/g;
5106     
5107     my ($sec, $min, $hour, $mday, $mon, $year) = (localtime)[0..5];
5108     my $yearstr = sprintf("%04d", $year + 1900);
5109     my $monstr = sprintf("%02d", $mon + 1);
5110     my $mdaystr = sprintf("%02d", $mday);
5111     my $hourstr = sprintf("%02d", $hour);
5112     my $minstr = sprintf("%02d", $min);
5113     my $secstr = sprintf("%02d", $sec);
5114
5115     $str =~ s/\&year;/$yearstr/g;
5116     $str =~ s/\&month;/$monstr/g;
5117     $str =~ s/\&date;/$mdaystr/g;
5118     $str =~ s/\&hour;/$hourstr/g;    
5119     $str =~ s/\&min;/$minstr/g;    
5120     $str =~ s/\&sec;/$secstr/g;    
5121     
5122     return $str;
5123 }
5124
5125 sub unhexify {
5126     # Replace hex notation for unprintable characters in PPD files
5127     # by the actual characters ex: "<0A>" --> chr(hex("0A"))
5128     my ($input) = @_;
5129     my $output = "";
5130     my $hexmode = 0;
5131     my $firstdigit = "";
5132     for (my $i = 0; $i < length($input); $i ++) {
5133         my $c = substr($input, $i, 1);
5134         if ($hexmode) {
5135             if ($c eq ">") {
5136                 # End of hex string
5137                 $hexmode = 0;
5138             } elsif ($c =~ /^[0-9a-fA-F]$/) {
5139                 # Hexadecimal digit, two of them give a character
5140                 if ($firstdigit ne "") {
5141                     $output .= chr(hex("$firstdigit$c"));
5142                     $firstdigit = "";
5143                 } else {
5144                     $firstdigit = $c;
5145                 }
5146             }
5147         } else {
5148             if ($c eq "<") {
5149                 # Beginning of hex string
5150                 $hexmode = 1;
5151             } else {
5152                 # Normal character
5153                 $output .= $c;
5154             }
5155         }
5156     }
5157     return $output;
5158 }
5159
5160 sub undossify( $ ) {
5161     # Remove "dossy" line ends ("\r\n") from a string
5162     my $str = $_[0];
5163     $str =~ s/\r\n/\n/gs;
5164     $str =~ s/\r$//s;
5165     return( $str );
5166 }
5167
5168 sub checkarg {
5169     # Check if there is already an argument record $argname in $dat, if not,
5170     # create one
5171     my ($dat, $argname) = @_;
5172     return if defined($dat->{'args_byname'}{$argname});
5173     # argument record
5174     my $rec;
5175     $rec->{'name'} = $argname;
5176     # Insert record in 'args' array for browsing all arguments
5177     push(@{$dat->{'args'}}, $rec);
5178     # 'args_byname' hash for looking up arguments by name
5179     $dat->{'args_byname'}{$argname} = $dat->{'args'}[$#{$dat->{'args'}}];
5180     # Default execution style is 'G' (PostScript) since all arguments for
5181     # which we don't find "*Foomatic..." keywords are usual PostScript
5182     # options
5183     $dat->{'args_byname'}{$argname}{'style'} = 'G';
5184     # Default prototype for code to insert, used by enum options
5185     $dat->{'args_byname'}{$argname}{'proto'} = '%s';
5186     # stop Perl nattering about undefined to string comparisons
5187     $dat->{'args_byname'}{$argname}{'type'} = '';
5188     print $logh "Added option $argname\n";
5189 }
5190
5191 sub checksetting {
5192     # Check if there is already an choice record $setting in the $argname
5193     # argument in $dat, if not, create one
5194     my ($dat, $argname, $setting) = @_;
5195     return if 
5196         defined($dat->{'args_byname'}{$argname}{'vals_byname'}{$setting});
5197     # setting record
5198     my $rec;
5199     $rec->{'value'} = $setting;
5200     # Insert record in 'vals' array for browsing all settings
5201     push(@{$dat->{'args_byname'}{$argname}{'vals'}}, $rec);
5202     # 'vals_byname' hash for looking up settings by name
5203     $dat->{'args_byname'}{$argname}{'vals_byname'}{$setting} = 
5204         $dat->{'args_byname'}{$argname}{'vals'}[$#{$dat->{'args_byname'}{$argname}{'vals'}}];
5205 }
5206
5207 sub removearg {
5208     # remove the argument record $argname from $dat
5209     my ($dat, $argname) = @_;
5210     return if !defined($dat->{'args_byname'}{$argname});
5211     # Remove 'args_byname' hash for looking up arguments by name
5212     delete $dat->{'args_byname'}{$argname};
5213     # Remove argument itself
5214     for (my $i = 0; $i <= $#{$dat->{'args'}}; $i ++) {
5215         if ($dat->{'args'}[$i]{'name'} eq $argname) {
5216             print $logh "Removing option " .
5217                 $argname . "\n";
5218             splice(@{$dat->{'args'}}, $i, 1);
5219             last;
5220         }
5221     }
5222 }
5223
5224 sub removepsargs {
5225     # remove all records of PostScript arguments from $dat
5226     my ($dat) = @_;
5227     return if !defined($dat);
5228     for (my $i = 0; $i <= $#{$dat->{'args'}}; $i ++) {
5229         if ($dat->{'args'}[$i]{'style'} eq 'G') {
5230             print $logh "Removing PostScript option " .
5231                 $dat->{'args'}[$i]{'name'} . "\n";
5232             # Remove 'args_byname' hash for looking up arguments by name
5233             delete $dat->{'args_byname'}{$dat->{'args'}[$i]{'name'}};
5234             # Remove argument itself
5235             splice(@{$dat->{'args'}}, $i, 1);
5236             $i --;
5237         }
5238     }
5239 }
5240
5241 sub checkoptionvalue {
5242
5243     ## This function checks whether a given value is valid for a given
5244     ## option. If yes, it returns a cleaned value (e. g. always 0 or 1
5245     ## for boolean options), otherwise "undef". If $forcevalue is set,
5246     ## we always determine a corrected value to insert (we never return
5247     ## "undef").
5248
5249     # Is $value valid for the option named $argname?
5250     my ($dat, $argname, $value, $forcevalue) = @_;
5251
5252     # Record for option $argname
5253     my $arg = $dat->{'args_byname'}{$argname};
5254     $arg->{'type'} = '' if not defined $arg->{'type'};
5255
5256     if ($arg->{'type'} eq 'bool') {
5257         my $lcvalue = lc($value);
5258         if ((($lcvalue) eq 'true') ||
5259             (($lcvalue) eq 'on') ||
5260             (($lcvalue) eq 'yes') ||
5261             (($lcvalue) eq '1')) {
5262             return 1;
5263         } elsif ((($lcvalue) eq 'false') ||
5264                  (($lcvalue) eq 'off') ||
5265                  (($lcvalue) eq 'no') ||
5266                  (($lcvalue) eq '0')) {
5267             return 0;
5268         } elsif ($forcevalue) {
5269             # This maps Unknown to mean False.  Good?  Bad?
5270             # It was done so in Foomatic 2.0.x, too.
5271             my $name = $arg->{'name'};
5272             print $logh 
5273                 "The value $value for $name is not a " .
5274                 "choice!\n" .
5275                 " --> Using False instead!\n";
5276             return 0;
5277         }
5278     } elsif ($arg->{'type'} eq 'enum') {
5279         if ($value =~ /^None$/i) {
5280             return 'None';
5281         } elsif (defined($arg->{'vals_byname'}{$value})) {
5282             return $value;
5283         } elsif ((($arg->{'name'} eq "PageSize") ||
5284                   ($arg->{'name'} eq "PageRegion")) &&
5285                  (defined($arg->{'vals_byname'}{'Custom'})) &&
5286                  ($value =~ m!^Custom\.([\d\.]+)x([\d\.]+)([A-Za-z]*)$!)) {
5287             # Custom paper size
5288             return $value;
5289         } elsif ($forcevalue) {
5290             # wtf!?  that's not a choice!
5291             my $name = $arg->{'name'};
5292             # Return the first entry of the list
5293             my $firstentry = $arg->{'vals'}[0]{'value'};
5294             print $logh 
5295                 "The value $value for $name is not a " .
5296                 "choice!\n" .
5297                 " --> Using $firstentry instead!\n";
5298             return $firstentry;
5299         }
5300     } elsif (($arg->{'type'} eq 'int') ||
5301              ($arg->{'type'} eq 'float')) {
5302         if (($value <= $arg->{'max'}) &&
5303             ($value >= $arg->{'min'})) {
5304             if ($arg->{'type'} eq 'int') {
5305                 return POSIX::floor($value);
5306             } else {
5307             return $value;
5308             }
5309         } elsif ($forcevalue) {
5310             my $name = $arg->{'name'};
5311             my $newvalue;
5312             if ($value > $arg->{'max'}) {
5313                 $newvalue = $arg->{'max'}
5314             } elsif ($value < $arg->{'min'}) {
5315                 $newvalue = $arg->{'min'}
5316             }
5317             print $logh 
5318                 "The value $value for $name is out of " .
5319                 "range!\n" .
5320                 " --> Using $newvalue instead!\n";
5321             return $newvalue;
5322         }
5323     } elsif (($arg->{'type'} eq 'string') ||
5324              ($arg->{'type'} eq 'password')) {
5325         if (defined($arg->{'vals_byname'}{$value})) {
5326             my $name = $arg->{'name'};
5327             print $logh 
5328                 "The value $value for $name is a predefined choice\n";
5329             return $value;
5330         } elsif (stringvalid($dat, $argname, $value)) {
5331             # Check whether the string is one of the enumerated choices
5332             my $sprintfproto = $arg->{'proto'};
5333             $sprintfproto =~ s/\%(?!s)/\%\%/g;
5334             my $driverval = sprintf($sprintfproto, $value);
5335             for my $val (@{$arg->{'vals'}}) {
5336                 if (($val->{'driverval'} eq $driverval) ||
5337                     ($val->{'driverval'} eq $value)) {
5338                     my $name = $arg->{'name'};
5339                     print $logh 
5340                         "The string $value for $name is the predefined " .
5341                         "choice $val->{value}\n";
5342                     return $val->{value};
5343                 }
5344             }
5345             # "None" is mapped to the empty string
5346             if ($value eq 'None') {
5347                 my $name = $arg->{'name'};
5348                 print $logh 
5349                     "Option $name: 'None' is the mapped to the " .
5350                     "empty string\n";
5351                 return '';
5352             }
5353             # No matching choice? Return the original string
5354             return $value;
5355         } elsif ($forcevalue) {
5356             my $name = $arg->{'name'};
5357             my $str = substr($value, 0, $arg->{'maxlength'});
5358             if (stringvalid($dat, $argname, $str)) {
5359                 print $logh 
5360                     "The string $value for $name is longer than " .
5361                     "$arg->{'maxlength'}, string shortened to $str\n";
5362                 return $str;
5363             } elsif ($#{$arg->{'vals'}} >= 0) {
5364                 # First list item
5365                 my $firstentry = $arg->{'vals'}[0]{'value'};
5366                 print $logh 
5367                     "The string $value for $name contains forbidden " .
5368                     "characters or does not match the regular expression " .
5369                     "defined for this option, using predefined choice " .
5370                     "$firstentry instead\n";
5371                 return $firstentry;
5372             } else {
5373                 # We should not get here
5374                 rip_die("Option $name incorrectly defined in the " .
5375                         "PPD file!\n", $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
5376             }
5377         }
5378     }
5379     return undef;
5380 }
5381
5382 sub stringvalid {
5383
5384     ## Checks whether a user-supplied value for a string option is valid
5385     ## It must be within the length limit, should only contain allowed
5386     ## characters and match the given regexp
5387
5388     # Option and string
5389     my ($dat, $argname, $value) = @_;
5390
5391     my $arg = $dat->{'args_byname'}{$argname};
5392
5393     # Maximum length
5394     return 0 if (defined($arg->{'maxlength'}) &&
5395                  (length($value) > $arg->{'maxlength'}));
5396
5397     # Allowed characters
5398     if ($arg->{'allowedchars'}) {
5399         my $chars = $arg->{'allowedchars'};
5400         # Quote the slashes (if a slash is preceeded by an even number of
5401         # backslashes, it is not already quoted)
5402         $chars =~ s/(?<!\\)((\\\\)*)\//$2\\\//g;
5403         return 0 if $value !~ /^[$chars]*$/;
5404     }
5405
5406     # Regular expression
5407     if ($arg->{'allowedregexp'}) {
5408         my $regexp = $arg->{'allowedregexp'};
5409         # Quote the slashes (if a slash is preceeded by an even number of
5410         # backslashes, it is not already quoted)
5411         $regexp =~ s/(?<!\\)((\\\\)*)\//$2\\\//g;
5412         return 0 if $value !~ /$regexp/;
5413     }
5414
5415     # All checks passed
5416     return 1;
5417 }
5418
5419 sub checkoptions {
5420
5421     ## Let the values of a boolean option being 0 or 1 instead of
5422     ## "True" or "False", range-check the defaults of all options and
5423     ## issue warnings if the values are not valid
5424
5425     # Option set to be examined
5426     my ($dat, $optionset) = @_;
5427
5428     for my $arg (@{$dat->{'args'}}) {
5429         if (defined($arg->{$optionset})) {
5430             $arg->{$optionset} =
5431                 checkoptionvalue
5432                 ($dat, $arg->{'name'}, $arg->{$optionset}, 1);
5433         }
5434     }
5435
5436     # If the settings for "PageSize" and "PageRegion" are different,
5437     # set the one for "PageRegion" to the one for "PageSize" and issue
5438     # a warning.
5439     if ($dat->{'args_byname'}{'PageSize'}{$optionset} ne
5440         $dat->{'args_byname'}{'PageRegion'}{$optionset}) {
5441         print $logh "Settings for \"PageSize\" and \"PageRegion\" are " .
5442             "different:\n" .
5443             "   PageSize: $dat->{'args_byname'}{'PageSize'}{$optionset}\n" .
5444             "   PageRegion: ".
5445             "$dat->{'args_byname'}{'PageRegion'}{$optionset}\n" .
5446             "Using the \"PageSize\" value " .
5447             "\"$dat->{'args_byname'}{'PageSize'}{$optionset}\"," .
5448             " for both.\n";
5449         $dat->{'args_byname'}{'PageRegion'}{$optionset} =
5450             $dat->{'args_byname'}{'PageSize'}{$optionset};
5451     }
5452 }
5453
5454 # If the PageSize or PageRegion was changed, also change the other
5455
5456 sub syncpagesize {
5457     
5458     # Name and value of the option we set, and the option set where we
5459     # did the change
5460     my ($dat, $name, $value, $optionset) = @_;
5461
5462     # Don't do anything if we were called with an option other than
5463     # "PageSize" or "PageRegion"
5464     return if (($name ne "PageSize") && ($name ne "PageRegion"));
5465     
5466     # Don't do anything if not both "PageSize" and "PageRegion" exist
5467     return if ((!defined($dat->{'args_byname'}{'PageSize'})) ||
5468                (!defined($dat->{'args_byname'}{'PageRegion'})));
5469     
5470     my $dest;
5471     
5472     # "PageSize" --> "PageRegion"
5473     if ($name eq "PageSize") {
5474         $dest = "PageRegion";
5475     }
5476     
5477     # "PageRegion" --> "PageSize"
5478     if ($name eq "PageRegion") {
5479         $dest = "PageSize";
5480     }
5481     
5482     # Do it!
5483         my $val;
5484     if ($val=valbyname($dat->{'args_byname'}{$dest}, $value)) {
5485         # Standard paper size
5486         $dat->{'args_byname'}{$dest}{$optionset} = $val->{'value'};
5487     } elsif ($val=valbyname($dat->{'args_byname'}{$dest}, "Custom")) {
5488         # Custom paper size
5489         $dat->{'args_byname'}{$dest}{$optionset} = $value;
5490     }
5491 }
5492
5493 sub copyoptions {
5494
5495     ## Copy one option set into another one
5496
5497     # Source and destination option sets
5498     my ($dat, $srcoptionset, $destoptionset) = @_;
5499
5500     for my $arg (@{$dat->{'args'}}) {
5501         if (defined($arg->{$srcoptionset})) {
5502             $arg->{$destoptionset} = $arg->{$srcoptionset};
5503         }
5504     }
5505 }
5506
5507 sub deleteoptions {
5508
5509     ## Delete an option set
5510
5511     # option set to be removed
5512     my ($dat, $optionset) = @_;
5513
5514     for my $arg (@{$dat->{'args'}}) {
5515         if (defined($arg->{$optionset})) {
5516             delete($arg->{$optionset});
5517         }
5518     }
5519 }
5520
5521 sub optionsequal {
5522
5523     ## Compare two option sets, if they are equal, return 1, otherwise 0
5524
5525     # Option sets to be compared, flag to compare only command line and JCL
5526     # options
5527     my ($dat, $firstoptionset, $secondoptionset, $exceptPS) = @_;
5528
5529     for my $arg (@{$dat->{'args'}}) {
5530         next if ($exceptPS && ($arg->{'style'} eq 'G'));
5531         if ((defined($arg->{$firstoptionset})) &&
5532             (defined($arg->{$secondoptionset}))) {
5533             # Both entries exist
5534             return 0 if $arg->{$firstoptionset} ne $arg->{$secondoptionset};
5535         } elsif ((defined($arg->{$firstoptionset})) ||
5536                  (defined($arg->{$secondoptionset}))) {
5537             # One entry exists
5538             return 0;
5539         }
5540         # If no entry exists, the non-existing entries are considered as
5541         # equal
5542     }
5543     return 1;
5544 }
5545
5546 sub makeprologsection {
5547
5548     # option set to be used,
5549     # $comments = 1: Add "%%BeginProlog...%%EndProlog"
5550     my ($dat, $optionset, $comments) = @_;
5551     
5552     # Collect data to be inserted here
5553     my @output;
5554
5555     # Start comment
5556     if ($comments) {
5557         print $logh "\"Prolog\" section is missing, inserting it.\n";
5558         push(@output, "%%BeginProlog\n");
5559     }
5560
5561     # Generate the option code (not necessary when CUPS is spooler)
5562     if ($spooler ne 'cups') {
5563         print $logh "Inserting option code into \"Prolog\" section.\n";
5564         buildcommandline ($dat, $optionset);
5565         push(@output, @{$dat->{'prologprepend'}});
5566     }
5567
5568     # End comment
5569     if ($comments) {
5570         push(@output, "%%EndProlog\n");
5571     }
5572
5573     return join('', @output);
5574 }
5575
5576 sub makesetupsection {
5577
5578     # option set to be used, $comments = 1: Add "%%BeginSetup...%%EndSetup"
5579     my ($dat, $optionset, $comments) = @_;
5580     
5581     # Collect data to be inserted here
5582     my @output;
5583
5584     # Start comment
5585     if ($comments) {
5586         print $logh "\"Setup\" section is missing, inserting it.\n";
5587         push(@output, "%%BeginSetup\n");
5588     }
5589
5590     # PostScript code to generate accounting messages for CUPS
5591     if ($spooler eq 'cups') {
5592         print $logh "Inserting PostScript code for CUPS' page accounting\n";
5593         push(@output, $accounting_prolog);
5594     }
5595
5596     # Generate the option code (not necessary when CUPS is spooler)
5597     if ($spooler ne 'cups') {
5598         print $logh "Inserting option code into \"Setup\" section.\n";
5599         buildcommandline ($dat, $optionset);
5600         push(@output, @{$dat->{'setupprepend'}});
5601     }
5602
5603     # End comment
5604     if ($comments) {
5605         push(@output, "%%EndSetup\n");
5606     }
5607
5608     return join('', @output);
5609 }
5610
5611 sub makepagesetupsection {
5612
5613     # option set to be used,
5614     # $comments = 1: Add "%%BeginPageSetup...%%EndPageSetup"
5615     my ($dat, $optionset, $comments) = @_;
5616     
5617     # Collect data to be inserted here
5618     my @output;
5619
5620     # Start comment
5621     if ($comments) {
5622         push(@output, "%%BeginPageSetup\n");
5623         print $logh "\"PageSetup\" section is missing, inserting it.\n";
5624     }
5625
5626     # Generate the option code (not necessary when CUPS is spooler)
5627     print $logh "Inserting option code into \"PageSetup\" section.\n";
5628     buildcommandline ($dat, $optionset);
5629     if ($spooler ne 'cups') {
5630         push(@output, @{$dat->{'pagesetupprepend'}});
5631     } else {
5632         push(@output, @{$dat->{'cupspagesetupprepend'}});
5633     }
5634
5635     # End comment
5636     if ($comments) {
5637         push(@output, "%%EndPageSetup\n");
5638     }
5639
5640     return join('', @output);
5641 }
5642
5643 sub parsepageranges {
5644
5645     ## Parse a string containing page ranges and either check whether a
5646     ## given page is in the ranges or, if the given page number is zero,
5647     ## determine the score how specific this page range string is.
5648
5649     # String with page ranges and number of current page (0 for score)
5650     my ($ranges, $page) = @_;
5651     
5652     my $currentnumber = 0;
5653     my $rangestart = 0;
5654     my $currentkeyword = '';
5655     my $invalidrange = 0;
5656     my $totalscore = 0;
5657     my $pageinside = 0;
5658     my $currentrange = '';
5659
5660     my $evaluaterange = sub {
5661         # evaluate the current range: determine its score and whether the
5662         # current page is member of it.
5663         if ($invalidrange) {
5664             # Range is invalid, issue a warning
5665             print $logh "   Invalid range: $currentrange\n";
5666         } else {
5667             # We have a valid range, evaluate it
5668             if ($currentkeyword) {
5669                 if ($currentkeyword =~ /^even/i) {
5670                     # All even-numbered pages
5671                     $totalscore += 50000;
5672                     $pageinside = 1 if (($page % 2) == 0);
5673                 } elsif ($currentkeyword =~ /^odd/i) {
5674                     # All odd-numbered pages
5675                     $totalscore += 50000;
5676                     $pageinside = 1 if (($page % 2) == 1);
5677                 } else {
5678                     # Invalid range
5679                     print $logh "   Invalid range: $currentrange\n";
5680                 }
5681             } elsif (($rangestart == 0) && ($currentnumber > 0)) {
5682                 # Page range is a single page
5683                 $totalscore += 1;
5684                 $pageinside = 1 if ($page == $currentnumber);
5685             } elsif (($rangestart > 0) && ($currentnumber > 0)) {
5686                 # Page range is a sequence of pages
5687                 $totalscore += (abs($currentnumber - $rangestart) + 1);
5688                 if ($currentnumber < $rangestart) {
5689                     my $tmp = $currentnumber;
5690                     $currentnumber = $rangestart;
5691                     $rangestart = $tmp;
5692                 }
5693                 $pageinside = 1 if (($page <= $currentnumber) &&
5694                                     ($page >= $rangestart));
5695             } elsif ($rangestart > 0) {
5696                 # Page range goes to the end of the document
5697                 $totalscore += 100000;
5698                 $pageinside = 1 if ($page >= $rangestart);
5699             } else {
5700                 # Invalid range
5701                 print $logh "   Invalid range: $currentrange\n";
5702             }
5703         }
5704         # Range is evaluated, remove all recordings of the current range
5705         $rangestart = 0;
5706         $currentnumber = 0;
5707         $currentkeyword = '';
5708         $invalidrange = 0;
5709         $currentrange = '';
5710     };
5711
5712     for (my $i = 0; $i < length($ranges); $i ++) {
5713         my $c = substr($ranges, $i, 1);
5714         if (!$invalidrange) {
5715             if ($c =~ /\d/) {
5716                 # Digit
5717                 if ($currentkeyword) {
5718                     # Add to keyword
5719                     $currentkeyword .= $c;
5720                 } else {
5721                     # Build a page number
5722                     $currentnumber *= 10;
5723                     $currentnumber += $c;
5724                 }
5725             } elsif ($c =~ /[a-z_]/i) {
5726                 # Letter or underscore
5727                 if (($rangestart > 0) || ($currentnumber > 0)) {
5728                     # Keyword not allowed after a page number or a
5729                     # page range
5730                     $invalidrange = 1;
5731                 } else {
5732                     # Build a keyword
5733                     $currentkeyword .= $c;
5734                 }
5735             } elsif ($c eq '-') {
5736                 # Page range 
5737                 if (($rangestart > 0) || ($currentkeyword)) {
5738                     # Keyword or two '-' not allowed in page range
5739                     $invalidrange = 1;
5740                 } else {
5741                     # Save start of range, reset page number
5742                     $rangestart = $currentnumber;
5743                     if ($rangestart == 0) {
5744                         $rangestart = 1;
5745                     }
5746                     $currentnumber = 0;
5747                 }
5748             } 
5749         }
5750         if ($c eq ',') {
5751             # End of a range
5752             &$evaluaterange();
5753         } else {
5754             # Make a string of the current range, for warnings
5755             $currentrange .= $c;
5756         }
5757     }
5758     # End of input string
5759     &$evaluaterange();
5760     # Return value
5761     if (($page == 0) || ($pageinside)) {
5762         return $totalscore;
5763     } else {
5764         return 0;
5765     }
5766 }
5767
5768 sub setoptionsforpage {
5769
5770     ## Set the options for a given page
5771
5772     # Foomatic data, name of the option set where to apply the options, and
5773     # number of the page
5774     my ($dat, $optionset, $page) = @_;
5775
5776     my $value;
5777     for my $arg (@{$dat->{'args'}}) {
5778         $value = '';
5779         my $bestscore = 10000000;
5780         for my $key (keys %{$arg}) {
5781             next if $key !~ /^pages:(.*)$/;
5782             my $pageranges = $1;
5783             if (my $score = parsepageranges($pageranges, $page)) {
5784                 if ($score <= $bestscore) {
5785                     $bestscore = $score;
5786                     $value = $arg->{$key};
5787                 }
5788             }
5789         }
5790         if ($value) {
5791             $arg->{$optionset} = $value;
5792         }
5793     }
5794 }
5795
5796 sub buildcommandline {
5797
5798     ## Build a renderer command line, based on the given option set
5799
5800     # Foomatic data and name of the option set to apply
5801     my ($dat, $optionset) = @_;
5802
5803     # Construct the proper command line.
5804     $dat->{'currentcmd'} = $dat->{'cmd'};
5805     my @prologprepend;
5806     my @setupprepend;
5807     my @pagesetupprepend;
5808     my @cupspagesetupprepend;
5809     my @jclprepend;
5810     my @jclappend;
5811
5812     # At first search for composite options and determine how they
5813     # set their member options
5814     for my $arg (@{$dat->{'args'}}) { $arg->{'order'} = 0 if !defined $arg->{'order'}; }
5815     for my $arg (sort { $a->{'order'} <=> $b->{'order'} } 
5816               @{$dat->{'args'}}) {
5817
5818         # Here we are only interested in composite options, skip the others
5819         next if $arg->{'style'} ne 'X';
5820         
5821         my $name = $arg->{'name'};
5822         # Check whether this composite option is controlled by another
5823         # composite option, so nested composite options are possible.
5824         my $userval = ($arg->{'fromcomposite'} ?
5825                        $arg->{'fromcomposite'} : $arg->{$optionset});
5826
5827         # Get the current setting
5828         my $v = $arg->{'vals_byname'}{$userval};
5829         my @settings = split(/\s+/s, $v->{'driverval'});
5830         for my $s (@settings) {
5831             my ($key, $value);
5832             if ($s =~ /^([^=]+)=(.+)$/) {
5833                 $key = $1;
5834                 $value = $2;
5835             } elsif ($s =~ /^no([^=]+)$/) {
5836                 $key = $1;
5837                 $value = 0;
5838             } elsif ($s =~ /^([^=]+)$/) {
5839                 $key = $1;
5840                 $value = 1;
5841             }
5842             $a = $dat->{'args_byname'}{$key};
5843             if ($a->{$optionset} eq "From$name") {
5844                 # We must set this option according to the
5845                 # composite option
5846                 $a->{'fromcomposite'} = $value;
5847                 # Mark the option telling by which composite option
5848                 # it is controlled
5849                 $a->{'controlledby'} = $name;
5850             } else {
5851                 $a->{'fromcomposite'} = "";
5852             }
5853         }
5854         # Remove PostScript code to be inserted after an appearance of the
5855         # Composite option in the PostScript code.
5856         undef $arg->{'jclsetup'};
5857         undef $arg->{'prolog'};
5858         undef $arg->{'setup'};
5859         undef $arg->{'pagesetup'};
5860     }
5861
5862     for my $arg (sort { $a->{'order'} <=> $b->{'order'} } 
5863               @{$dat->{'args'}}) {
5864         
5865         # Composite options have no direct influence on the command
5866         # line, skip them here
5867         next if $arg->{'style'} eq 'X';
5868
5869         my $name = $arg->{'name'};
5870         my $spot = $arg->{'spot'};
5871         my $cmd = $arg->{'proto'};
5872         my $cmdf = $arg->{'protof'};
5873         my $type = ($arg->{'type'} || "");
5874         my $section = $arg->{'section'};
5875         my $userval = ($arg->{'fromcomposite'} ?
5876                        $arg->{'fromcomposite'} : $arg->{$optionset});
5877         my $cmdvar = "";
5878
5879         # If we have both "PageSize" and "PageRegion" options, we kept
5880         # them all the time in sync, so we don't need to insert the settings
5881         # of both options. So skip "PageRegion".
5882         next if (($name eq "PageRegion") &&
5883                  (defined($dat->{'args_byname'}{'PageSize'})) &&
5884                  (defined($dat->{'args_byname'}{'PageRegion'})));
5885
5886         # Build the command line snippet/PostScript/JCL code for the current
5887         # option
5888         if ($type eq 'bool') {
5889
5890             # If true, stick the proto into the command line, if false
5891             # and we have a proto for false, stick that in
5892             if (defined($userval) && $userval == 1) {
5893                 $cmdvar = $cmd;
5894             } elsif ($cmdf) {
5895                 $userval = 0;
5896                 $cmdvar = $cmdf;
5897             }
5898
5899         } elsif ($type eq 'int' or $type eq 'float') {
5900
5901             # If defined, process the proto and stick the result into
5902             # the command line or postscript queue.
5903             if (defined($userval)) {
5904                 my $min = $arg->{'min'};
5905                 my $max = $arg->{'max'};
5906                 # We have already range-checked, correct only
5907                 # floating point inaccuricies here
5908                 if ($userval < $min) {
5909                     $userval = $min;
5910                 }
5911                 if ($userval > $max) {
5912                     $userval = $max;
5913                 }
5914                 my $sprintfcmd = $cmd;
5915                 $sprintfcmd =~ s/\%(?!s)/\%\%/g;
5916                 $cmdvar = sprintf($sprintfcmd,
5917                                   ($type eq 'int' 
5918                                    ? sprintf("%d", $userval)
5919                                    : sprintf("%f", $userval)));
5920             } else {
5921                 $userval = 'None';
5922             }
5923
5924         } elsif ($type eq 'enum') {
5925
5926             # If defined, stick the selected value into the proto and
5927             # thence into the commandline
5928             if (defined($userval)) {
5929                 # CUPS assumes that options with the choices "Yes", "No",
5930                 # "On", "Off", "True", or "False" are boolean options and
5931                 # maps "-o Option=On" to "-o Option" and "-o Option=Off"
5932                 # to "-o noOption", which foomatic-rip maps to "0" and "1".
5933                 # So when "0" or "1" is unavailable in the option, we try
5934                 # "Yes", "No", "On", "Off", "True", and "False".
5935                 my $val;
5936                 my $found = 0;
5937                 if ($val=valbyname($arg,$userval)) {
5938                     $found = 1;
5939                 } elsif ($userval =~ /^Custom\.[\d\.]+x[\d\.]+[A-Za-z]*$/) {
5940                     # Custom paper size
5941                     $val = valbyname($arg,"Custom");
5942                     $found = 1;
5943                 } elsif ($userval =~ /^(0|No|Off|False)$/i) {
5944                     foreach (qw(0 No Off False None)) {
5945                         if ($val=valbyname($arg,$_)) {
5946                             $userval = $_;
5947                             $arg->{$optionset} = $userval;
5948                             $found = 1;
5949                             last;
5950                         }
5951                     }
5952                 } elsif ($userval =~ /^(1|Yes|On|True)$/i) {
5953                     foreach (qw(1 Yes On True)) {
5954                         if ($val=valbyname($arg,$_)) {
5955                             $userval = $_;
5956                             $arg->{$optionset} = $userval;
5957                             $found = 1;
5958                             last;
5959                         }
5960                     }
5961                 } elsif ($userval =~ /^(LongEdge|DuplexNoTumble)$/i) {
5962                     # Handle different names for the choices of the
5963                     # "Duplex" option
5964                     foreach (qw(LongEdge DuplexNoTumble)) {
5965                         if ($val=valbyname($arg,$_)) {
5966                             $userval = $_;
5967                             $arg->{$optionset} = $userval;
5968                             $found = 1;
5969                             last;
5970                         }
5971                     }
5972                 } elsif ($userval =~ /^(ShortEdge|DuplexTumble)$/i) {
5973                     foreach (qw(ShortEdge DuplexTumble)) {
5974                         if ($val=valbyname($arg,$_)) {
5975                             $userval = $_;
5976                             $arg->{$optionset} = $userval;
5977                             $found = 1;
5978                             last;
5979                         }
5980                     }
5981                 }
5982                 if ($found) {
5983                     my $sprintfcmd = $cmd;
5984                     $sprintfcmd =~ s/\%(?!s)/\%\%/g;
5985                     $cmdvar = sprintf($sprintfcmd,
5986                                       (defined($val->{'driverval'})
5987                                        ? $val->{'driverval'}
5988                                        : $val->{'value'}));
5989                     # Custom paper size
5990                     if ($userval =~ /^Custom\.([\d\.]+)x([\d\.]+)([A-Za-z]*)$/) {
5991                         my $width = $1;
5992                         my $height = $2;
5993                         my $unit = $3;
5994                         # convert width and height to PostScript points
5995                         if (lc($unit) eq "in") {
5996                             $width *= 72.0;
5997                             $height *= 72.0;
5998                         } elsif (lc($unit) eq "cm") {
5999                             $width *= (72.0/2.54);
6000                             $height *= (72.0/2.54);
6001                         } elsif (lc($unit) eq "mm") {
6002                             $width *= (72.0/25.4);
6003                             $height *= (72.0/25.4);
6004                         }
6005                         # Round width and height
6006                         $width =~ s/\.[0-4].*$// or
6007                             $width =~ s/\.[5-9].*$// and $width += 1;
6008                         $height =~ s/\.[0-4].*$// or
6009                             $height =~ s/\.[5-9].*$// and $height += 1;
6010                         # Insert width and height into the prototype
6011                         if ($cmdvar =~ /^\s*pop\W/s) {
6012                             # Custom page size for PostScript printers
6013                             $cmdvar = "$width $height 0 0 0\n$cmdvar";
6014                         } else {
6015                             # Custom page size for Foomatic/Gutenprint/
6016                             # Gimp-Print
6017                             $cmdvar =~ s/\%0/$width/ or
6018                                 $cmdvar =~ s/(\W)0(\W)/$1$width$2/ or
6019                                 $cmdvar =~ s/^0(\W)/$width$1/m or
6020                                 $cmdvar =~ s/(\W)0$/$1$width/m or
6021                                 $cmdvar =~ s/^0$/$width/m;
6022                             $cmdvar =~ s/\%1/$height/ or
6023                                 $cmdvar =~ s/(\W)0(\W)/$1$height$2/ or
6024                                 $cmdvar =~ s/^0(\W)/$height$1/m or
6025                                 $cmdvar =~ s/(\W)0$/$1$height/m or
6026                                 $cmdvar =~ s/^0$/$height/m;
6027                         }
6028                     }
6029                 } else {
6030                     # User gave unknown value?
6031                     $userval = 'None';
6032                     print $logh "Value $userval for $name is not a valid choice.\n";
6033                 }
6034             } else {
6035                 $userval = 'None';
6036             }
6037
6038         } elsif (($type eq 'string') || ($type eq 'password')) {
6039             # Stick the entered value into the proto and
6040             # thence into the commandline
6041             if (defined($userval)) {
6042                 my $val;
6043                 if ($val=valbyname($arg,$userval)) {
6044                     $userval = $val->{'value'};
6045                     $cmdvar = (defined($val->{'driverval'})
6046                                        ? $val->{'driverval'}
6047                                        : $val->{'value'});
6048                 } else {
6049                     my $sprintfcmd = $cmd;
6050                     $sprintfcmd =~ s/\%(?!s)/\%\%/g;
6051                     $cmdvar = sprintf($sprintfcmd, $userval);
6052                 }
6053             } else {
6054                 $userval = 'None';
6055             }
6056
6057         } else {
6058             # Ignore unknown option types silently
6059         }
6060         
6061         # Insert the built snippet at the correct place
6062         if ($arg->{'style'} eq 'G') {
6063             # Place this Postscript command onto the prepend queue
6064             # for the appropriate section.
6065             if ($cmdvar) {
6066                 my $open = "[{\n%%BeginFeature: *$name ";
6067                 if ($type eq 'bool') {
6068                     $open .= ($userval == 1 ? "True" : "False") . "\n";
6069                 } else {
6070                     $open .= "$userval\n";
6071                 }
6072                 my $close = "\n%%EndFeature\n} stopped cleartomark\n";
6073                 if ($section eq "Prolog") {
6074                     push (@prologprepend, "$open$cmdvar$close");
6075                     my $a = $arg;
6076                     while ($a->{'controlledby'}) {
6077                         # Collect option PostScript code to be inserted when
6078                         # the composite option which controls this option
6079                         # is found in the PostScript code
6080                         $a = $dat->{'args_byname'}{$a->{'controlledby'}};
6081                         $a->{'prolog'} .= "$cmdvar\n";
6082                     }
6083                 } elsif ($section eq "AnySetup") {
6084                     if ($optionset ne 'currentpage') {
6085                         push (@setupprepend, "$open$cmdvar$close");
6086                     } elsif ($arg->{'header'} ne $userval) {
6087                         push (@pagesetupprepend, "$open$cmdvar$close");
6088                         push (@cupspagesetupprepend, "$open$cmdvar$close");
6089                     }
6090                     my $a = $arg;
6091                     while ($a->{'controlledby'}) {
6092                         # Collect option PostScript code to be inserted when
6093                         # the composite option which controls this option
6094                         # is found in the PostScript code
6095                         $a = $dat->{'args_byname'}{$a->{'controlledby'}};
6096                         $a->{'setup'} .= "$cmdvar\n";
6097                         $a->{'pagesetup'} .= "$cmdvar\n";
6098                     }
6099                 } elsif ($section eq "DocumentSetup") {
6100                     push (@setupprepend, "$open$cmdvar$close");
6101                     my $a = $arg;
6102                     while ($a->{'controlledby'}) {
6103                         # Collect option PostScript code to be inserted when
6104                         # the composite option which controls this option
6105                         # is found in the PostScript code
6106                         $a = $dat->{'args_byname'}{$a->{'controlledby'}};
6107                         $a->{'setup'} .= "$cmdvar\n";
6108                     }
6109                 } elsif ($section eq "PageSetup") {
6110                     push (@pagesetupprepend, "$open$cmdvar$close");
6111                     my $a = $arg;
6112                     while ($a->{'controlledby'}) {
6113                         # Collect option PostScript code to be inserted when
6114                         # the composite option which controls this option
6115                         # is found in the PostScript code
6116                         $a = $dat->{'args_byname'}{$a->{'controlledby'}};
6117                         $a->{'pagesetup'} .= "$cmdvar\n";
6118                     }
6119                 } elsif ($section eq "JCLSetup") {
6120                     # PJL/JCL argument
6121                     $dat->{'jcl'} = 1;
6122                     push (@jclprepend, unhexify($cmdvar));
6123                     my $a = $arg;
6124                     while ($a->{'controlledby'}) {
6125                         # Collect option PostScript code to be inserted when
6126                         # the composite option which controls this option
6127                         # is found in the PostScript code
6128                         $a = $dat->{'args_byname'}{$a->{'controlledby'}};
6129                         $a->{'jclsetup'} .= "$cmdvar\n";
6130                     }
6131                 } else {
6132                     push (@setupprepend, "$open$cmdvar$close");
6133                     my $a = $arg;
6134                     while ($a->{'controlledby'}) {
6135                         # Collect option PostScript code to be inserted when
6136                         # the composite option which controls this option
6137                         # is found in the PostScript code
6138                         $a = $dat->{'args_byname'}{$a->{'controlledby'}};
6139                         $a->{'setup'} .= "$cmdvar\n";
6140                     }
6141                 }
6142             }
6143             # Do we have an option which is set to "Controlled by 
6144             # '<Composite>'"? Then make PostScript code available
6145             # for substitution of "%% FoomaticRIPOptionSetting: ..." 
6146             if ($arg->{'fromcomposite'}) {
6147                 $arg->{'compositesubst'} = "$cmdvar\n";
6148             }
6149         } elsif ($arg->{'style'} eq 'J') {
6150             # JCL argument
6151             $dat->{'jcl'} = 1;
6152             # put JCL commands onto JCL stack...
6153             push (@jclprepend, "$jclprefix$cmdvar\n") if $cmdvar;
6154         } elsif ($arg->{'style'} eq 'C') {
6155             # command-line argument
6156
6157             # Insert the processed argument in the commandline
6158             # just before every occurance of the spot marker.
6159             $dat->{'currentcmd'} =~ s!\%$spot!$cmdvar\%$spot!g;
6160         }
6161         # Insert option into command line of CUPS raster driver
6162         if ($dat->{'currentcmd'} =~ m!\%Y!) {
6163             next if !defined($userval) or $userval eq "";
6164             $dat->{'currentcmd'} =~ s!\%Y!$name=$userval \%Y!g;
6165         }
6166         # Remove the marks telling that this option is currently controlled
6167         # by a composite option (setting "From<composite>")
6168         undef $arg->{'fromcomposite'};
6169         undef $arg->{'controlledby'};
6170     }
6171     
6172
6173     ### Tidy up after computing option statements for all of P, J, and
6174     ### C types:
6175
6176     ## C type finishing
6177     # Pluck out all of the %n's from the command line prototype
6178     my @letters = qw/A B C D E F G H I J K L M W X Y Z/;
6179     for my $spot (@letters) {
6180         # Remove the letter markers from the commandline
6181         $dat->{'currentcmd'} =~ s!\%$spot!!g;
6182     }
6183
6184     ## J type finishing
6185     # Compute the proper stuff to say around the job
6186
6187     if ((defined($dat->{'jcl'})) && (!$jobhasjcl)) {
6188
6189         # Stick beginning of job cruft on the front of the jcl stuff...
6190         unshift (@jclprepend, $jclbegin);
6191
6192         # Command to switch to the interpreter
6193         push (@jclprepend, $jcltointerpreter);
6194         
6195         # Arrange for JCL RESET command at end of job
6196         push (@jclappend, $jclend);
6197
6198         # Put the JCL stuff into the data structure
6199         @{$dat->{'jclprepend'}} = @jclprepend;
6200         @{$dat->{'jclappend'}} = @jclappend;
6201     }
6202
6203     ## G type finishing
6204     # Save PostScript options
6205     @{$dat->{'prologprepend'}} = @prologprepend;
6206     @{$dat->{'setupprepend'}} = @setupprepend;
6207     @{$dat->{'pagesetupprepend'}} = @pagesetupprepend;
6208     @{$dat->{'cupspagesetupprepend'}} = @cupspagesetupprepend;
6209 }
6210
6211 sub buildpdqdriver {
6212
6213     # Build a PDQ driver description file to use the given PPD file
6214     # together with foomatic-rip with the PDQ printing system
6215
6216     # Foomatic data and name of the option set for the default settings
6217     my ($dat, $optionset) = @_;
6218
6219     # Construct structure with driver information
6220     my @pdqdriver = ();
6221
6222     # Construct option list
6223     my @driveropts = ();
6224
6225     # Do we have a "Custom" setting for the page size?
6226     # Then we have to insert the following into the "filter_exec" script.
6227     my @setcustompagesize = ();
6228
6229     # Fata for a custom page size, to allow a custom size as default
6230     my $pagewidth = 612;
6231     my $pageheight = 792;
6232     my $pageunit = "pt";
6233
6234
6235
6236     ## First, compute the various option/value clauses
6237     for my $arg (@{$dat->{'args'}}) {
6238
6239         if ($arg->{'type'} eq "enum") {
6240             
6241             # Option with only one choice, omit it, foomatic-rip will set 
6242             # this choice anyway.
6243             next if ($#{$arg->{'vals'}} < 1);
6244
6245             my $nam = $arg->{'name'};
6246
6247             # Omit "PageRegion" option, it does the same as "PageSize".
6248             next if $nam eq "PageRegion";
6249
6250             my $com = $arg->{'comment'};
6251
6252             # Assure that the comment is not empty
6253             if (!$com) {
6254                 $com = $nam;
6255             }
6256
6257             my $def = $arg->{$optionset};
6258             $arg->{'varname'} = "$nam";
6259             $arg->{'varname'} =~ s![\-\/\.]!\_!g;
6260             my $varn = $arg->{'varname'};
6261
6262             # 1, if setting "PageSize=Custom" was found
6263             # Then we must add options for page width and height
6264             my $custompagesize = 0;
6265
6266             # If the default is a custom size we have to set also
6267             # defaults for the width, height, and units of the page
6268             if (($nam eq "PageSize") &&
6269                 ($def =~ /^Custom\.([\d\.]+)x([\d\.]+)([A-Za-z]*)$/)) {
6270                 $def = "Custom";
6271                 $pagewidth = $1;
6272                 $pageheight = $2;
6273                 $pageunit = $3;
6274             }
6275
6276             # No quotes, thank you.
6277             $com =~ s!\"!\\\"!g;
6278             
6279             push(@driveropts,
6280                  "  option {\n",
6281                  "    var = \"$varn\"\n",
6282                  "    desc = \"$com\"\n");
6283             
6284             # get enumeration values for each enum arg
6285             my ($ev, @vals, @valstmp);
6286             for $ev (@{$arg->{'vals'}}) {
6287                 my $choiceshortname = $ev->{'value'};
6288                 my $choicename = "${nam}_${choiceshortname}";
6289                 my $val = " -o ${nam}=${choiceshortname}";
6290                 my $com = $ev->{'comment'};
6291
6292                 # Assure that the comment is not empty
6293                 if (!$com) {
6294                     $com = $choiceshortname;
6295                 }
6296
6297                 # stick another choice on driveropts
6298                 push(@valstmp,
6299                      "    choice \"$choicename\" {\n",
6300                      "      desc = \"$com\"\n",
6301                      "      value = \"$val\"\n",
6302                      "    }\n");
6303                 if (($nam eq "PageSize") && 
6304                     ($choiceshortname eq "Custom")) {
6305                     $custompagesize = 1;
6306                     if ($#setcustompagesize < 0) {
6307                         push(@setcustompagesize,
6308                              "      # Custom page size settings\n",
6309                              "      # We aren't really checking for " .
6310                              "legal vals.\n",
6311                              "      if [ \"x\${$varn}\" = 'x$val' ]; " .
6312                              "then\n",
6313                              "        $varn=\"\${$varn}.\${PageWidth}" .
6314                              "x\${PageHeight}\${PageSizeUnit}\"\n",
6315                              "      fi\n\n");
6316                     }
6317                 }
6318             }
6319
6320             push(@driveropts,
6321                  "    default_choice \"" . $nam . "_" . $def . "\"\n",
6322                  @valstmp,
6323                  "  }\n\n");
6324
6325             if ($custompagesize) {
6326                 # Add options to set the custom page size
6327                 push(@driveropts,
6328                      "  argument {\n",
6329                      "    var = \"PageWidth\"\n",
6330                      "    desc = \"Page Width (for \\\"Custom\\\" page " .
6331                      "size)\"\n",
6332                      "    def_value \"$pagewidth\"\n",
6333                      "    help = \"Minimum value: 0, Maximum value: " .
6334                      "100000\"\n",
6335                      "  }\n\n",
6336                      "  argument {\n",
6337                      "    var = \"PageHeight\"\n",
6338                      "    desc = \"Page Height (for \\\"Custom\\\" page " .
6339                      "size)\"\n",
6340                      "    def_value \"$pageheight\"\n",
6341                      "    help = \"Minimum value: 0, Maximum value: " .
6342                      "100000\"\n",
6343                      "  }\n\n",
6344                      "  option {\n",
6345                      "    var = \"PageSizeUnit\"\n",
6346                      "    desc = \"Unit (for \\\"Custom\\\" page size)\"\n",
6347                      "    default_choice \"PageSizeUnit_$pageunit\"\n",
6348                      "    choice \"PageSizeUnit_pt\" {\n",
6349                      "      desc = \"Points (1/72 inch)\"\n",
6350                      "      value = \"pt\"\n",
6351                      "    }\n",
6352                      "    choice \"PageSizeUnit_in\" {\n",
6353                      "      desc = \"Inches\"\n",
6354                      "      value = \"in\"\n",
6355                      "    }\n",
6356                      "    choice \"PageSizeUnit_cm\" {\n",
6357                      "      desc = \"cm\"\n",
6358                      "      value = \"cm\"\n",
6359                      "    }\n",
6360                      "    choice \"PageSizeUnit_mm\" {\n",
6361                      "      desc = \"mm\"\n",
6362                      "      value = \"mm\"\n",
6363                      "    }\n",
6364                      "  }\n\n");                
6365             }
6366             
6367         } elsif ($arg->{'type'} eq 'int' or $arg->{'type'} eq 'float') {
6368             
6369             my $nam = $arg->{'name'};
6370             my $com = $arg->{'comment'};
6371
6372             # Assure that the comment is not empty
6373             if (!$com) {
6374                 $com = $nam;
6375             }
6376
6377             my $def = $arg->{$optionset};
6378             my $max = $arg->{'max'};
6379             my $min = $arg->{'min'};
6380             $arg->{'varname'} = "$nam";
6381             $arg->{'varname'} =~ s![\-\/\.]!\_!g;
6382             my $varn = $arg->{'varname'};
6383             my $legal = $arg->{'legal'} = 
6384                 "Minimum value: $min, Maximum value: $max";
6385             
6386             my $defstr = "";
6387             if ($def) {
6388                 $defstr = sprintf("    def_value \"%s\"\n", $def);
6389             }
6390             
6391             push(@driveropts,
6392                  "  argument {\n",
6393                  "    var = \"$varn\"\n",
6394                  "    desc = \"$com\"\n",
6395                  $defstr,
6396                  "    help = \"$legal\"\n",
6397                  "  }\n\n");
6398             
6399         } elsif ($arg->{'type'} eq 'bool') {
6400             
6401             my $nam = $arg->{'name'};
6402             my $com = $arg->{'comment'};
6403
6404             # Assure that the comment is not empty
6405             if (!$com) {
6406                 $com = $nam;
6407             }
6408
6409             my $tcom = $arg->{'comment_true'};
6410             my $fcom = $arg->{'comment_false'};
6411             my $def = $arg->{$optionset};
6412             $arg->{'legal'} = "Value is a boolean flag";
6413             $arg->{'varname'} = "$nam";
6414             $arg->{'varname'} =~ s![\-\/\.]!\_!g;
6415             my $varn = $arg->{'varname'};
6416             
6417             my $defstr = "";
6418             if ($def) {
6419                 $defstr = sprintf("    default_choice \"%s\"\n", 
6420                                   $def ? "$nam" : "no$nam");
6421             } else {
6422                 $defstr = sprintf("    default_choice \"%s\"\n", "no$nam");
6423             }
6424             push(@driveropts,
6425                  "  option {\n",
6426                  "    var = \"$varn\"\n",
6427                  "    desc = \"$com\"\n",
6428                  $defstr,
6429                  "    choice \"$nam\" {\n",
6430                  "      desc = \"$tcom\"\n",
6431                  "      value = \" -o $nam=True\"\n",
6432                  "    }\n",
6433                  "    choice \"no$nam\" {\n",
6434                  "      desc = \"$fcom\"\n",
6435                  "      value = \" -o $nam=False\"\n",
6436                  "    }\n",
6437                  "  }\n\n");
6438
6439         } elsif ($arg->{'type'} eq 'string' or $arg->{'type'} eq 'password') {
6440             
6441             my $nam = $arg->{'name'};
6442             my $com = $arg->{'comment'};
6443
6444             # Assure that the comment is not empty
6445             if (!$com) {
6446                 $com = $nam;
6447             }
6448
6449             my $def = $arg->{$optionset};
6450             my $maxlength = $arg->{'maxlength'};
6451             my $proto = $arg->{'proto'};
6452             $arg->{'varname'} = "$nam";
6453             $arg->{'varname'} =~ s![\-\/\.]!\_!g;
6454             my $varn = $arg->{'varname'};
6455
6456             my $legal;
6457             if (defined($maxlength)) {
6458                 $legal .= "Maximum length: $maxlength characters, ";
6459             }
6460             $legal .= "Examples/special settings: ";
6461             for (@{$arg->{'vals'}}) {
6462                 my ($value, $comment, $driverval) = 
6463                     ($_->{'value'}, $_->{'comment'}, $_->{'driverval'});
6464                 # Retrieve the original string from the prototype
6465                 # and the driverval
6466                 my $string;
6467                 if ($proto) {
6468                     my $s = index($proto, '%s');
6469                     my $l = length($driverval) - length($proto) + 2;
6470                     if (($s < 0) || ($l < 0)) {
6471                         $string = $driverval;
6472                     } else {
6473                         $string = substr($driverval, $s, $l);
6474                     }
6475                 } else {
6476                     $string = $driverval;
6477                 }
6478                 if ($value ne $string) {
6479                     $legal .= "${value}: \\\"$string\\\"";
6480                 } else {
6481                     $legal .= "\\\"$value\\\"";
6482                 }
6483                 if ($comment && ($value ne $comment) && 
6484                     ($string ne $comment) && 
6485                     (($value ne 'None') || ($comment ne '(None)'))) {
6486                     $legal .= " ($comment)";
6487                 }
6488                 $legal .= "; ";
6489             }
6490             $legal =~ s/; $//;
6491
6492             $arg->{'legal'} = $legal;
6493             
6494             my $defstr = "";
6495             if ($def) {
6496                 $defstr = sprintf("    def_value \"%s\"\n", $def);
6497             }
6498             
6499             push(@driveropts,
6500                  "  argument {\n",
6501                  "    var = \"$varn\"\n",
6502                  "    desc = \"$com\"\n",
6503                  $defstr,
6504                  "    help = \"$legal\"\n",
6505                  "  }\n\n");
6506             
6507         }
6508         
6509     }
6510     
6511
6512
6513     ## Define the "docs" option to print the driver documentation page
6514
6515     push(@driveropts,
6516          "  option {\n",
6517          "    var = \"DRIVERDOCS\"\n",
6518          "    desc = \"Print driver usage information\"\n",
6519          "    default_choice \"nodocs\"\n", 
6520          "    choice \"docs\" {\n",
6521          "      desc = \"Yes\"\n",
6522          "      value = \" -o docs\"\n",
6523          "    }\n",
6524          "    choice \"nodocs\" {\n",
6525          "      desc = \"No\"\n",
6526          "      value = \"\"\n",
6527          "    }\n",
6528          "  }\n\n");
6529     
6530
6531
6532     ## Build the "foomatic-rip" command line
6533     my $commandline = "foomatic-rip --pdq";
6534     if ($printer) {
6535         $commandline .= " -P $printer";
6536     } else {
6537         # Make sure that the PPD file is entered with an absolute path
6538         if ($ppdfile !~ m!^/!) {        
6539             my $pwd = cwd;
6540             $ppdfile = "$pwd/$ppdfile";
6541         }
6542         $commandline .= " --ppd=$ppdfile";
6543     }
6544     for my $arg (@{$dat->{'args'}}) {
6545         if ($arg->{'varname'}) {
6546             $commandline .= "\${$arg->{'varname'}}";
6547         }
6548     }
6549     $commandline .= "\${DRIVERDOCS} \$INPUT > \$OUTPUT";
6550
6551
6552         
6553     ## Now we generate code to build the command line snippets for the
6554     ## numerical options
6555
6556     my @psfilter;
6557     for my $arg (@{$dat->{'args'}}) {
6558                 
6559         # Only numerical and string options need to be treated here
6560         next if (($arg->{'type'} ne 'int') && 
6561                  ($arg->{'type'} ne 'float') &&
6562                  ($arg->{'type'} ne 'string') &&
6563                  ($arg->{'type'} ne 'password'));
6564
6565         my $comment = $arg->{'comment'};
6566         my $name = $arg->{'name'};
6567         my $varname = $arg->{'varname'};
6568                     
6569         # If the option's variable is non-null, put in the
6570         # argument.  Otherwise this option is the empty
6571         # string.  Error checking?
6572                     
6573         push(@psfilter,
6574              "      # $comment\n",
6575              (($arg->{'type'} eq 'int') || ($arg->{'type'} eq 'float') ?
6576               ("      # We aren't really checking for max/min,\n",
6577                "      # this is done by foomatic-rip\n",
6578                "      if [ \"x\${$varname}\" != 'x' ]; then\n  ") : ""),
6579              #"      $varname=`echo \${$varname} | perl -p -e \"s/'/'\\\\\\\\\\\\\\\\''/g\"`\n",
6580              "      $varname=\" -o $name='\${$varname}'\"\n",
6581              (($arg->{'type'} eq 'int') || ($arg->{'type'} eq 'float') ?
6582               "      fi\n" : ""),
6583              "\n");
6584     }
6585
6586     # Command execution
6587
6588     push(@psfilter,
6589          "      if ! test -e \$INPUT.ok; then\n",
6590          "        sh -c \"$commandline\"\n",
6591          "        if ! test -e \$OUTPUT; then \n",
6592          "          echo 'Error running foomatic-rip; no output!'\n",
6593          "          exit 1\n",
6594          "        fi\n",
6595          "      else\n",
6596          "        ln -s \$INPUT \$OUTPUT\n",
6597          "      fi\n\n");
6598     
6599     my $version = time();
6600     my $name = "$model-$version";
6601     $name =~ s/\W/\-/g;
6602     $name =~ s/\-+/\-/g;
6603     
6604     my $pname = $model;
6605     
6606     push (@pdqdriver,
6607           "driver \"$name\" {\n\n",
6608           "  # This PDQ driver declaration file was generated " .
6609           "automatically by\n",
6610           "  # foomatic-rip from information in the file $ppdfile.\n",
6611           "  # It allows printing with PDQ on the $pname.\n",
6612           "\n",
6613           "  requires \"foomatic-rip\"\n\n",
6614           @driveropts,
6615           "  language_driver all {\n",
6616           "    # We accept all file types and pass them to foomatic-rip\n",
6617           "    # (invoked in \"filter_exec {}\" section) without\n", 
6618           "    # pre-filtering\n",
6619           "    filetype_regx \"\"\n",
6620           "    convert_exec {\n",
6621           "      ln -s \$INPUT \$OUTPUT\n",
6622           "    }\n",
6623           "  }\n\n",
6624           "  filter_exec {\n",
6625           @setcustompagesize,
6626           @psfilter,
6627           "  }\n",
6628           "}\n");
6629     
6630     return @pdqdriver;
6631
6632 }
6633
6634 #
6635 # Convert lp or ipp based attribute names (and values) to something that matches# PPD file options.
6636 #
6637 sub option_to_ppd {
6638     my ($ipp_attribute) = @_;
6639     my ($key, $value, $result) = ();
6640
6641     if (/([^=]+)=[\'\"]?(.*}[\'\"]?)/) { # key=value
6642         ($key, $value) = ($1, $2);
6643     } elsif (/no(.+)/) {                 # BOOLEAN: no{key} (false)
6644         ($key, $value) = ($1, 'false');
6645     } else {                             # BOOLEAN: {key} (true)
6646         ($key, $value) = ($1, 'true');
6647     }
6648
6649     if (($key =~ /^job-/) || ($key =~ /^copies/) ||
6650         ($key =~ /^multiple-document-handling/) || ($key =~ /^number-up/) ||
6651         ($key =~ /^orientation-requested/) ||
6652         ($key =~ /^dest/) || ($key =~ /^protocol/) || ($key =~ /^banner/) ||
6653         ($key =~ /^page-ranges/)) {
6654         # Ignored:
6655         #    job-*, multiple-document-handling are not supported by this
6656         #             filter
6657         #    dest, protocol, banner, number-up, orientation-requested are
6658         #             handled by the LP filtering or interface script
6659         #    NOTE - page-ranges should probably be handled here, but
6660         #             ignore it until we decide how to handle it.
6661     } elsif (/^printer-resolution/) {
6662         # value match on "123, 457" or on "123, 457, 8"
6663         if (/([\d]+),([\s]*)([\d]+)((,([\s]*)([\d]+))??)/) {
6664             $result = '$1x$2$3 '; # (width)x(height)(units)
6665         }
6666     } elsif (/^print-quality/) {
6667         ($value == 3) &&
6668             ($result = 'PrintoutMode=Draft');
6669         ($value == 4) &&
6670             ($result = 'PrintoutMode=Normal');
6671         ($value == 5) &&
6672             ($result = 'PrintoutMode=High');
6673     } else {
6674         # NOTE - if key == 'media', we may need to convert the values at some
6675         #        point. (see RFC2911, Section 14 for values)
6676         $result = '$key=\"$value\"';
6677     }
6678
6679     return ($result);
6680 }
6681
6682 #
6683 # Read the attributes file containing the various job meta-data, including
6684 # requested capabilities
6685 #
6686 sub read_attribute_file {
6687     my ($file) = @_;
6688     my $result = "";
6689
6690     open (AFP, "<$file") ||
6691         (print $logh "Unable to open IPP Attribute file ".$file.", ignored: ".$!);
6692
6693     while(<AFP>) {
6694         $result .= option_to_ppd($_);
6695     }
6696
6697     close (AFP);
6698
6699     return ($result);
6700 }
6701
6702 sub modern_system {
6703     my (@list) = @_;
6704
6705     if ($modern_shell |~ /.+/) {
6706         # No "modern" shell other than the default shell was specified
6707         $modern_shell = '/bin/sh';
6708     }
6709
6710     my $pid = fork();
6711     ($pid < 0) && die "failed to fork()";
6712
6713     if ($pid == 0) {  # child, execute the commands under a modern shell
6714         # If the system supports process groups, we create a process
6715         # group of this subshell process. All the children of this
6716         # process (calls of external filters, renderers, or drivers)
6717         # will be members of this process group and so by killing this
6718         # process group we can kill all subprocesses and so we can
6719         # cleanly cancel print jobs
6720         $SIG{PIPE} = 'DEFAULT';
6721         eval("setpgrp()");
6722         # Stop catching signals
6723         #use sigtrap qw(die normal-signals error-signals
6724         #               handler do_nothing USR1 USR2 TTIN);
6725         exec($modern_shell, "-c", @list);
6726         rip_die("exec($modern_shell, \"-c\", @list);",
6727                 $EXIT_PRNERR_NORETRY_BAD_SETTINGS);
6728     } else { # parent, register child's PID, wait for the child, and
6729              # unregister the PID
6730         $pids{$pid} = substr(join(" ", @list), 0, 100) .
6731             (length(join(" ", @list)) > 100 ? "..." : "");
6732         print $logh "Starting process $pid: \"$pids{$pid}\"\n";
6733         waitpid($pid, 0);
6734         print $logh "Process $pid ending: \"$pids{$pid}\"\n";
6735         delete $pids{$pid};
6736     }
6737 }
6738
6739 # Emacs tabulator/indentation
6740
6741 ### Local Variables:
6742 ### tab-width: 8
6743 ### perl-indent-level: 4
6744 ### End: