#! /usr/bin/perl # The above Perl path may vary on your system; fix it!!! # Cupsomatic is intended to be used as a CUPS filter for printers # defined in a PPD file (CUPS-O-Matic or PPD-O-Matic) obtained from # the Linux Printing Database. See # http://www.linuxprinting.org/cups-doc.html # Set this to a command you've got installed my $enscriptcommand = 'mpage -o -1 -P- -'; # my $enscriptcommand = "enscript args???"; # my $enscriptcommand = "nenscript args??"; # my $enscriptcommand = "a2ps args??"; # What 'echo' program to use. It needs -e and -n. Linux's builtin # and regular echo work fine; non-GNU platforms may need to install # gnu echo and put gecho here or something. # my $myecho = 'echo'; # What path to use for filter programs and such. Your printer driver # must be in the path, as must be Ghostscript, $enscriptcommand, and # possibly other stuff. The default path is often fine on Linux, but # may not be on other systems. # # $ENV{'PATH'} = '/usr/local/bin:/usr/bin:/bin'; # Set debug to 1 to enable the debug logfile for this filter; it will # appear as /tmp/prnlog It will contain status from this filter, plus # Ghostscript stderr output. # # WARNING: This logfile is a security hole; do not use in production. my $debug=0; # Where to send debugging log output to if ($debug) { # Grotesquely unsecure; use for debugging only open LOG, ">/tmp/prnlog"; $logh = *LOG; use IO::Handle; $logh->autoflush(1); } else { $logh=*STDERR; } # This piece of PostScript code (created 2001 by Michael Allerhand # (michael.allerhand@ed.ac.uk) lets GhostScript output the page # accounting information which CUPS needs on standard error. my $accounting_prolog = "[{ %% Code for writing CUPS accounting tags on standard error /cupsWrite { (%stderr) (w) file exch writestring } bind def /cupsEndPage { (PAGE: ) cupsWrite pop % ignore reason code 1 add 40 string cvs cupsWrite ( ) cupsWrite #copies 40 string cvs cupsWrite (\\n) cupsWrite true } bind def <>setpagedevice } stopped cleartomark "; # Uncomment this to deactivate accounting #$accounting_prolog = ""; ########### End interesting enduser options ############## # # cupsomatic Perl Foomatic filter script for CUPS # # Copyright 2000-2001 Grant Taylor # & Till Kamppeter # # This program is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by the Free # Software Foundation; either version 2 of the License, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License # for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Flush everything immediately. $|=1; my $comversion='$Revision: 1.12 $'; #'# Fix emacs syntax highlighting print $logh "Cupsomatic backend version $comversion running...\n"; print $logh "called with arguments: '",join("','",@ARGV),"'\n"; # Check for and handle inputfile vs stdin my $inputfile = $ARGV[5]; if ($inputfile and $inputfile ne '-') { print $logh 'inputfile handling is broken!!!'; warn 'inputfile handling is broken!!!'; } # We get the PPD filename in environment variable PPD. # Load the cups-o-matic data structure from it # Load also the defaults from the PPD syntax... my $ppdfile = $ENV{'PPD'}; print $logh "ppd=$ppdfile\n"; open PPD, "$ppdfile" || do { print $logh "error opening $ppdfile.\n"; die "unable to open ppd file $ppdfile"; }; my @datablob; # embedded data my %ppddefaults; # defaults from PPD while() { if (s!^\*\% COMDATA \#!!) { push (@datablob, $_); } elsif (m!^\*Default(\w+): (\w+)!) { $ppddefaults{$1} = $2; } } close PPD; # OK, we have the datablob eval join('',@datablob) || do { print $logh "unable to evaluate datablob\n"; die "error in datablob eval"; }; $dat = $VAR1; ## First, for arguments with a default, stick the default in as the ## userval. First take the defaults from the embedded data, then take ## the defaults as found in the PPD file: some people modify the PPD ## file directly to set new system-wide defaults. # from metadata for $arg (@{$dat->{'args'}}) { if ($arg->{'default'}) { $arg->{'userval'} = $arg->{'default'}; } } # from ppd file; these overwrite the standard defaults for $arg (@{$dat->{'args'}}) { my $ppddef = $ppddefaults{$arg->{'name'}}; if (defined($ppddef)) { my $name = $arg->{'name'}; if ($arg->{'type'} eq 'bool') { # This maps Unknown to mean False. Good? Bad? $arg->{'userval'} = ($ppddef eq 'True' ? '1' : '0'); } elsif ($arg->{'type'} eq 'enum') { if (defined($arg->{'vals_byname'}{$ppddef})) { $arg->{'userval'} = $ppddef; } else { # wtf!? that's not a choice! my $name=$arg->{'name'}; print $logh "PPD default value $ppddef for $name is not a choice!\n"; } } elsif (($arg->{'type'} eq 'int') || ($arg->{'type'} eq 'float')) { if (($ppddef <= $arg->{'max'}) && ($ppddef >= $arg->{'min'})) { $arg->{'userval'} = $ppddef; } else { print $logh "PPD default value $ppddef for $name is out of range!\n"; } } } } # so now what were the defaults? print them if debugging... if ($debug) { for $arg (@{$dat->{'args'}}) { my ($name, $val) = ($arg->{'name'}, $arg->{'userval'}); print $logh "Default for option $name is $val\n"; } } ## Next, examine the postscript job itself for traces of command-line ## and pjl options. Sometimes these don't show up in the CUPS filter ## 'options' argument! # Examination strategy: read some lines from STDIN. Put those lines # onto the stack @examined_stuff, which will be stuffed into # Ghostscript/whatever later on. print $logh "Seaerching job for option settings ...\n"; my $maxlines = 1000; # how many lines to examine? my $more_stuff = 1; # there is more stuff in stdin. my $linect = 0; # how many lines have we examined? my $last_setpagedevice = 0; # Find the last line with "setpagedevice" # and insert the accounting code afterwards. # If there is a "setpagedevice" after the # accounting code, an empty page would be # printed (and even accounted). do { my $line; if ($line=) { if ($linect == 0) { # Line zero should be postscript leader die 'job does not start with Postscript %! thing' if $line !~ m/^.?%!/; # There can be a Windows control char # before "%!" } else { if (($line =~ m/\%\%BeginFeature: \*?(\w+) (\w+)/) || ($line =~ m/\%\%\s*FoomaticOpt:\s*(\w+)=(\w+)/)) { my ($option, $value) = ($1, $2); # OK, we have an option. If it's not a # *ostscript-style option (ie, it's command-line or # PJL) then we should note that fact, since the # attribute-to-filteroption passing in CUPS is kind of # funky, especially wrt boolean options. print $logh "Found: $line"; if ($arg=argbyname($option)) { print $logh " Option: $option=$value"; if ($arg->{'style'} ne 'G') { print $logh " --> Setting option\n"; if ($arg->{'type'} eq 'bool') { # Boolean options are 1 or 0 if ($value eq 'True') { $arg->{'userval'} = 1; } elsif ($value eq 'False') { $arg->{'userval'} = 0; } else { warn "job contained boolean option", " with neither True nor False value!?"; } } elsif (($arg->{'type'} eq 'enum') || ($arg->{'type'} eq 'int') || ($arg->{'type'} eq 'float')) { # enum options go as the value, unless # they were Unknown... # Same with numerical options, they can appear # here when the client has used the Adobe- # compliant PPD-O-MATIC PPD file. if (lc($value) eq 'unknown') { $arg->{'userval'} = undef; } else { $arg->{'userval'} = $value; } } } else { # it is a postscript style option, presuemably # all applied for us and such... print $logh " --> Option will be set by PostScript interpreter\n"; } } else { # This option is unknown to us. WTF? warn "unknown option $option=$value found in the job"; } } # When "setpagedevice" is in the line, update the line number # of the last "setpagedevice" if ($line =~ /^[^\%]*setpagedevice/) { $last_setpagedevice = $linect; } } # Push the line onto the stack for later spitting up... push (@examined_stuff, $line); $linect++; } else { # EOF! $more_stuff = 0; } } while (($linect < $maxlines) and ($more_stuff != 0)); # Insert accounting code after the line with the last "setpagedevice" splice(@examined_stuff, $last_setpagedevice + 1, 0, $accounting_prolog); ## We get various options as argument 5. Parse these out. User-set ## values get stored as 'userval' in the argument's structure my $optstr = $ARGV[4]; print $logh "options: ->$optstr<-\n"; # Parse them. They're foo='bar nut', or foo, or 'bar nut', or # foo:'bar nut' (when GPR was used) all with spaces between... my @opts; # foo='bar nut' while ($optstr =~ s!(\w+=\'.+?\') ?!!) { push (@opts, $1); } # foo:'bar nut' (GPR separates option and setting with a colon ":") while ($optstr =~ s!(\w+:\'.+?\') ?!!) { push (@opts, $1); } # 'bar nut' while ($optstr =~ s!(\'.+?\') ?!!) { push (@opts, $1); } # foo push(@opts, split(/ /,$optstr)); # Now actually process those pesky options... for (@opts) { print $logh "Pondering option `$_'\n"; if (lc($_) eq 'docs') { $do_docs = 1; last; } my $arg; if ((m!(.+)=\'?(.+)\'?!) || (m!(.+):\'?(.+)\'?!)) { # GPR separates option and setting with a colon ":", all other # frontends use "=". my ($aname, $avalue) = ($1, $2); # Standard arguments? # media=x,y,z # sides=one|two-sided-long|short-edge # handled by cups for us? # page-ranges= # page-set= # number-up= # brightness= gamma= these probably collide with printer-specific # options. Hmm. CUPS has a stupid design for option # handling; everything gets all muddled together. # Rummage around in the media= option for known media, source, etc types. # We ought to do something sensible to make the common manual # boolean option work when specified as a media= tray thing. # # Note that this fails miserably when the option value is in # fact a number; they all look alike. It's unclear how many # drivers do that. We may have to standardize the verbose # names to make them work as selections, too. if ($aname =~ m!^media$!i) { my @values = split(',',$avalue); for (@values) { if ($dat->{'args_byname'}{'PageSize'} and $val=valbyname($dat->{'args_byname'}{'PageSize'},$_)) { $dat->{'args_byname'}{'PageSize'}{'userval'} = $val->{'value'}; } elsif ($dat->{'args_byname'}{'MediaType'} and $val=valbyname($dat->{'args_byname'}{'MediaType'},$_)) { $dat->{'args_byname'}{'MediaType'}{'userval'} = $val->{'value'}; } elsif ($dat->{'args_byname'}{'InputSlot'} and $val=valbyname($dat->{'args_byname'}{'InputSlot'},$_)) { $dat->{'args_byname'}{'InputSlot'}{'userval'} = $val->{'value'}; } elsif (lc($_) eq 'manualfeed') { # Special case for our typical boolean manual # feeder option if we didn't match an InputSlot above if (defined($dat->{'args_byname'}{'ManualFeed'})) { $dat->{'args_byname'}{'ManualFeed'}{'userval'} = 1; } } else { print $logh "Unknown media= component $_.\n"; } } } elsif ($aname =~ m!^sides$!i) { # Handle the standard duplex option, mostly if ($avalue =~ m!^two-sided!i) { if (defined($dat->{'args_byname'}{'Duplex'})) { # We set "Duplex" to '1' here, the real argument setting # will be done later $dat->{'args_byname'}{'Duplex'}{'userval'} = '1'; # Check the binding: "long edge" or "short edge" if ($avalue =~ m!long-edge!i) { if (defined($dat->{'args_byname'}{'Binding'})) { $dat->{'args_byname'}{'Binding'}{'userval'} = $dat->{'args_byname'}{'Binding'}{'vals_byname'}{'LongEdge'}{'value'}; } else { $dat->{'args_byname'}{'Duplex'}{'userval'} = 'LongEdge'; } } elsif ($avalue =~ m!short-edge!i) { if (defined($dat->{'args_byname'}{'Binding'})) { $dat->{'args_byname'}{'Binding'}{'userval'} = $dat->{'args_byname'}{'Binding'}{'vals_byname'}{'ShortEdge'}{'value'}; } else { $dat->{'args_byname'}{'Duplex'}{'userval'} = 'ShortEdge'; } } } } elsif ($avalue =~ m!^one-sided!i) { if (defined($dat->{'args_byname'}{'Duplex'})) { # We set "Duplex" to '0' here, the real argument setting # will be done later $dat->{'args_byname'}{'Duplex'}{'userval'} = '0'; } } # We should handle the other half of this option - the # BindEdge bit. Also, are there well-known ipp/cups # options for Collate and StapleLocation? These may be # here... } else { # Various non-standard printer-specific options if ($arg=argbyname($aname)) { $arg->{'userval'} = $avalue; # Special case for PPD undef in required defaults; etc. # The user himself should never be specifying 'Unknown'. if (lc($avalue) eq 'unknown') { $arg->{'userval'} = undef; } } else { print $logh "Unknown option $aname=$avalue.\n"; } } } elsif (m!no(.+)!i) { # standard bool args: # landscape; what to do here? # duplex; we should just handle this one OK now? if ($arg=argbyname($1)) { $arg->{'userval'} = 0; } else { print $logh "Unknown bool option $1.\n"; } } elsif (m!(.+)!) { if ($arg=argbyname($1)) { $arg->{'userval'} = 1; } else { print $logh "Unknown bool? option $1.\n"; } } } #### Everything below here ought to be generic for any printing #### system? It just uses the $dat structure, with user values filled #### in, and turns postscript into printer data. # Construct the proper command line. my $commandline = $dat->{'cmd'}; my $arg; argument: for $arg (sort { $a->{'order'} <=> $b->{'order'} } @{$dat->{'args'}}) { # Only do command-line and postscript style arguments. # I think PJL options may break some drivers? Uncomment if so # next argument if ($arg->{'style'} eq 'J'); my $name = $arg->{'name'}; my $spot = $arg->{'spot'}; my $varname = $arg->{'varname'}; my $cmd = $arg->{'proto'}; my $comment = $arg->{'comment'}; my $type = $arg->{'type'}; my $cmdvar = ""; my $userval = $arg->{'userval'}; my $psarg = ($arg->{'style'} eq 'G' ? 1 : 0); if ($type eq 'bool') { if ($psarg) { # P style args already done for us by cups } else { # If true, stick the proto into the command line if (defined($userval) && $userval == 1) { $cmdvar = $cmd; } } } elsif ($type eq 'int' or $type eq 'float') { # If defined, process the proto and stick the result into # the command line or postscript queue. if (defined($userval)) { my $min = $arg->{'min'}; my $max = $arg->{'max'}; if ($userval >= $min and $userval <= $max) { my $sprintfcmd = $cmd; $sprintfcmd =~ s!\%([^s])!\%\%$1!g; $cmdvar = sprintf($sprintfcmd, ($type eq 'int' ? sprintf("%d", $userval) : sprintf("%f", $userval))); } else { print $logh "Value $userval for $name is out of range $min<=x<=$max.\n"; } } } elsif ($type eq 'enum') { if ($psarg) { # CUPS handles enums for us... } else { # If defined, stick the selected value into the proto and # thence into the commandline if (defined($userval)) { # CUPS assumes that options with the choises "Yes", "No", # "On", "Off", "True", or "False" are boolean options and # maps "-o Option=On" to "-o Option" and "-o Option=Off" # to "-o noOption", which cupsomatic maps to "0" and "1". # So when "0" or "1" is unavailable in the option, we try # "Yes", "No", "On", "Off", "True", and "False". my $found = 0; my $val; if ($val=valbyname($arg,$userval)) { $found = 1; } elsif ($userval eq '0') { foreach (qw(No Off False None)) { if ($val=valbyname($arg,$_)) { $userval = $_; $arg->{'userval'} = $userval; $found = 1; last; } } } elsif ($userval eq '1') { foreach (qw(Yes On True)) { if ($val=valbyname($arg,$_)) { $userval = $_; $arg->{'userval'} = $userval; $found = 1; last; } } } elsif ($userval eq 'LongEdge') { # Handle different names for the choices of the # "Duplex" option foreach (qw(LongEdge DuplexNoTumble)) { if ($val=valbyname($arg,$_)) { $userval = $_; $arg->{'userval'} = $userval; $found = 1; last; } } } elsif ($userval eq 'ShortEdge') { foreach (qw(ShortEdge DuplexTumble)) { if ($val=valbyname($arg,$_)) { $userval = $_; $arg->{'userval'} = $userval; $found = 1; last; } } } if ($found) { my $sprintfcmd = $cmd; $sprintfcmd =~ s!\%([^s])!\%\%$1!g; $cmdvar = sprintf($sprintfcmd, (defined($val->{'driverval'}) ? $val->{'driverval'} : $val->{'value'})); } else { # User gave unknown value? print $logh "Value $userval for $name is not a valid choice.\n"; } } } } else { print $logh "unknown type for argument $name!?\n"; # die "evil type!?"; } if ($arg->{'style'} eq 'G') { if ($type eq 'int' or $type eq 'float') { # Place this Postscript command onto the prepend queue. push (@prepend, "$cmdvar\n") if $cmdvar; } else { # non numeric arguments are done for us by cups } } elsif ($arg->{'style'} eq 'J') { if (defined($dat->{'pjl'})) { # put PJL commands onto PJL stack... push (@pjlprepend, "\@PJL $cmdvar\n") if $cmdvar; } } elsif ($arg->{'style'} eq 'C') { # command-line argument # Insert the processed argument in the commandline # just before the spot marker. $commandline =~ s!\%$spot!$cmdvar\%$spot!; } } ### Tidy up after computing option statements for all of P, J, and C types: ## C type finishing # Pluck out all of the %n's from the command line prototype my @letters = qw/A B C D E F G H I J K L M Z/; for $spot (@letters) { # Remove the letter marker from the commandline $commandline =~ s!\%$spot!!; } ## J type finishing # Compute the proper stuff to say around the job if (defined($dat->{'pjl'})) { # Stick beginning of job cruft on the front of the pjl stuff... unshift (@pjlprepend, "\033%-12345X\@PJL JOB NAME=\"CUPSOMATIC\"\n"); # Arrange for PJL EOJ command at end of job push (@pjlappend, "\33%-12345X\@PJL RESET\n\@PJL EOJ\n"); print $logh "PJL: ", @pjlprepend, "\n", @pjlappend; } # Debugging printout of all option values if ($debug) { for $arg (@{$dat->{'args'}}) { my ($name, $val) = ($arg->{'name'}, $arg->{'userval'}); print $logh "Final value for option $name is $val\n"; } } # Now print the darned thing! if (! $do_docs) { # Run the proper command line. my ($driverh, $driverpid) = getdriverhandle(); print $driverh @examined_stuff; # first 1000 lines or so if ($debug != 0) { open DRIVERINPUT, "> /tmp/prnjob" or die "error opening /tmp/prnjob"; print DRIVERINPUT @examined_stuff; } if ($more_stuff) { while () { print $driverh $_; if ($debug != 0) { print DRIVERINPUT $_; } } } close $driverh or die "error closing $driverh"; if ($debug != 0) { close DRIVERINPUT or die "error closing /tmp/prnjob"; } # Wait for driver child waitpid($driverpid, 0); print $logh "Main process finished\n"; exit(0); ### End of non-doc processing... } else { print $logh "printing docs\n"; my $pid, $sleep_count=0; do { $pid = open(KID1, "|-"); unless (defined $pid) { warn "cannot fork: $!"; die "bailing out" if $sleep_count++ > 6; sleep 10; } } until defined $pid; if (! $pid) { # child/driver; exec enscript... my ($driverhandle, $driverpid) = getdriverhandle(); print $logh "setting STDOUT to be $driverhandle and spawning $enscriptcommand\n"; open (STDOUT, ">&$driverhandle") or die "Couldn't dup driverhandle"; system "$enscriptcommand" and die "Couldn't exec $enscriptcommand"; close STDOUT; close $driverhandle; # Wait for driver child waitpid($driverpid, 0); print $logh "KID1 finished\n"; exit(0); } # parent; write the job into KID1 aka $enscriptcommand select KID1; my ($make, $model, $driver) = ($dat->{'make'}, $dat->{'model'}, $dat->{'driver'}); my $optstr = ("Specify each option with a -o argument to lp/lpr ie\n", "% lpr -o duplex -o two=2 -o three=3\n"); print "Invokation summary for your $make $model printer as driven by the $driver driver. $optstr The following options are available for this printer: "; for $arg (@{$dat->{'args'}}) { my ($name, $required, $type, $comment, $spot, $default) = ($arg->{'name'}, $arg->{'required'}, $arg->{'type'}, $arg->{'comment'}, $arg->{'spot'}, $arg->{'default'}); my $reqstr = ($required ? " required" : "n optional"); print "Option `$name':\n A$reqstr $type argument.\n $comment\n"; print " This options corresponds to a PJL command.\n" if ($arg->{'style'} eq 'J'); if ($type eq 'bool') { if (defined($default)) { my $defstr = ($default ? "True" : "False"); print " Default: $defstr\n"; } print " Example: `$name'\n"; } elsif ($type eq 'enum') { print " Possible choices:\n"; my $exarg; for (@{$arg->{'vals'}}) { my ($choice, $comment) = ($_->{'value'}, $_->{'comment'}); print " o $choice: $comment\n"; $exarg=$choice; } if (defined($default)) { print " Default: $default\n"; } print " Example: $name=$exarg\n"; } elsif ($type eq 'int' or $type eq 'float') { my ($max, $min) = ($arg->{'max'}, $arg->{'min'}); my $exarg; if (defined($max)) { print " Range: $min <= x <= $max\n"; $exarg=$max; } if (defined($default)) { print " Default: $default\n"; $exarg=$default; } if (!$exarg) { $exarg=0; } print " Example: $name=$exarg\n"; } print "\n"; } select STDOUT; close KID1 or warn "error closign KID1/enscript for docs print"; } # Wait for enscript child waitpid($pid, 0); print $logh "Main process finished\n"; close $logh; exit(0); ## Everything below here *is* the same in lpdomatic and cupsomatic ## KEEP IT THAT WAY! # return glob ref to "| commandline | self(pjlstuffer) | $postpipe" # ugly, we use $commandline, $postpipe, @prepend, @pjlprepend, @pjlappend globals sub getdriverhandle { pipe KID3_IN, KID3; my $pid3 = fork(); if (!defined($pid3)) { print $logh "$0: cannot fork for kid3!\n"; die "can't for for kid3\n"; } if ($pid3) { # we are the parent; return a glob to the filehandle close KID3_IN; print KID3 @prepend; print $logh "$0: prepended:\n", @prepend; KID3->flush(); return ( *KID3, $pid3 ); } else { close KID3; pipe KID4_IN, KID4; my $pid2 = fork(); if (!defined($pid2)) { print $logh "$0: cannot fork for kid4!\n"; die "can't fork for kid4\n"; } if ($pid2) { # parent, child of primary task; we are |commandline| close KID4_IN; print $logh "gs PID pid2=$pid2\n"; print $logh "gs command: $commandline\n"; close STDIN or die "couldn't close STDIN in $pid2"; open (STDIN, "<&KID3_IN") or die "Couldn't dup KID3_IN"; open (STDOUT, ">&KID4") or die "Couldn't dup KID4"; if ($debug) { open (STDERR, ">&$logh") or die "Couldn't dup logh to stderr"; } # Massage commandline to execute foomatic-gswrapper my $havewrapper = 0; for (split(':', $ENV{'PATH'})) { if (-x "$_/foomatic-gswrapper") { $havewrapper=1; last; } } if ($havewrapper) { $commandline =~ s!^\s*gs !foomatic-gswrapper !; $commandline =~ s!(\|\s*)gs !\|foomatic-gswrapper !; } # Actually run the thing... system "$commandline" and die "Couldn't exec $commandline"; close STDOUT; close KID4; close STDIN; close KID3_IN; # Wait for output child waitpid($pid2, 0); print $logh "KID3 finished\n"; exit(0); } else { # child, trailing task on the pipe; we write pjl stuff close KID4; my $fileh = *STDOUT; if ($postpipe) { open PIPE,$postpipe or "die cannot open postpipe $postpipe"; $fileh = *PIPE; } # wrap the PJL around the job data... # wrap the PJL around the job data, if there are any # options specified... if ( @pjlprepend > 1 ) { print $fileh @pjlprepend; } while () { print $fileh $_; } if ( @pjlprepend > 1 ) { print $fileh @pjlappend; } close $fileh or die "error closing $fileh"; close KID4_IN; print $logh "tail process done writing data to $fileh\n"; print $logh "KID4 finished\n"; exit(0); } } } # Find an argument by name in a case-insensitive way sub argbyname { my $name = @_[0]; my $arg; for $arg (@{$dat->{'args'}}) { return $arg if (lc($name) eq lc($arg->{'name'})); } return undef; } sub valbyname { my ($arg,$name) = @_; my $val; for $val (@{$arg->{'vals'}}) { return $val if (lc($name) eq lc($val->{'value'})); } return undef; }