"Fossies" - the Fresh Open Source Software Archive

Member "foomatic-db-engine-4.0-20221101/foomatic-ppd-options.in" (1 Nov 2022, 3993 Bytes) of package /linux/misc/foomatic-db-engine-4.0-20221101.tar.gz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

    1 #!@PERL@ -w
    2 use strict;
    3 
    4 # This is foomatic-ppd-options, a program which will print out the
    5 # options specified by a PPD file.
    6 #
    7 # foomatic-ppd-options [file*]
    8 #  reads one or more PPD files from the specified file or
    9 #  standard input.  If present, PPD information is separated by
   10 #  lines starting with Printer: .  This makes it compatible with
   11 #  the LPRng 'lpc ppd' command:
   12 #    lpc ppd | foomatic-ppd-options
   13 
   14 use Foomatic::Defaults;
   15 use Foomatic::DB;
   16 use Data::Dumper;
   17 use FileHandle;
   18 
   19 $0 =~ m!/([^/]+)\s*$!;
   20 my $progname = ($1 || $0);
   21 
   22 sub help {
   23     print STDERR <<EOF;
   24 $progname [-d=debuglevel][files]
   25   reads one or more PPD files from the specified file or
   26   standard input.  If present, PPD information is separated by
   27   lines starting with Printer: .  This makes it compatible with
   28   the LPRng 'lpc ppd' command:
   29     lpc ppd | foomatic-ppd-options
   30   
   31  -h            - printes help message
   32  -d debuglevel - sets debugging level (0 is 0ff)
   33 EOF
   34     exit 1;
   35 }
   36 # Read out the program name with which we were called, but discard the path
   37 
   38 my $debug = 0;
   39 
   40 # We use the library Getopt::Long here, so that we can have more than
   41 # one "-o" option on one command line.
   42 
   43 my( $opt_h, $opt_d );
   44 
   45 use Getopt::Long;
   46 Getopt::Long::Configure("no_ignore_case");
   47 GetOptions(
   48 	   "d=i"   => \$opt_d,         # Help!
   49 	   "h"   => \$opt_h,         # Help!
   50 	   "help"=> \$opt_h) || help();
   51 
   52 help() if $opt_h;
   53 $debug = $opt_d if $opt_d;
   54 
   55 sub getppdinfo( $ $ );
   56 if( @ARGV ){
   57 	while( @ARGV ){
   58 		my $file = shift @ARGV;
   59 		print STDERR "file $file\n" if $debug;
   60 		my $fd = new FileHandle "<$file";
   61 		if( not $fd ){
   62 			die( "$progname: cannot open '$file' - $!\n" );
   63 			next;
   64 		}
   65 		getppdinfo($fd, $file);
   66 		close($fd);
   67 	}
   68 } else {
   69 	getppdinfo( \*STDIN, "STDIN" );
   70 }
   71 
   72 exit 0;
   73 
   74 my $key;
   75 sub order_by_key{$a->{$key} cmp $b->{$key}};
   76 
   77 sub getppdinfo( $ $ ){
   78 	my( $fd, $name ) = @_;
   79 	my @ppd = <$fd>;
   80 	close( $fd );
   81 	print "PPD $name= " . Dumper(\@ppd) if $debug > 1;
   82 	my ($printer);
   83 	$printer = shift @ppd if $ppd[0] =~ /^Printer:/;
   84 	print "$printer\n" if $printer;
   85 	my $ppd = ppdfromvartoperl( \@ppd );
   86 	if( not defined $ppd ){
   87 		die "$progname: bad ppdfile $name\n";
   88 	}
   89 	print STDERR "PPD DB " . Dumper( $ppd ) if $debug;
   90 	my $makemodel = ($ppd->{'makemodel'} or "");
   91 	print "makemodel = $makemodel\n";
   92 	my $args = $ppd->{'args'};
   93 	print STDERR "PPD ARGS " . Dumper( $args ) if $debug;
   94 	for my $argname ( @{$args} ) {
   95 		my $name = $argname->{'name'};
   96 		my $language = "postscript";
   97 		if( $name =~ /^JCL(.*)$/ ){
   98 			$argname->{'name'} = $1;
   99 			$language = "pjl";
  100 		}
  101 		$argname->{'language'} = $language;
  102 	}
  103 	$key = 'name';
  104 	for my $argname ( sort order_by_key @{$args} ) {
  105 		my $name = $argname->{'name'};
  106 		my $comment = ($argname->{'comment'} or "");
  107 		my $type = ($argname->{'type'} or "");
  108 		my $vals = ($argname->{'vals'} or []);
  109 		my $default = ($argname->{'default'} or "");
  110 		my $language = ($argname->{'language'} or "postscript");
  111 		print STDERR "PPD ARG " . $name . "\n" if $debug;
  112 		print STDERR "PPD VALUES " . Dumper( $vals ) . "\n" if $debug;
  113 		my $values = "name=$name";
  114 		$values .= "($comment)" if( $comment );
  115 		$values .= ";";
  116 		$values .= " language=$language;";
  117 		$values .= " type=$type;" if( $type );
  118 		$values .= " default=$default;" if( $default );
  119 		$values .= " options=";
  120 		if( not @{$vals} ){
  121 			if( $type eq "bool" ){
  122 				$values .= "True (True), False (False)";
  123 			}
  124 		} else {
  125 			$key = 'value';
  126 			for my $v ( sort order_by_key @{$vals} ){
  127 				my $value = $v->{'value'};
  128 				my $comment = ($v->{'comment'} or "");
  129 				my $driverval = ($v->{'driverval'} or "");
  130 				$driverval =~ s/[\s\n]+/ /gm;
  131 				$driverval =~ s/^ //gm;
  132 				$driverval =~ s/ $//gm;
  133 				$driverval =~ s/[\W]/\\$&/gm;
  134 				$driverval =~ s/\\ / /gm;
  135 				$comment =~ s/[\W]/\\$&/g;
  136 				$comment =~ s/\\ / /gm;
  137 				$values .= "$value";
  138 				$values .= " ($comment)" if( $comment );
  139 				$values .= " [$driverval]" if( $driverval );
  140 				$values .= ", ";
  141 			}
  142 			$values =~ s/, $/;/;
  143 		}
  144 		print $values . "\n";
  145 	}
  146 }