package PHTDBPUB; require Exporter; @ISA = qw(Exporter); @EXPORT_OK = qw(&normalizename); # symbols to export by default my $ver = '1.0'; # constructor for PHTDBPUB sub new { return bless {}; } # A map from the database's internal one-letter types to English my %driver_types = ('F' => 'Filter', 'P' => 'Postscript', 'U' => 'Ghostscript Uniprint', 'G' => 'Ghostscript'); # getdat. Obtains a printer/driver data object from the web. This # data object is cached internally; other operations will operate on # it. # # You can call this again to throw out the last data object and start # working with a new one, if you care to write a multi-printer/driver # sort of program. # sub getdat { my ($this, $driver, $poid) = @_; if (defined($this->{'dat'})) { $this->{'dat'} = undef; } my $base = 'http://www.linuxprinting.org'; my $url = "$base/get_data.cgi?driver=$driver&printer=$poid"; my $page = $this->getpage($url); my $VAR1; eval ($page) || die "Error in datablob!"; $this->{'dat'} = $VAR1; return $VAR1; } sub getascii { my ($this) = @_; use Data::Dumper; local $Data::Dumper::Purity=1; local $Data::Dumper::Indent=1; return Dumper($this->{'dat'}); } # Returns a data structure of make/model listings. You get the name, # pnp info, notes, func, a proofread bit, a list of drivers, and a # record id number. sub getoverview { my ($this) = @_; if (defined($this->{'overview'})) { $this->{'overview'} = undef; } my $base = 'http://www.linuxprinting.org'; my $url = "$base/get_over.cgi"; my $page = $this->getpage($url); eval ($page) || die "Error in datablob!"; $this->{'overview'} = $VAR1; return $VAR1; } ################### # PDQ # # getpdqdata() returns a PDQ driver description file. # Change this whenever you change anything! my $pdqomaticversion = '2.05'; sub getpdqdata { my ($this) = @_; die "you must call getdat first" if (!$this->{'dat'}); my $dat = $this->{'dat'}; my $driver = $dat->{'driver'}; # Construct structure with driver information my @declaration=undef; # First, compute the various option/value clauses for $arg (@{$dat->{'args'}}) { if ($arg->{'type'} eq 'enum') { my $com = $arg->{'comment'}; my $idx = $arg->{'idx'}; my $def = $p->{'arg_default'}; my $nam = $arg->{'name'}; $arg->{'varname'} = "EOPT_$idx"; # No quotes, thank you. $com =~ s!\"!\\\"!g; push(@driveropts, " option {\n", " var = \"EOPT_$idx\"\n", " desc = \"$com\"\n"); # get enumeration values for each enum arg my ($ev, @vals, @valstmp); for $ev (@{$arg->{'vals'}}) { my $choicename = $ev->{'value'}; my $val = (defined($ev->{'driverval'}) ? $ev->{'driverval'} : $ev->{'value'}); my $com = $ev->{'comment'}; # stick another choice on driveropts push(@valstmp, " choice \"$choicename\" {\n", " desc = \"$com\"\n", " value = \"$val\"\n", " }\n"); } push(@driveropts, " default_choice \"" . $arg->{'default'} . "\"\n", @valstmp, " }\n\n"); } elsif ($arg->{'type'} eq 'int' or $arg->{'type'} eq 'float') { my $com = $arg->{'comment'}; my $idx = $arg->{'idx'}; my $nam = $arg->{'name'}; my $max = $arg->{'max'}; my $min = $arg->{'min'}; $arg->{'varname'} = "OPT_$nam"; my $legal = $arg->{'legal'} = "Minimum value: $min, Maximum value: $max"; my $defstr = ""; if ($arg->{'default'}) { $defstr = sprintf(" def_value \"%s\"\n", $arg->{'default'}); } push(@driveropts, " argument {\n", " var = \"OPT_$nam\"\n", " desc = \"$nam\"\n", $defstr, " help = \"$com $legal\"\n", " }\n\n"); } elsif ($arg->{'type'} eq 'bool') { my $com = $arg->{'comment'}; my $tname = $arg->{'name_true'}; my $fname = $arg->{'name_false'}; my $idx = $arg->{'idx'}; $arg->{'legal'} = "Value is a boolean flag"; $arg->{'varname'} = "BOPT_$idx"; my $defstr = ""; if ($arg->{'default'}) { $defstr = sprintf(" def_value \"%s\"\n", $arg->{'default'} ? "TRUE" : "FALSE"); } push(@driveropts, " option {\n", " var = \"BOPT_$idx\"\n", " desc = \"$com\"\n", $defstr, " choice \"$tname\" {\n", " desc = \"$tname\"\n", " value = \"TRUE\"\n", " }\n", " choice \"$fname\" {\n", " desc = \"$fname\"\n", " value = \"FALSE\"\n", " }\n", " }\n\n"); } } ## Now let's compute the postscript filter part my @drivfilter; push(@drivfilter, " language_driver postscript {\n", " # Various postscript tricks would go here\n", " }\n\n"); ## Add ASCII to drivfilter! ## FIXME # Options: we do ascii, so just crlf fix it push (@drivfilter, " language_driver text {\n"); if ($dat->{'ascii'}) { push(@drivfilter, "\n", " sed 's/\$/\r/' \$INPUT > \$OUTPUT\n", " touch \$OUTPUT.ok\n", " }\n"); } else { push(@drivfilter, " convert_exec {#!/bin/sh if [ \"\$PAPER_SIZE\" = \"legal\" ]; then PAGE_HEIGHT=\"14\" LINES_PER_PAGE=\"85\" elif [ \"\$PAPER_SIZE\" = \"A4\" ]; then PAGE_HEIGHT=\"11.7\" LINES_PER_PAGE=\"70\" else PAGE_HEIGHT=\"11\" LINES_PER_PAGE=\"66\" fi cat > \$OUTPUT <> \$OUTPUT cat >> \$OUTPUT <{'cmd'}; my @letters = qw/A B C D E F G H I J K L M Z/; for $spot (@letters) { if ($commandline =~ m!\%$spot!) { argument: for $arg (sort { $a->{'order'} <=> $b->{'order'} } @{$dat->{'args'}}) { # Only do arguments that go in this spot next argument if ($arg->{'spot'} ne $spot); my $varname = $arg->{'varname'}; my $cmd = $arg->{'proto'}; my $comment = $arg->{'comment'}; my $cmdvar = $arg->{'cmdvarname'} = "CMD_$varname"; my $type = $arg->{'type'}; my $gsarg = 1 if ($arg->{'style'} eq 'G'); if ($type eq 'bool') { # If BOPT_whatever is true, the cmd is present. # Otherwise this option is the empty string push(@psfilter, " # $comment\n", " if [ \"x\${$varname}\" = 'xTRUE' ]; then\n", " $cmdvar=\'$cmd\'\n", " fi\n\n"); } elsif ($type eq 'int' or $type eq 'float'){ # If [IF]OPT_whatever is non-null, put in the # argument. Otherwise this option is the empty # string. Error checking? my $fixedcmd = $cmd; if ($gsarg) { $fixedcmd =~ s!\"!\\\"!g; } else { $fixedcmd =~ s!([\\\"\$\;\,\!\&\<\>])!\\\\$1!g; } $fixedcmd = sprintf($fixedcmd, "\${$varname}"); push(@psfilter, " # $comment\n", " # We aren't really checking for max/min.\n", " if [ \"x\${$varname}\" != 'x' ]; then\n", " $cmdvar=\"$fixedcmd\"\n", " fi\n\n"); } elsif ($type eq 'enum') { # If EOPT_whatever is non-null, put in the # choice value. my $fixedcmd = $cmd; if ($gsarg) { $fixedcmd =~ s!\"!\\\"!g; } else { $fixedcmd =~ s!([\\\"\$\;\,\!\&\<\>])!\\\\$1!g; } $fixedcmd = sprintf($fixedcmd, "\${$varname}"); push(@psfilter, " # $comment\n", " # We aren't really checking for legal vals.\n", " if [ \"x\${$varname}\" != 'x' ]; then\n", " $cmdvar=\"$fixedcmd\"\n", " fi\n\n"); } else { die "evil type!?"; } if (! $gsarg) { # Insert the processed variable in the commandline # just before the spot marker. $commandline =~ s!\%$spot!\$$cmdvar\%$spot!; } else { # Ghostscript/Postscript argument, prepend to job push(@echoes, "echo \"\${$cmdvar}\""); } } # Remove the letter marker from the commandline $commandline =~ s!\%$spot!!; } } # Execute command # # Spit out the command with all the post-processed arguments # stuffed in where the %A %B etc were. Don't forget to deal # with the %Z normal gs option stuff. my $echostr = join (";\\\n ", @echoes); push(@psfilter, " if ! test -e \$INPUT.ok; then\n", " # Execute this puppy, already...\n", " ($echostr;\\\n", " cat \$INPUT ) \\\n", " | $commandline\\\n", " >> \$OUTPUT\n", " if ! test -e \$OUTPUT; then \n", " echo 'Error running Ghostscript; no output!'\n", " exit 1\n", " fi\n", " else\n", " ln -s \$INPUT \$OUTPUT\n", " fi\n\n"); # OK, so much for the postscript_filter part. # Now let's compute the filter_exec script, which processes # all jobs right before sending. Here is where we do PJL options. my @pjlfilter, @pjlfilter_bot; if ($dat->{'pjl'} == 1) { push(@pjlfilter, " echo -ne '\33%-12345X' > \$OUTPUT\n", " echo '\@PJL JOB NAME=\"PDQ Print Job\"' >> \$OUTPUT\n"); argument: for $arg (sort { $a->{'order'} <=> $b->{'order'} } @{$dat->{'args'}}) { # Only do PJL arguments next argument if ($arg->{'style'} ne 'J'); my $varname = $arg->{'varname'}; my $cmd = $arg->{'proto'}; my $comment = $arg->{'comment'}; my $cmdvar = $arg->{'cmdvarname'} = "CMD_$varname"; my $type = $arg->{'type'}; my $pjlcmd = sprintf($cmd, "\$$varname"); $pjlcmd =~ s!\"!\\\"!g; $pjlcmd =~ s!\\!\\\\!g; if ($type eq 'bool') { push(@pjlfilter, " # $comment\n", " if [ \"x\${$varname}\" != 'xNA' ]; then\n", " if [ \"x\${$varname}\" == 'TRUE' ]; then\n", " echo \"$pjlcmd\" >> \$OUTPUT\n", " fi\n", " fi\n\n"); } elsif ($type eq 'int' or $type eq 'float'){ push(@pjlfilter, " # $comment\n", " if [ \"x\${$varname}\" != 'xNA' ]; then\n", " echo \"$pjlcmd\" >> \$OUTPUT\n", " fi\n\n"); } elsif ($type eq 'enum') { # If EOPT_whatever is non-null, put in the # choice value. push(@pjlfilter, " # $comment\n", " if [ \"x\${$varname}\" != 'xNA' ]; then\n", " echo \"$pjlcmd\" >> \$OUTPUT\n", " fi\n\n"); } else { die "evil type!?"; } # Insert the processed variable in the commandline # just before the spot marker. $commandline =~ s!\%$spot!\$$cmdvar\%$spot!; } # Send the job, followed by the end of job command push(@pjlfilter_bot, " echo -ne '\33%-12345X' >> \$OUTPUT\n", " echo '\@PJL EOJ' >> \$OUTPUT\n\n"); } my $wwwhome = 'http://www.linuxprinting.org/show_driver.cgi'; my $showurl = "$wwwhome?driver=$driver"; my $notes = $dat->{'comment'}; my $pname = $dat->{'make'} . " " . $dat->{'model'}; push (@body, " # This PDQ driver was generated automatically by pdq-o-matic.cgi from\n", " # information in the Printing HOWTO's compatibility database. It uses\n", " # the $driver driver to drive a $pname. \n", " #\n", " # For more information on this driver please see the HOWTO's $driver\n", " # driver database entry at \n", " # $showurl\n\n", " help \"$notes\"\n\n", # ( $dat->{'type'} eq 'G' or $dat->{'type'} eq 'U' ? # " requires \"gs\"\n" : ""), " # We need the $driver driver, but I haven't implemented requires yet.\n\n", @driveropts, @drivfilter, " filter_exec {\n", @pjlfilter, @psfilter, @pjlfilter_bot, " }\n" ); my $version = $dat->{'timestamp'}; my ($smake, $smodel) = ($dat->{'make'}, $dat->{'model'}); $smake =~ s/ /\-/g; $smodel =~ s/ /\-/g; my $name = "POM-$driver-$smake-$smodel-$version"; $name =~ s! !\-!g; push (@declaration, "# THIS IS A BETA VERSION OF PDQ-O-MATIC! EXPECT NOTHING!\n\n", "# This is a PDQ driver declaration for the ", lc($driver_types{$dat->{'type'}}), " driver $driver.\n", "# It was generated by pdq-o-matic.cgi version $pdqomaticversion\n\n", "# You should append this file to your personal .printrc, the system\n", "# /etc/printrc, or place it by itself in the systemwide /etc/pdq/drivers\n", "# area. Then run PDQ's new printer setup wizard.\n\n", "driver \"$name\" {\n\n", @body, "}\n"); return @declaration; } ################# # LPD stuff # # getlpddata() returns a data file which you can give to lpdomatic # Set when you change. (Not used, but should be?) my $lpdomaticversion = '0.4'; sub getlpddata { my ($db) = @_; die "you need to call PHTDBPUB::getdat first!" if (!defined($db->{'dat'})); my $dat = $db->{'dat'}; # Encase data for inclusion in LOM file my @datablob; for(split('\n',$db->getascii())) { push(@datablob, "$_\n"); } ## OK, now we have a whole structure named $dat about the ## calling of this driver. my ($make, $model, $driver, $poid) = ($dat->{'make'}, $dat->{'model'}, $dat->{'driver'}, $dat->{'id'}); my @ppd; push(@ppd, "# This is an LPD-O-Matic printer definition file for the\n", "# $make $model printer using the $driver driver.\n", "#\n", "# It is designed to be used together with the lpdomatic backend\n", "# filter script. For more information, see:\n#\n", "# Documentation: http://www.linuxprinting.org/lpd-doc.html\n", "# Driver `$driver': http://www.linuxprinting.org/show_driver.cgi?driver=$driver\n", "# $make $model: http://www.linuxprinting.org/show_printer.cgi?recnum=$poid\n\n", "# \"\$postpipe\" is a command to pipe the printer data to somewhere on the\n", "# network. Uncomment/modify a line you like for network printing. For\n", "# local (parallel or serial) printing, this doesn't apply.\n", "#\n", "# Netware users might stick something here like:\n", "#\n", "# \$postpipe = '| nprint -U guest -S net -q foo1 -';\n", "#\n", "# Remote LPD printers should be done using rlpr. The if= isn't run\n", "# with any arguments locally, so you have to set up lpdomatic printing\n", "# to a local printer on /dev/null, and set this to *really* send the\n", "# job over the network.\n", "#\n", "# \$postpipe = '| rlpr -Premotequeue\@remotehost';\n", "#\n", "# Windows/SMB remote printers would use an smbprint command.\n", "#\n", "# Remote HP JetDirect network printers will usually work with either of:\n", "#\n", "# \$postpipe = '| nc ipaddress 9100';\n", "# \$postpipe = '| rlpr -Praw\@ipaddress';\n", "#\n", "# The important thing is to remember the leading | symbol.\n\n", @datablob ); return @ppd; } ##################### # CUPS stuff # ## Set this whenever you change the getcupsppd code!!!! my $cupsomaticversion = '0.4'; # Return a PPD for CUPS and the cupsomatic script. Built from the # standard data; you must call getdat() first. sub getcupsppd { my ($db) = @_; die "you need to call PHTDBPUB::getdat first!" if (!defined($db->{'dat'})); # Encase data for inclusion in PPD file my @datablob; for(split('\n',$db->getascii())) { push(@datablob, "*% COMDATA #$_\n"); } # Construct various selectors for PPD file my @optionblob; push(@optionblob, "*% For the moment, this system only handles options specified\n", "*% on the cups command line. The change to support in-job\n", "*% options as inserted by PPD-grokking tools is trivial; I\n", "*% just haven't gotten around to it. The idea is to have a\n", "*% structured comment like `%COMOPTION: Duplex:On' as the\n", "*% `Postscript' for the PPD driver to paste in.\n\n"); my $dat = $db->{'dat'}; for $arg (@{$dat->{'args'}}) { my $type = $arg->{'type'}; my $com = $arg->{'comment'}; my $default = $arg->{'default'}; my $idx = $arg->{'idx'}; if ($type eq 'enum') { # Skip zero or one choice arguments if (1 < scalar(@{$arg->{'vals'}})) { my $name = $arg->{'name'}; push(@optionblob, sprintf("\n*OpenUI *%s/%s: PickOne\n", $name, $com), sprintf("*Default%s: %s\n", $name, (defined($default) ? $default : 'Unknown'))); if (!defined($default)) { my $whr = sprintf("%s %s driver %s", $dat->{'make'}, $dat->{'model'}, $dat->{'driver'}); warn "undefined default for $idx/$name on a $whr"; } my $v; for $v (@{$arg->{'vals'}}) { my $psstr = ""; if ($arg->{'style'} eq 'G') { # Ghostscript argument; offer up ps for insertion $psstr = sprintf($arg->{'proto'}, (defined($v->{'driverval'}) ? $v->{'driverval'} : $v->{'value'})); } push(@optionblob, sprintf("*%s %s/%s: \"$psstr\"\n", $name, $v->{'value'}, $v->{'comment'})); } push(@optionblob, sprintf("*CloseUI: *%s\n", $name)); } } elsif ($type eq 'bool') { my $name = $arg->{'name'}; my $namef = $arg->{'name_false'}; my $defstr = ($default ? 'True' : 'False'); my $psstr = ""; if ($arg->{'style'} eq 'G') { # Ghostscript argument $psstr = $arg->{'proto'}; } if (!defined($default)) { $defstr = 'Unknown'; } push(@optionblob, sprintf("\n*OpenUI *%s/%s: Boolean\n", $name, $com), sprintf("*Default%s: $defstr\n", $name), sprintf("*%s True/%s: \"$psstr\"\n", $name, $name), sprintf("*%s False/%s: \"\"\n", $name, $namef), sprintf("*CloseUI: *%s\n", $name)); } elsif ($type eq 'int') { # max, min, and a few in between? } elsif ($type eq 'float') { # max, min, and a few in between? } } if (! $dat->{'args_byname'}{'PageSize'} ) { # This is a problem, since CUPS segfaults on PPD files # without a default PageSize set. push(@optionblob, <>setpagedevice" *PageSize Legal/Legal: "<>setpagedevice" *PageSize A4/A4: "<>setpagedevice" *CloseUI: *PageSize EOFPGSZ } if (defined($dat->{'pnp_mfg'})) { push(@others, "*pnpManufacturer: \"", $dat->{'pnp_mfg'}, "\"\n"); } if (defined($dat->{'pnp_mdl'})) { push(@others, "*pnpModel: \"", $dat->{'pnp_mdl'}, "\"\n"); } if (defined($dat->{'pnp_cmd'})) { push(@others, "*pnpCmd: \"", $dat->{'pnp_cmd'}, "\"\n"); } if (defined($dat->{'pnp_des'})) { push(@others, "*pnpDescr: \"", $dat->{'pnp_des'}, "\"\n"); } my $blob = join('',@datablob); my $opts = join('',@optionblob); my $otherstuff = join('',@others); $driver =~ m!(^(.{1,5}))!; my $shortname = uc($1); my $model = $dat->{'model'}; my $make = $dat->{'make'}; my $filename = join('-',($dat->{'make'}, $dat->{'model'}, $dat->{'driver'}));; $filename =~ s![ /]!_!g; my $longname = "$filename.ppd"; my $tmpl = get_tmpl(); $tmpl =~ s!\@\@MODEL\@\@!$model!g; $tmpl =~ s!\@\@MAKE\@\@!$make!g; $tmpl =~ s!\@\@SAVETHISAS\@\@!$longname!g; $tmpl =~ s!\@\@NUMBER\@\@!$shortname!g; $tmpl =~ s!\@\@OTHERSTUFF\@\@!$otherstuff!g; $tmpl =~ s!\@\@OPTIONS\@\@!$opts!g; $tmpl =~ s!\@\@COMDATABLOB\@\@!$blob!g; push (@ppd, $tmpl); return @ppd; } # Utility function; returns content of a URL sub getpage { my ($this, $url) = @_; use LWP::UserAgent; my $ua = LWP::UserAgent->new(); $ua->agent("PHTDBPUB/$ver ($0)"); $ua->timeout([30]); $ua->env_proxy(); # should call ->proxy() here if needed... my $request = $ua->request(new HTTP::Request('GET', $url)); die ("http error: " . $request->status_line) if $request->is_error(); my $page = $request->content; return $page; } # Get documentation for the printer/driver pair to print out. sub getexecdocs { my ($this) = $_[0]; my $dat = $this->{'dat'}; my @docs; # Construct the proper command line. my $commandline = $dat->{'cmd'}; my @letters = qw/A B C D E F G H I J K L M Z/; my $spot; for $spot (@letters) { if($commandline =~ m!\%$spot!) { my $arg; argument: for $arg (sort { $a->{'order'} <=> $b->{'order'} } @{$dat->{'args'}}) { # Only do arguments that go in this spot next argument if ($arg->{'spot'} ne $spot); my $name = $arg->{'name'}; my $varname = $arg->{'varname'}; my $cmd = $arg->{'proto'}; my $comment = $arg->{'comment'}; my $default = $arg->{'default'}; my $type = $arg->{'type'}; my $cmdvar = ""; my $gsarg = ""; $gsarg = ' -c ' if ($arg->{'style'} eq 'G'); my $leftbr = ($arg->{'required'} ? "" : "["); my $rightbr = ($arg->{'required'} ? "" : "]"); if ($type eq 'bool') { $cmdvar = "$leftbr$gsarg$cmd$rightbr"; } elsif ($type eq 'int' or $type eq 'float') { $cmdvar = sprintf("$leftbr$gsarg$cmd$rightbr",$default); } elsif ($type eq 'enum') { my $val; if ($val=valbyname($arg,$default)) { $cmdvar = sprintf("$leftbr$gsarg$cmd$rightbr", (defined($val->{'driverval'}) ? $val->{'driverval'} : $val->{'value'})); } } # Insert the processed argument in the commandline # just before the spot marker. $cmdvar =~ s!^\[\ !\ \[!; $commandline =~ s!\%$spot!$cmdvar\%$spot!; } # Remove the letter marker from the commandline $commandline =~ s!\%$spot!!; } } $dat->{'excommandline'} = $commandline; $commandline =~ s!&!&!g; $commandline =~ s/\{'order'} <=> $b->{'order'} } @{$dat->{'args'}}) { my $name = $arg->{'name'}; my $cmd = $arg->{'proto'}; $cmd =~ s!{'comment'}; my $default = $arg->{'default'}; my $type = $arg->{'type'}; my $required = ($arg->{'required'} ? " required" : "n optional"); if ($type eq 'bool') { my $name_false = $arg->{'name_false'}; push(@doctmp, dt($name), dd("A$required boolean argument meaning $name if present or $name_false if not.", br(), "$comment", br(), "Prototype:", tt($cmd), br(), "Default: ", $default ? "True" : "False", ), ); } elsif ($type eq 'int' or $type eq 'float') { my $max = (defined($arg->{'max'}) ? $arg->{'max'} : "none"); my $min = (defined($arg->{'min'}) ? $arg->{'min'} : "none"); push(@doctmp, dt($name), dd("A$required $type argument.", br(), "$comment", br(), "Prototype:", tt($cmd), br(), "Default: $default", br(), "Range: $min <= x <= $max"), ); } elsif ($type eq 'enum') { my ($val, $defstr); my (@choicelist) = (); for $val (@{$arg->{'vals'}}) { my ($value, $comment, $driverval) = ($val->{'value'}, $val->{'comment'}, $val->{'driverval'}); if (defined($driverval)) { push(@choicelist, li("$value: $comment (%s is `" . tt($driverval) . "')")); } else { push(@choicelist, li(tt($value) . ": $comment")); } } push(@doctmp, dt($name), dd("A$required enumerated choice argument.", br(), "$comment", br(), "Prototype:", tt($cmd), br(), "Default: $default", ul(@choicelist)) ); } } push(@docs, dl(@doctmp)); return @docs; } # Get a shorter summary documentation thing. This appears on the # driver pages, for example sub getdocs { my ($this) = $_[0]; my $dat = $this->{'dat'}; my @docs; 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"); push(@docs, "Option `$name':\n A$reqstr $type argument.\n $comment\n"); push(@docs, " This option corresponds to a PJL command.\n") if ($spot eq 'Y'); if ($type eq 'bool') { if (defined($default)) { my $defstr = ($default ? "True" : "False"); push(@docs, " Default: $defstr\n"); } push(@docs, " Example (true): `$name'\n"); push(@docs, " Example (false): `no$name'\n"); } elsif ($type eq 'enum') { push(@docs, " Possible choices:\n"); my $exarg; for (@{$arg->{'vals'}}) { my ($choice, $comment) = ($_->{'value'}, $_->{'comment'}); push(@docs, " * $choice: $comment\n"); $exarg=$choice; } if (defined($default)) { push(@docs, " Default: $default\n"); } push(@docs, " Example: `$name=$exarg'\n"); } elsif ($type eq 'int' or $type eq 'float') { my ($max, $min) = ($arg->{'max'}, $arg->{'min'}); my $exarg; if (defined($max)) { push(@docs, " Range: $min <= x <= $max\n"); $exarg=$max; } if (defined($default)) { push(@docs, " Default: $default\n"); $exarg=$default; } if (!$exarg) { $exarg=0; } push(@docs, " Example: `$name=$exarg'\n"); } push(@docs, "\n"); } return @docs; } # Find a choice value hash by name. sub valbyname { my ($arg,$name) = @_; my $val; for $val (@{$arg->{'vals'}}) { return $val if (lc($name) eq lc($val->{'value'})); } return undef; } # replace numbers with fixed 6-digit number for ease of sorting # ie: sort { normalizename($a) cmp normalizename($b) } @foo; sub normalizename { my $n = @_[0]; if ($n =~ m!(\d+)!) { my $num = sprintf("%06d", $1); $n =~ s!(\d+)!$num!; } return $n; } # PPD boilerplate template sub get_tmpl { return <