home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / bin / foomatic-rip < prev    next >
Encoding:
Text File  |  2006-06-19  |  203.2 KB  |  6,500 lines

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