1#!@PERL@ 2eval 'exec @PERL@ -S $0 ${1+"$@"}' 3 if $running_under_some_shell; 4 # this emulates #! processing on NIH machines. 5 # (remove #! line above if indigestible) 6 7use Getopt::Std; 8my $debug = 0; # always... sigh... 9my(%opt, @pc, %options); 10 11# get command line options 12getopts( 'A:B:C:D:E:F:G:H:I:J:K:L:M:N:O:P:Q:R:T:S:U:V:W:X:Y:Z:' 13. 'a:b:cd:e:f:g:h:i:j:k:l:m:n:o:p:q:r:t:s:u:v:w:x:y:z:', \%opt ); 14while( @ARGV ){ $opt{acct} = pop @ARGV ; }; 15 16# split up the PRINTCAP_ENTRY environment variable value 17@pc = split /\n\s*:/s, ($ENV{PRINTCAP_ENTRY} || ""); 18shift @pc; # throw way first entry field, printer name 19# set the options 20foreach (@pc){ # set the options values 21 if( /^(.+)=(.*)/ ){ $options{$1} = $2; 22 } elsif ( /^(.+)@/ ){ $options{$1} = 0; 23 } else { $options{$_} = 1; } 24} 25 26if( $debug ){ # for those interested 27 $s=""; 28 foreach my $v (sort keys %ENV){ $s .= "$v='$ENV{$v}',"; } 29 print STDERR "ENV: '$s'\n"; 30 my $s = ""; 31 foreach my $v (sort keys %options ){ $s .= "$v='$options{$v}',"; } 32 print STDERR "Printcap: '$s'\n"; 33 #$s=""; 34 #foreach my $v (sort keys %opt){ $s .= "$v='$opt{$v}',"; } 35 #print STDERR "Args: '$s'\n"; 36} 37 38# read stdin 39my( $file, $Zopts, $Q ); 40$file = join "", <STDIN>; 41print STDERR "File '$file'\n" if $debug; 42$Zopts = ""; 43# first use command line Queue name 44$Q = $opt{Q}; 45($Q) = $file =~ /^Q(.*)$/m if not $Q; 46# if no queue name fall back to printer name 47$Q = $opt{P} if not $Q; 48($Q) = $file =~ /^P(.*)$/m if not $Q; 49$Q = "" if not $Q; 50 51($Zopts) = $file =~ /^Z(.*)$/m; 52$Zopts = "" if not $Zopts; 53 54print STDERR "Q '$Q', Zopts '$Zopts'\n" if $debug; 55 56# now we split up the name and use as parameters for Z options 57while( $Q =~ /_([^_]+)/g ){ 58 # you can simply append them: 59 $Zopts .= ",$1"; 60 # or you can test and then append translated format 61 # if( $1 eq "11" ){ $Zopts .= ",legal"; } 62 # elsif( $1 eq "15" ){ $Zopts .= ",ledger"; } 63 # 64 #if( $1 eq "landscape" 65 # or $1 eq "legal" 66 # or $1 eq "ledger" ){ 67 # $Zopts .= ",$1" 68 #} 69} 70print "Final '$Zopts'\n" if $debug; 71if( $Zopts ){ 72 # remove leading comma 73 $Zopts =~ s/^,//; 74 #replace or prefix Z options 75 $file = "Z$Zopts\n" . $file if( not ($file =~ s/^Z.*$/Z$Zopts/m)); 76} 77print $file; 78exit 0 79