package Foomatic::DB;
use Exporter;
use Encode;
@ISA = qw(Exporter);
@EXPORT_OK = qw(normalizename comment_filter
get_overview
getexecdocs
translate_printer_id
);
@EXPORT = qw(ppdtoperl ppdfromvartoperl);
use Foomatic::Defaults qw(:DEFAULT $DEBUG);
use Data::Dumper;
use POSIX; # for rounding integers
use strict;
my $ver = '$Revision$ ';
# constructor for Foomatic::DB
sub new {
my $type = shift(@_);
my $this = bless {@_}, $type;
$this->{'language'} = "C";
return $this;
}
# A map from the database's internal one-letter driver types to English
my %driver_types = ('F' => 'Filter',
'P' => 'Postscript',
'U' => 'Ghostscript Uniprint',
'G' => 'Ghostscript');
# Translate old numerical PostGreSQL printer IDs to the new clear text ones.
sub translate_printer_id {
my ($oldid) = @_;
# Read translation table for the printer IDs
my $translation_table = "$libdir/db/oldprinterids";
open TRTAB, "< $translation_table" or return $oldid;
while () {
chomp;
my $searcholdid = quotemeta($oldid);
if (/^\s*$searcholdid\s+(\S+)\s*$/) {
# ID found, return new ID
my $newid = $1;
close TRTAB;
return $newid;
}
}
# ID not found, return original one
close TRTAB;
return $oldid;
}
# Set language for localized answers
sub set_language {
my ($this, $language) = @_;
$this->{'language'} = $language;
}
# List of driver names
sub get_driverlist {
my ($this) = @_;
return $this->_get_xml_filelist('source/driver');
}
# List of printer id's
sub get_printerlist {
my ($this) = @_;
return $this->_get_xml_filelist('source/printer');
}
sub get_overview {
my ($this, $rebuild, $cupsppds) = @_;
# In-memory cache only for this process
return $this->{'overview'} if defined($this->{'overview'}) &&
!$rebuild;
$this->{'overview'} = undef;
# Read on-disk cache file if we have one
if (defined($this->{'overviewfile'})) {
if (!$rebuild && (-r $this->{'overviewfile'})) {
if (open CFILE, "< $this->{'overviewfile'}") {
my $output = join('', );
close CFILE;
# Only output the cashed page if it was really
# completely written Before introduction of this
# measure pages would not display due to an incomplete
# cache file until the next page rebuild (or until
# manually nuking the cache).
if ($output =~ m!\]\;\s*$!s) {
my $VAR1;
if (eval $output) {
$this->{'overview'} = $VAR1;
return $this->{'overview'};
}
}
}
}
}
# Build a new overview
my $otype = ($cupsppds ? '-C' : '-O');
$otype .= ' -n' if ($cupsppds == 1);
# Generate overview Perl data structure from database
my $VAR1;
eval `$bindir/foomatic-combo-xml $otype -l '$libdir' | $bindir/foomatic-perl-data -O -l $this->{'language'}` ||
die ("Could not run \"foomatic-combo-xml\"/\"foomatic-perl-data\"!");
$this->{'overview'} = $VAR1;
# Write on-disk cache file if we have one
if (defined($this->{'overviewfile'})) {
if (open CFILE, "> $this->{'overviewfile'}") {
print CFILE Dumper($this->{'overview'});
close CFILE;
}
}
return $this->{'overview'};
}
sub get_overview_xml {
my ($this, $compile) = @_;
open( FCX, "$bindir/foomatic-combo-xml -O -l '$libdir'|")
or die "Can't execute $bindir/foomatic-combo-xml -O -l '$libdir'";
$_ = join('', );
close FCX;
return $_;
}
sub get_combo_data_xml {
my ($this, $drv, $poid, $withoptions) = @_;
# Insert the default option settings if there are some and the user
# desires it.
my $options = "";
if (($withoptions) && (defined($this->{'dat'}))) {
my $dat = $this->{'dat'};
for my $arg (@{$dat->{'args'}}) {
my $name = $arg->{'name'};
my $default = $arg->{'default'};
if (($name) && ($default)) {
$options .= " -o '$name'='$default'";
}
}
}
open( FCX, "$bindir/foomatic-combo-xml -d '$drv' -p '$poid'$options -l '$libdir'|")
or die "Can't execute $bindir/foomatic-combo-xml -d '$drv' -p '$poid'$options -l '$libdir'";
$_ = join('', );
close FCX;
return $_;
}
sub get_printer {
my ($this, $poid) = @_;
# Generate printer Perl data structure from database
my $VAR1;
if (-r "$libdir/db/source/printer/$poid.xml") {
eval (`$bindir/foomatic-perl-data -P -l $this->{'language'} '$libdir/db/source/printer/$poid.xml'`) ||
die ("Could not run \"foomatic-perl-data\"!");
} else {
my ($make, $model);
if ($poid =~ /^([^\-]+)\-(.*)$/) {
$make = $1;
$model = $2;
$make =~ s/_/ /g;
$model =~ s/_/ /g;
} else {
$make = $poid;
$make =~ s/_/ /g;
$model = "Unknown model";
}
$VAR1 = {
'id' => $poid,
'make' => $make,
'model' => $model,
'noxmlentry' => 1
}
}
return $VAR1;
}
sub printer_exists {
my ($this, $poid) = @_;
# Check whether a printer XML file exists in the database
return 1 if (-r "$libdir/db/source/printer/$poid.xml");
return undef;
}
sub get_printer_xml {
my ($this, $poid) = @_;
return $this->_get_object_xml("source/printer/$poid", 1);
}
sub get_driver {
my ($this, $drv) = @_;
# Generate driver Perl data structure from database
my $VAR1;
if (-r "$libdir/db/source/driver/$drv.xml") {
eval (`$bindir/foomatic-perl-data -D -l $this->{'language'} '$libdir/db/source/driver/$drv.xml'`) ||
die ("Could not run \"foomatic-perl-data\"!");
} else {
return undef;
}
return $VAR1;
}
sub get_driver_xml {
my ($this, $drv) = @_;
return $this->_get_object_xml("source/driver/$drv", 1);
}
# Utility query function sorts of things:
sub get_printers_for_driver {
my ($this, $drv) = @_;
my @printerlist = ();
#my $driver = $this->get_driver($drv);
#if (defined($driver)) {
#@printerlist = map { $_->{'id'} } @{$driver->{'printers'}};
#}
$this->get_overview();
for my $p (@{$this->{'overview'}}) {
if (member($drv, @{$p->{'drivers'}})) {
push(@printerlist, $p->{'id'});
}
}
return @printerlist;
}
# Routine lookup; just examine the overview
sub get_drivers_for_printer {
my ($this, $printer) = @_;
my @drivers = ();
my $over = $this->get_overview();
my $p;
for $p (@{$over}) {
if ($p->{'id'} eq $printer) {
return @{$p->{'drivers'}};
}
}
return undef;
}
# Clean some manufacturer's names (for printer search function, taken
# from printerdrake, former printer setup tool of Mandriva Linux)
sub clean_manufacturer_name {
my ($make) = @_;
#$make =~ s/^Canon\W.*$/Canon/i;
#$make =~ s/^Lexmark.*$/Lexmark/i;
$make =~ s/^Hewlett?[_\s\-]*Packard/HP/i;
$make =~ s/^Seiko[_\s\-]*Epson/Epson/i;
$make =~ s/^Kyocera[_\s\-]*Mita/Kyocera/i;
$make =~ s/^CItoh/C.Itoh/i;
$make =~ s/^Oki(|[_\s\-]*Data)$/Oki/i;
$make =~ s/^(SilentWriter2?|ColorMate)/NEC/i;
$make =~ s/^(XPrint|Majestix)/Xerox/i;
$make =~ s/^QMS-PS/QMS/i;
$make =~ s/^konica([_\s\-]|)minolta/KONICA MINOLTA/i;
$make =~ s/^(Personal|LaserWriter)/Apple/i;
$make =~ s/^Digital/DEC/i;
$make =~ s/\s+Inc\.//i;
$make =~ s/\s+Corp\.//i;
$make =~ s/\s+SA\.//i;
$make =~ s/\s+S\.\s*A\.//i;
$make =~ s/\s+Ltd\.//i;
$make =~ s/\s+International//i;
$make =~ s/\s+Int\.//i;
return $make;
}
# Clean some model names (taken from system-config-printer, printer setup
# tool of Fedora/Red Hat, Ubuntu, and Mandriva
sub clean_model_name {
my ($model) = @_;
$model =~ s/^Mita[_\s\-]+//i;
$model =~ s/^AL-(([CM][A-Z]?|)\d+)/AcuLaser $1PS/;
$model =~ s/\s*\(recommended\)//i;
$model =~ s/\s*-\s*PostScript\b//i;
$model =~ s/\s*-\s*BR-Script[123]?\b//i;
$model =~ s/\s*\bseries\b//i;
$model =~ s/\s*\bPS[123]?\b//i;
$model =~ s/\s*PS[123]?$//;
$model =~ s/\s*\bPXL//i;
$model =~ s/[\s_-]+BT\b//i;
$model =~ s/\s*\(Bluetooth\)//i;
$model =~ s/\s*-\s*(RC|Ver(|sion))\s*-*\s*[0-9\.]+//i;
$model =~ s/\s*-\s*(RC|Ver(|sion))\b//i;
$model =~ s/\s*PostScript\s*$//i;
$model =~ s/\s*BR-Script[123]?\s*$//i;
$model =~ s/\s*\(\s*\)//i;
$model =~ s/\s*[\-\/]\s*$//i;
return $model;
}
# Guess manufacturer by description with only model name (for printer
# search function, taken from printerdrake, printer setup tool of
# Mandriva Linux)
sub guessmake {
my ($description) = @_;
my $manufacturer;
my $model;
if ($description =~
/^\s*(DeskJet|LaserJet|OfficeJet|PSC|PhotoSmart)\b/i) {
# HP printer
$manufacturer = "HP";
$model = $description;
} elsif ($description =~
/^\s*(Stylus|EPL|AcuLaser)\b/i) {
# Epson printer
$manufacturer = "Epson";
$model = $description;
} elsif ($description =~
/^\s*(Aficio)\b/i) {
# Ricoh printer
$manufacturer = "Ricoh";
$model = $description;
} elsif ($description =~
/^\s*(Optra|Color\s+JetPrinter)\b/i) {
# Lexmark printer
$manufacturer = "Lexmark";
$model = $description;
} elsif ($description =~
/^\s*(imageRunner|Pixma|Pixus|BJC|LBP)\b/i) {
# Canon printer
$manufacturer = "Canon";
$model = $description;
} elsif ($description =~
/^\s*(Phaser|DocuPrint|(Work|Document)\s*(Home|)Centre)\b/i) {
# Xerox printer
$manufacturer = "Xerox";
$model = $description;
} elsif (($description =~ /^\s*(KONICA\s*MINOLTA)\s+(\S.*)$/i) ||
($description =~ /^\s*(\S*)\s+(\S.*)$/)) {
$manufacturer = $1 if $manufacturer eq "";
$model = $2 if $model eq "";
}
return ($manufacturer, $model);
}
# Normalize a string, so that for a search only letters
# (case-insensitive), numbers and boundaries between letter blocks and
# number blocks are considered. The pipe '|' as separator between make
# and model is also considered. Blocks of other characters are
# replaced by a single space and boundaries between letters and
# numbers are marked with a single space.
sub normalize {
my ($str) = @_;
$str = lc($str);
$str =~ s/\+/plus/g;
$str =~ s/[^a-z0-9\|]+/ /g;
$str =~ s/(?<=[a-z])(?=[0-9])/ /g;
$str =~ s/(?<=[0-9])(?=[a-z])/ /g;
$str =~ s/ //g;
return $str;
}
# Find a printer in the database based on an auto-detected device ID
# or a user-typed search term
sub find_printer {
my ($this, $searchterm, $mode, $output) = @_;
# $mode = 0: Everything (default)
# $mode = 1: No matches on only the manufacturer
# $mode = 2: No matches on only the manufacturer or only the model
# $mode = 3: Exact matches of device ID, make/model, or Foomatic ID
# plus matches of the page description language
# $mode = 4: Exact matches of device ID, make/model, or Foomatic ID
# only
# $output = 0: Everything
# $output = 1: Only best match class (default)
# $output = 2: Only best match
# Correct options
$mode = 0 if !defined $mode;
$mode = 0 if $mode < 0;
$mode = 4 if $mode > 4;
$output = 1 if !defined $output;
$output = 0 if $output < 0;
$output = 2 if $output > 2;
my $over = $this->get_overview();
my %results;
# Parse the search term
my ($automake, $automodel, $autodescr, $autocmdset, $autosku);
my $deviceid = 0;
# Do we have a device ID?
if ($searchterm =~ /(MFG|MANUFACTURER):\s*([^:;]+);?/i) {
$automake = $2;
$deviceid = 1;
}
if ($searchterm =~ /(MDL|MODEL):\s*([^:;]+);?/i) {
$automodel = $2;
$automodel =~ s/\s+$//;
$deviceid = 1;
}
if ($searchterm =~ /(DES|DESCRIPTION):\s*([^:;]+);?/i) {
$autodescr = $2;
$autodescr =~ s/\s+$//;
$deviceid = 1;
}
if ($searchterm =~ /(CMD|COMMANDS?\s?SET):\s*([^:;]+);?/i) {
$autocmdset = $2;
$deviceid = 1;
}
if ($searchterm =~ /(SKU):\s*([^:;]+);?/i) {
$autosku = $2;
$autosku =~ s/\s+$//;
$deviceid = 1;
}
# Search term is not a device ID
if (!$deviceid) {
if ($searchterm =~ /^([^\|]+)\|([^\|]+|)(\|.*?|)$/) {
$automake = $1;
$automodel = $2;
} else {
$autodescr = $searchterm;
}
}
# This is the algorithm used in printerdrake (printer setup tool
# of Mandriva Linux) to match results of the printer auto-detection
# with the printer database
# Clean some manufacturer's names
my $descrmake = clean_manufacturer_name($automake);
# Generate data to match human-readable make/model names
# of Foomatic database
my $descr;
if ($automake && $autosku) {
$descr = "$descrmake|$autosku";
} elsif ($automake && $automodel) {
$descr = "$descrmake|$automodel";
} elsif ($autodescr && (length($autodescr) > 5)) {
my ($mf, $md) =
guessmake($autodescr);
$descrmake = clean_manufacturer_name($mf);
$descr = "$descrmake|$md";
} elsif ($automodel) {
my ($mf, $md) =
guessmake($automodel);
$descrmake = clean_manufacturer_name($mf);
$descr = "$descrmake|$md";
} elsif ($automake) {
$descr = "$descrmake|";
}
# Remove manufacturer's name from the beginning of the
# description (do not do this with manufacturer names which
# contain odd characters)
$descr =~ s/^$descrmake\|\s*$descrmake\s*/$descrmake|/i
if $descrmake &&
$descrmake !~ m![\\/\(\)\[\]\|\.\$\@\%\*\?]!;
# Clean up the description from noise which makes the best match
# difficult
$descr =~ s/\s+[Ss]eries//i;
$descr =~ s/\s+\(?[Pp]rinter\)?$//i;
# Try to find an exact match, check both whether the detected
# make|model is in the make|model of the database entry and vice versa
# If there is more than one matching database entry, the longest match
# counts.
my $matchlength = -1000;
my $bestmatchlength = -1000;
my $p;
DBENTRY: for $p (@{$over}) {
# Try to match the device ID string of the auto-detection
if ($p->{make} =~ /Generic/i) {
# Database entry for generic printer, check printer
# languages (command set)
if ($p->{model} =~ m!PCL\s*5/5e!i) {
# Generic PCL 5/5e Printer
if ($autocmdset =~
/(^|[:,])PCL\s*\-*\s*(5|)($|[,;])/i) {
$matchlength = 70;
$bestmatchlength = $matchlength if
$bestmatchlength < $matchlength;
$results{$p->{id}} = $matchlength if
(!defined($results{$p->{id}}) ||
($results{$p->{id}} < $matchlength));
next;
}
} elsif ($p->{model} =~ m!PCL\s*(6|XL)!i) {
# Generic PCL 6/XL Printer
if ($autocmdset =~
/(^|[:,])PCL\s*\-*\s*(6|XL)($|[,;])/i) {
$matchlength = 80;
$bestmatchlength = $matchlength if
$bestmatchlength < $matchlength;
$results{$p->{id}} = $matchlength if
(!defined($results{$p->{id}}) ||
($results{$p->{id}} < $matchlength));
next;
}
} elsif ($p->{model} =~ m!(PostScript)!i) {
# Generic PostScript Printer
if ($autocmdset =~
/(^|[:,\s])(PS|POSTSCRIPT)[^:;,]*($|[,;])/i) {
$matchlength = 90;
$bestmatchlength = $matchlength if
$bestmatchlength < $matchlength;
$results{$p->{id}} = $matchlength if
(!defined($results{$p->{id}}) ||
($results{$p->{id}} < $matchlength));
next;
}
}
} else {
# "Real" manufacturer, check manufacturer, model, and/or
# description
my $matched = 1;
my ($mfg, $mdl, $des, $sku);
my $ieee1284 = deviceIDfromDBEntry($p);
if ($ieee1284 =~ /(MFG|MANUFACTURER):\s*([^:;]+);?/i) {
$mfg = $2;
}
if ($ieee1284 =~ /(MDL|MODEL):\s*([^:;]+);?/i) {
$mdl = $2;
$mdl =~ s/\s+$//;
}
if ($ieee1284 =~ /(DES|DESCRIPTION):\s*([^:;]+);?/i) {
$des = $2;
$des =~ s/\s+$//;
}
if ($ieee1284 =~ /(SKU):\s*([^:;]+);?/i) {
$sku = $2;
$sku =~ s/\s+$//;
}
if ($mfg) {
if ($mfg ne $automake) {
$matched = 0;
}
}
if ($mdl) {
if ($mdl ne $automodel) {
$matched = 0;
}
}
if ($des) {
if ($des ne $autodescr) {
$matched = 0;
}
}
if ($sku && $autosku) {
if ($sku ne $autosku) {
$matched = 0;
}
}
if ($matched &&
($des || ($mfg && ($mdl || ($sku && $autosku))))) {
# Full match to known auto-detection data
$matchlength = 1000;
$bestmatchlength = $matchlength if
$bestmatchlength < $matchlength;
$results{$p->{id}} = $matchlength if
(!defined($results{$p->{id}}) ||
($results{$p->{id}} < $matchlength));
next;
}
}
# Try to match the (human-readable) make and model of the
# Foomatic database or of the PPD file
my $dbmakemodel = "$p->{make}|$p->{model}";
# At first try to match make and model, then only model and
# after that only make
my $searchtasks = [[$descr, $dbmakemodel, 0],
[$searchterm, $p->{model}, -200],
[clean_manufacturer_name($searchterm),
$p->{make}, -300],
[$searchterm, $p->{id}, 0]];
foreach my $task (@{$searchtasks}) {
# Do not try to match search terms or database entries without
# real content
next unless $task->[0] =~ /[a-z]/i;
next unless $task->[1] =~ /[a-z]/i;
# If make and model match exactly, we have found the correct
# entry and we can stop searching human-readable makes and
# models
if (normalize($task->[1]) eq normalize($task->[0])) {
$matchlength = 100;
$bestmatchlength = $matchlength + $task->[2] if
$bestmatchlength < $matchlength + $task->[2];
$results{$p->{id}} = $matchlength + $task->[2] if
(!defined($results{$p->{id}}) ||
($results{$p->{id}} < $matchlength));
next DBENTRY;
}
# Matching a part of the human-readable makes and models
# should only be done if the search term is not the name of
# an old model, otherwise the newest, not yet listed models
# match with the oldest model of the manufacturer (as the
# Epson Stylus Photo 900 with the original Epson Stylus Photo)
my @badsearchterms =
("HP|DeskJet",
"HP|LaserJet",
"HP|DesignJet",
"HP|OfficeJet",
"HP|PhotoSmart",
"EPSON|Stylus",
"EPSON|Stylus Color",
"EPSON|Stylus Photo",
"EPSON|Stylus Pro",
"XEROX|WorkCentre",
"XEROX|DocuPrint");
if (!member($task->[0], @badsearchterms)) {
my $searcht = normalize($task->[0]);
my $lsearcht = length($searcht);
$searcht =~ s!([\\/\(\)\[\]\|\.\$\@\%\*\?])!\\$1!g;
$searcht =~ s!(\\\|)!$1.*!g;
my $s = normalize($task->[1]);
if ((1 || $lsearcht >= $matchlength) &&
$s =~ m!$searcht!i) {
$matchlength = $lsearcht;
$bestmatchlength = $matchlength + $task->[2] if
$bestmatchlength < $matchlength + $task->[2];
$results{$p->{id}} = $matchlength + $task->[2] if
(!defined($results{$p->{id}}) ||
($results{$p->{id}} < $matchlength));
}
}
if (!member($task->[1], @badsearchterms)) {
my $searcht = normalize($task->[1]);
my $lsearcht = length($searcht);
$searcht =~ s!([\\/\(\)\[\]\|\.\$\@\%\*\?])!\\$1!g;
$searcht =~ s!(\\\|)!$1.*!g;
my $s = normalize($task->[0]);
if ((1 || $lsearcht >= $matchlength) &&
$s =~ m!$searcht!i) {
$matchlength = $lsearcht;
$bestmatchlength = $matchlength + $task->[2] if
$bestmatchlength < $matchlength + $task->[2];
$results{$p->{id}} = $matchlength + $task->[2] if
(!defined($results{$p->{id}}) ||
($results{$p->{id}} < $matchlength));
}
}
}
}
return grep {
((($mode == 4) && ($results{$_} >= 100)) ||
(($mode == 3) && ($results{$_} > 60)) ||
(($mode == 2) && ($results{$_} > -100)) ||
(($mode == 1) && ($results{$_} > -200)) ||
($mode == 0)) &&
(($output == 0) ||
(($output == 1) &&
!((($bestmatchlength >= 100) && ($results{$_} < 100)) ||
(($bestmatchlength >= 60) && ($results{$_} < 60)) ||
(($bestmatchlength >= 0) && ($results{$_} < 0)) ||
(($bestmatchlength >= -100) && ($results{$_} < -100)) ||
(($bestmatchlength >= -200) && ($results{$_} < -200)) ||
(($bestmatchlength >= -300) && ($results{$_} < -300)) ||
(($bestmatchlength >= -400) && ($results{$_} < -400)))) ||
(($output == 2) &&
($results{$_} == $bestmatchlength)))
} sort { $results{$b} <=> $results{$a} } keys(%results);
}
# This function sorts the options at first by their group membership and
# then by their names appearing in the list of functional areas. This way
# it will be made easier to build the PPD file with option groups and in
# user interfaces options will appear sorted by their functionality.
sub sortargs {
# All sorting done case-insensitive and characters which are not a
# letter or number are taken out!!
# List of typical option names to appear at first
# The terms must fit to the beginning of the line, terms which must fit
# exactly must have '\$' in the end.
my @standardopts = (
# The most important composite option
"printoutmode",
# Options which appear in the "General" group in
# CUPS and similar media handling options
"pagesize",
"papersize",
"mediasize",
"inputslot",
"papersource",
"mediasource",
"sheetfeeder",
"mediafeed",
"paperfeed",
"manualfeed",
"manual",
"outputtray",
"outputslot",
"outtray",
"faceup",
"facedown",
"mediatype",
"papertype",
"mediaweight",
"paperweight",
"duplex",
"sides",
"binding",
"tumble",
"notumble",
"media",
"paper",
# Other hardware options
"inktype",
"ink",
# Page choice/ordering options
"pageset",
"pagerange",
"pages",
"nup",
"numberup",
# Printout quality, colour/bw
"resolution",
"gsresolution",
"hwresolution",
"jclresolution",
"fastres",
"jclfastres",
"quality",
"printquality",
"printingquality",
"printoutquality",
"bitsperpixel",
"econo",
"jclecono",
"tonersav",
"photomode",
"photo",
"colormode",
"colourmode",
"color",
"colour",
"grayscale",
"gray",
"monochrome",
"mono",
"blackonly",
"colormodel",
"colourmodel",
"processcolormodel",
"processcolourmodel",
"printcolors",
"printcolours",
"outputtype",
"outputmode",
"printingmode",
"printoutmode",
"printmode",
"mode",
"imagetype",
"imagemode",
"image",
"dithering",
"dither",
"halftoning",
"halftone",
"floydsteinberg",
"ret\$",
"cret\$",
"photoret\$",
"smooth",
# Adjustments
"gammacorrection",
"gammacorr",
"gammageneral",
"mastergamma",
"stpgamma",
"gammablack",
"blackgamma",
"gammacyan",
"cyangamma",
"gammamagenta",
"magentagamma",
"gammayellow",
"yellowgamma",
"gammared",
"redgamma",
"gammagreen",
"greengamma",
"gammablue",
"bluegamma",
"gamma",
"density",
"stpdensity",
"hpljdensity",
"tonerdensity",
"inkdensity",
"brightness",
"stpbrightness",
"saturation",
"stpsaturation",
"hue",
"stphue",
"tint",
"stptint",
"contrast",
"stpcontrast",
"black",
"stpblack",
"cyan",
"stpcyan",
"magenta",
"stpmagenta",
"yellow",
"stpyellow",
"red",
"stpred",
"green",
"stpgreen",
"blue",
"stpblue"
);
my @standardgroups = (
"general",
"media",
"quality",
"imag",
"color",
"output",
"finish",
"stapl",
"extra",
"install"
);
my $compare;
# Argument records
my $firstarg = $a;
my $secondarg = $b;
# Bring the two option names into a standard form to compare them
# in a better way
my $first = normalizename(lc($firstarg->{'name'}));
$first =~ s/[\W_]//g;
my $second = normalizename(lc($secondarg->{'name'}));
$second =~ s/[\W_]//g;
# group names
my $firstgr = $firstarg->{'group'};
my @firstgroup;
@firstgroup = split("/", $firstgr) if defined($firstgr);
my $secondgr = $secondarg->{'group'};
my @secondgroup;
@secondgroup = split("/", $secondgr) if defined($secondgr);
my $i = 0;
# Compare groups
while ($firstgroup[$i] && $secondgroup[$i]) {
# Normalize group names
my $firstgr = normalizename(lc($firstgroup[$i]));
$firstgr =~ s/[\W_]//g;
my $secondgr = normalizename(lc($secondgroup[$i]));
$secondgr =~ s/[\W_]//g;
# Are the groups in the list of standard group names?
my $j;
for ($j = 0; $j <= $#standardgroups; $j++) {
my $firstinlist = ($firstgr =~ /^$standardgroups[$j]/);
my $secondinlist = ($secondgr =~ /^$standardgroups[$j]/);
if (($firstinlist) && (!$secondinlist)) {return -1};
if (($secondinlist) && (!$firstinlist)) {return 1};
if (($firstinlist) && ($secondinlist)) {last};
}
# Compare normalized group names
$compare = $firstgr cmp $secondgr;
if ($compare != 0) {return $compare};
# Compare original group names
$compare = $firstgroup[$i] cmp $secondgroup[$i];
if ($compare != 0) {return $compare};
$i++;
}
# The one with a deeper level in the group tree will come later
if ($firstgroup[$i]) {return 1};
if ($secondgroup[$i]) {return -1};
# Sort by order parameter if the order parameters are different
if (defined($firstarg->{'order'}) && defined($secondarg->{'order'}) &&
$firstarg->{'order'} != $secondarg->{'order'}) {
return $firstarg->{'order'} cmp $secondarg->{'order'};
}
# Check whether the argument names are in the @standardopts list
for ($i = 0; $i <= $#standardopts; $i++) {
my $firstinlist = ($first =~ /^$standardopts[$i]/);
my $secondinlist = ($second =~ /^$standardopts[$i]/);
if (($firstinlist) && (!$secondinlist)) {return -1};
if (($secondinlist) && (!$firstinlist)) {return 1};
if (($firstinlist) && ($secondinlist)) {last};
}
# None of the search terms in the list, compare the standard-formed
# strings
$compare = ( $first cmp $second );
if ($compare != 0) {return $compare};
# No other criteria fullfilled, compare the original input strings
return $firstarg->{'name'} cmp $secondarg->{'name'};
}
sub sortvals {
# All sorting done case-insensitive and characters which are not a letter
# or number are taken out!!
# List of typical choice names to appear at first
# The terms must fit to the beginning of the line, terms which must fit
# exactly must have '\$' in the end.
my @standardvals = (
# Default setting
"default",
"printerdefault",
# "Neutral" setting
"None\$",
# Paper sizes
"letter\$",
#"legal",
"a4\$",
# Paper types
"plain",
# Printout Modes
"draft\$",
"draft\.gray",
"draft\.mono",
"draft\.",
"draft",
"normal\$",
"normal\.gray",
"normal\.mono",
"normal\.",
"normal",
"high\$",
"high\.gray",
"high\.mono",
"high\.",
"high",
"veryhigh\$",
"veryhigh\.gray",
"veryhigh\.mono",
"veryhigh\.",
"veryhigh",
"photo\$",
"photo\.gray",
"photo\.mono",
"photo\.",
"photo",
# Trays
"upper",
"top",
"middle",
"mid",
"lower",
"bottom",
"highcapacity",
"multipurpose",
"tray",
);
# Do not waste time if the input strings are equal
if ($a eq $b) {return 0;}
# Are the two strings numbers? Compare them numerically
if (($a =~ /^[\d\.]+$/) && ($b =~ /^[\d\.]+$/)) {
my $compare = ( $a <=> $b );
if ($compare != 0) {return $compare};
}
# Bring the two option names into a standard form to compare them
# in a better way
my $first = lc($a);
$first =~ s/[\W_]//g;
my $second = lc($b);
$second =~ s/[\W_]//g;
# Check whether they are in the @standardvals list
for (my $i = 0; $i <= $#standardvals; $i++) {
my $firstinlist = ($first =~ /^$standardvals[$i]/);
my $secondinlist = ($second =~ /^$standardvals[$i]/);
if (($firstinlist) && (!$secondinlist)) {return -1};
if (($secondinlist) && (!$firstinlist)) {return 1};
if (($firstinlist) && ($secondinlist)) {last};
}
# None of the search terms in the list, compare the standard-formed
# strings
my $compare = ( normalizename($first) cmp normalizename($second) );
if ($compare != 0) {return $compare};
# No other criteria fullfilled, compare the original input strings
return $a cmp $b;
}
# Take driver/pid arguments and generate a Perl data structure for the
# Perl filter scripts. Sort the options and enumerated choices so that
# they get presented more nicely on frontends which do not sort by
# themselves
sub getdat ($ $ $) {
my ($this, $drv, $poid) = @_;
my $ppdfile;
# Do we have a link to a custom PPD file for this driver in the
# printer XML file? Then return the custom PPD
my $p = $this->get_printer($poid);
if (defined($p->{'drivers'})) {
for my $d (@{$p->{'drivers'}}) {
next if ($d->{'id'} ne $drv);
$ppdfile = $d->{'ppd'} if defined($d->{'ppd'});
last;
}
}
# Do we have a PostScript printer and a link to a manufacturer-
# supplied PPD file? Then return the manufacturer-supplied PPD
if ($drv =~ /^Postscript$/i) {
$ppdfile = $p->{'ppdurl'} if defined($p->{'ppdurl'});
}
# There is a link to a custom PPD, if it is installed on the local
# machine, use the custom PPD instead of generating one from the
# Foomatic data
if ($ppdfile) {
$ppdfile =~ s,^http://.*/(PPD/.*)$,$1,;
$ppdfile = $libdir . "/db/source/" . $ppdfile;
$ppdfile = "${ppdfile}.gz" if (! -r $ppdfile);
if (-r $ppdfile) {
$this->getdatfromppd($ppdfile);
$this->{'dat'}{'ppdfile'} = $ppdfile;
return $this->{'dat'};
}
}
# Generate Perl data structure from database
my %dat; # Our purpose in life...
my $VAR1;
eval (`$bindir/foomatic-combo-xml -d '$drv' -p '$poid' -l '$libdir' | $bindir/foomatic-perl-data -C -l $this->{'language'}`) ||
die ("Could not run \"foomatic-combo-xml\"/" .
"\"foomatic-perl-data\"!");
%dat = %{$VAR1};
# Funky one-at-a-time cache thing
$this->{'dat'} = \%dat;
# We do some additional stuff which is very awkward to implement in C
# now, so we do it here
# Some clean-up
checklongnames($this->{'dat'});
sortoptions($this->{'dat'});
generalentries($this->{'dat'});
if (defined($this->{'dat'}{'shortdescription'})) {
$this->{'dat'}{'shortdescription'} =~ s/[\s\n\r]+/ /s;
$this->{'dat'}{'shortdescription'} =~ s/^\s+//;
$this->{'dat'}{'shortdescription'} =~ s/\s+$//;
}
return \%dat;
}
sub getdatfromppd {
my ($this, $ppdfile, $parameters) = @_;
my $dat = ppdtoperl($ppdfile, $parameters);
if (!defined($dat)) {
die ("Unable to open PPD file \'$ppdfile\'\n");
}
$this->{'dat'} = $dat;
}
sub ppdtoperl {
# Build a Perl data structure of the printer/driver options
my ($ppdfile, $parameters) = @_;
# Load the PPD file and send it to the parser
open PPD, ($ppdfile !~ /\.gz$/i ? "< $ppdfile" :
"$sysdeps->{'gzip'} -cd \'$ppdfile\' |") or return undef;
my @ppd = ;
close PPD;
$parameters->{'ppdfile'} = $ppdfile if $parameters;
return ppdfromvartoperl(\@ppd, $parameters);
}
sub apply_driver_and_pdl_info {
# Find out printer's page description languages and suitable drivers
my ($dat, $parameters) = @_;
my %drivers;
my $pdls;
my $ppddlpath;
my $ppddrv = $dat->{'driver'};
if ($parameters) {
if (defined($parameters->{'drivers'})) {
foreach my $d (@{$parameters->{'drivers'}}) {
$drivers{$d} = 1;
}
$ppddrv = $parameters->{'drivers'}[0];
$dat->{'driver'} = $parameters->{'drivers'}[0] if
$parameters->{'drivers'}[0] =~ /^$dat->{'driver'}/;
}
if ($parameters->{'recommendeddriver'}) {
$dat->{'driver'} = $parameters->{'recommendeddriver'};
}
if (defined($parameters->{'pdls'})) {
$pdls = join(",", @{$parameters->{'pdls'}});
}
if ($parameters->{'ppdfile'} && $parameters->{'ppdlink'}) {
my $ppdfile = $parameters->{'ppdfile'};
if ($parameters->{'basedir'}) {
my $basedir = $parameters->{'basedir'};
$basedir =~ s:/+$::;
if (! -d $basedir) {
die ("PPD base directory $basedir does not exist!\n");
}
if (! -r $ppdfile) {
$ppddlpath = $ppdfile;
$ppdfile = $basedir . "/" . $ppdfile;
if (! -r $ppdfile) {
die ("Given PPD file not found, neither as $ppddlpath nor as $ppdfile!\n");
}
} else {
$ppddlpath = $1 if $ppdfile =~ m:$basedir/(.*)$:;
}
} else {
if (! -r $ppdfile) {
die ("Given PPD file $ppdfile not found!\n");
}
$ppddlpath = $ppdfile;
}
if ($ppddlpath eq "") {
my $mk = $dat->{'id'};
$mk =~ s/^([^\-]+)\-.*$/$1/;
my $ppd = $ppdfile;
$ppd =~ s:^.*/([^/]+):$1:;
$ppddlpath = "PPD/$mk/$ppd";
}
$ppddlpath =~ s/\.gz$//i;
}
}
if ($dat->{'driver'} =~ /Postscript/i) {
$pdls = join(',', ($pdls, "POSTSCRIPT$dat->{'ppdpslevel'}"));
} elsif ($dat->{'driver'} =~ /(pxl|pcl[\s\-]?xl)/i) {
$pdls = join(',', ($pdls, "PCLXL"));
} elsif ($dat->{'driver'} =~ /(ljet4|lj4)/i) {
$pdls = join(',', ($pdls, "PCL5e"));
} elsif (($dat->{'driver'} =~ /clj/i) && $dat->{'color'}) {
$pdls = join(',', ($pdls, "PCL5c"));
} elsif ($dat->{'driver'} =~ /(ljet3|lj3)/i) {
$pdls = join(',', ($pdls, "PCL5"));
} elsif ($dat->{'driver'} =~ /(laserjet|ljet|lj)/i) {
$pdls = join(',', ($pdls, "PCL4"));
}
$pdls = join(',', ($dat->{'general_cmd'}, $pdls)) if
defined($dat->{'general_cmd'});
if ($pdls) {
for my $l (split(',', $pdls)) {
my ($lang, $level) = ('', '');
if ($l =~ /\b(PostScript|PS|BR-?Script|KPDL-?)\s*(\d?)\b/i) {
$lang = "postscript";
$level = $2;
} elsif ($l =~ /\b(PDF)\b/i) {
$lang = "pdf";
} elsif ($l =~ /\b(PCLXL)\b/i) {
$lang = "pcl";
$level = "6";
} elsif ($l =~ /\b(PCL)(\d\S?|)\b/i) {
$lang = "pcl";
$level = $2;
if (!$level) {
if ($dat->{'color'}) {
$level = "5c";
} else {
$level = "5e";
}
}
} elsif ($l =~ /\b(PJL)\b/i) {
$dat->{'pjl'} = 1;
$dat->{'jcl'} = 1;
}
if ($lang) {
if (!defined($dat->{'languages'})) {
$dat->{'languages'} = [];
}
my $found = 0;
foreach my $ll (@{$dat->{'languages'}}) {
if ($ll->{'name'} =~ /^$lang$/i) {
$ll->{'level'} = $level if $level &&
($level gt $ll->{'level'});
$found = 1;
}
}
push(@{$dat->{'languages'}},
{
'name' => $lang,
'level' => $level
}) if !$found;
}
}
}
$drivers{$dat->{'driver'}} = 1;
for my $ll (@{$dat->{'languages'}}) {
my $lang = $ll->{'name'};
my $level = $ll->{'level'};
if ($lang =~ /^postscript$/i) {
if ($level eq "1") {
$drivers{'Postscript1'} = 1;
} else {
$drivers{'Postscript'} = 1;
}
} elsif ($lang =~ /^pcl$/i) {
if ($level eq "6") {
if ($dat->{'color'}) {
$drivers{'pxlcolor'} = 1;
} else {
$drivers{'pxlmono'} = 1;
$drivers{'lj5gray'} = 1;
$drivers{'lj5mono'} = 1;
}
} elsif ($level eq "5e") {
$drivers{'ljet4d'} = 1;
$drivers{'ljet4'} = 1;
$drivers{'lj4dith'} = 1;
if ($dat->{'make'} =~ /^(HP|Hewlett[\s-]+Packard)$/i) {
$drivers{'hplip'} = 1;
} else {
$drivers{'hpijs-pcl5e'} = 1;
}
$drivers{'gutenprint'} = 1;
} elsif ($level eq "5c") {
$drivers{'cljet5'} = 1;
if ($dat->{'make'} =~ /^(HP|Hewlett[\s-]+Packard)$/i) {
$drivers{'hplip'} = 1;
} else {
$drivers{'hpijs-pcl5c'} = 1;
}
} elsif ($level eq "5") {
$drivers{'ljet3d'} = 1;
$drivers{'ljet3'} = 1;
} elsif ($level eq "4") {
$drivers{'laserjet'} = 1;
$drivers{'ljetplus'} = 1;
$drivers{'ljet2p'} = 1;
}
# PCL printers print also plain text
$dat->{'ascii'} = 'us-ascii';
}
}
for my $drv (keys %drivers) {
if (!defined($dat->{'drivers'})) {
$dat->{'drivers'} = [];
}
my $found = 0;
foreach my $dd (@{$dat->{'drivers'}}) {
if (($dd->{'name'} =~ /^$drv$/i) ||
($dd->{'id'} =~ /^$drv$/i)) {
$found = 1;
}
if ($ppddlpath && ($dd->{'id'} =~ /^$ppddrv$/i)) {
$dd->{'ppd'} = $ppddlpath;
}
}
push(@{$dat->{'drivers'}},
{
'name' => $drv,
'id' => $drv,
($ppddlpath && ($drv =~ /^$ppddrv$/i) ?
('ppd' => $ppddlpath) : ())
}) if !$found;
}
}
sub ppdfromvartoperl {
my ($ppd, $parameters) = @_;
# Build a data structure for the renderer's command line and the
# options
my $dat = {}; # data structure for the options
my $currentargument = ""; # We are currently reading this argument
my $currentgroup = ""; # We are currently in this group/subgroup
my @currentgrouptrans; # Translation/long name for group/subgroup
my $isfoomatic = 0; # Do we have a Foomatic PPD?
# If we have an old Foomatic 2.0.x PPD file, read its built-in Perl
# data structure into @datablob and the default values in %ppddefaults
# Then delete the $dat structure, replace it by the one "eval"ed from
# @datablob, and correct the default settings according to the ones of
# the main PPD structure
my @datablob;
$dat->{"encoding"} = "ascii";
# search for LanguageEncoding
for (my $i = 0; $i < @{$ppd}; $i ++) {
$_ = $ppd->[$i];
if (m/^\*LanguageEncoding:\s*(\S+)\s*$/) {
# "*LanguageEncoding: "
$dat->{'encoding'} = $1;
if ($dat->{'encoding'} eq 'MacStandard') {
$dat->{'encoding'} = 'MacCentralEurRoman';
} elsif ($dat->{'encoding'} eq 'WindowsANSI') {
$dat->{'encoding'} = 'cp1252';
} elsif ($dat->{'encoding'} eq 'JIS83-RKSJ') {
$dat->{'encoding'} = 'shiftjis';
}
last;
}
}
# decode PPD
my $encoding = $dat->{"encoding"};
for (my $i = 0; $i < @{$ppd}; $i ++) {
$ppd->[$i] = decode($encoding, $ppd->[$i]);
}
$dat->{'maxpaperwidth'} = 0;
# Parse the PPD file
for (my $i = 0; $i < @{$ppd}; $i ++) {
$_ = $ppd->[$i];
# Foomatic should also work with PPD files downloaded under
# Windows.
$_ = undossify($_);
# Parse keywords
if (m!^\*NickName:\s*\"(.*)$!) {
# "*NickName: "
my $line = $1;
# Store the value
# Code string can have multiple lines, read all of them
my $cmd = "";
while ($line !~ m!\"!) {
$line =~ s/^\s*//;
$line =~ s/\s*$//;
$cmd .= " $line";
# Read next line
$i ++;
$line = $ppd->[$i];
chomp $line;
}
$line =~ s/^\s*//;
$line =~ m!^([^\"]*?)\s*\"!;
$cmd .= " $1";
$cmd =~ s/^\s*//;
$dat->{'makemodel'} = unhexify($cmd);
$dat->{'makemodel'} =~ s/^([^,]+),.*$/$1/;
} elsif (m!^\*ModelName:\s*\"(.*)$!) {
# "*ModelName: "
my $line = $1;
# Store the value
# Code string can have multiple lines, read all of them
my $cmd = "";
while ($line !~ m!\"!) {
$line =~ s/^\s*//;
$line =~ s/\s*$//;
$cmd .= " $line";
# Read next line
$i ++;
$line = $ppd->[$i];
chomp $line;
}
$line =~ s/^\s*//;
$line =~ m!^([^\"]*?)\s*\"!;
$cmd .= " $1";
$cmd =~ s/^\s*//;
$dat->{'ppdmodelname'} = unhexify($cmd);
} elsif (m!^\*Product:\s*\"(.*)$!) {
# "*Product: "
my $line = $1;
# Store the value
# Code string can have multiple lines, read all of them
my $cmd = "";
while ($line !~ m!\"!) {
$line =~ s/^\s*//;
$line =~ s/\s*$//;
$cmd .= " $line";
# Read next line
$i ++;
$line = $ppd->[$i];
chomp $line;
}
$line =~ s/^\s*//;
$line =~ m!^([^\"]*?)\s*\"!;
$cmd .= " $1";
$cmd =~ s/^\s*//;
my $ppdproduct = unhexify($cmd);
$ppdproduct =~ s/^\s*\(\s*//;
$ppdproduct =~ s/\s*\)\s*$//;
@{$dat->{'ppdproduct'}} = ()
if !defined($dat->{'ppdproduct'});
push(@{$dat->{'ppdproduct'}}, $ppdproduct);
} elsif (m!^\*Manufacturer:\s*\"(.*)$!) {
# "*Manufacturer: "
my $line = $1;
# Store the value
# Code string can have multiple lines, read all of them
my $cmd = "";
while ($line !~ m!\"!) {
$line =~ s/^\s*//;
$line =~ s/\s*$//;
$cmd .= " $line";
# Read next line
$i ++;
$line = $ppd->[$i];
chomp $line;
}
$line =~ s/^\s*//;
$line =~ m!^([^\"]*?)\s*\"!;
$cmd .= " $1";
$cmd =~ s/^\s*//;
$dat->{'ppdmanufacturer'} = unhexify($cmd);
} elsif (m!^\*LanguageVersion:\s*(\S+)\s*$!) {
# "*LanguageVersion: "
$dat->{'language'} = $1;
} elsif (m!^\*ColorDevice:\s*(\S+)\s*$!) {
# "*ColorDevice: "
my $col = $1;
if ($col =~ /true/i) {
$dat->{'color'} = 1;
} elsif ($col =~ /false/i) {
$dat->{'color'} = 0;
}
} elsif (m!^\*LanguageLevel:\s*\"?(\S+?)\"?\s*$!) {
# "*LanguageLevel: """
$dat->{'ppdpslevel'} = $1;
} elsif (m!^\*Throughput:\s*\"?(\S+?)\"?\s*$!) {
# "*Throughput: """
$dat->{'throughput'} = $1;
} elsif (m!^\*1284DeviceID:\s*\"(.*)$!) {
# "*1284DeviceID: "
my $line = $1;
# Store the value
# Code string can have multiple lines, read all of them
my $cmd = "";
while ($line !~ m!\"!) {
$line =~ s/^\s*//;
$line =~ s/\s*$//;
$cmd .= $line;
# Read next line
$i ++;
$line = $ppd->[$i];
chomp $line;
}
$line =~ m!^([^\"]*?)\s*\"!;
$cmd .= $1;
$cmd =~ s/^\s*//;
if (!defined($dat->{'general_ieee'}) ||
(length($dat->{'general_ieee'}) <
length($cmd))) {
$dat->{'general_ieee'} = unhexify($cmd);
if ($dat->{'general_ieee'} =~ /(MFG|MANUFACTURER):\s*([^:;]+);?/i) {
$dat->{'general_mfg'} = $2;
}
if ($dat->{'general_ieee'} =~ /(MDL|MODEL):\s*([^:;]+);?/i) {
$dat->{'general_mdl'} = $2;
}
if ($dat->{'general_ieee'} =~ /(CMD|COMMANDS?\s*SET):\s*([^:;]+);?/i) {
$dat->{'general_cmd'} = $2;
}
if ($dat->{'general_ieee'} =~ /(DES|DESCRIPTION):\s*([^:;]+);?/i) {
$dat->{'general_des'} = $2;
}
}
} elsif (m!^\*PaperDimension\s+([^:]+):\s*\"(.*)$!) {
# "*PaperDimension : "
my $line = $2;
# Store the value
# Code string can have multiple lines, read all of them
my $cmd = "";
while ($line !~ m!\"!) {
$line =~ s/^\s*//;
$line =~ s/\s*$//;
$cmd .= " $line";
# Read next line
$i ++;
$line = $ppd->[$i];
chomp $line;
}
$line =~ s/^\s*//;
$line =~ m!^([^\"]*?)\s*\"!;
$cmd .= " $1";
$cmd =~ s/^\s*//;
$cmd =~ /^(\d+)/;
my $width = $1;
$dat->{'maxpaperwidth'} = $width if
$width && ($width > $dat->{'maxpaperwidth'});
} elsif (m!^\*cupsFilter\s+([^:]+):\s*\"(.*)$!) {
# "*cupsFilter: "
my $line = $2;
# Store the value
# Code string can have multiple lines, read all of them
my $cmd = "";
while ($line !~ m!\"!) {
$line =~ s/^\s*//;
$line =~ s/\s*$//;
$cmd .= " $line";
# Read next line
$i ++;
$line = $ppd->[$i];
chomp $line;
}
$line =~ s/^\s*//;
$line =~ m!^([^\"]*?)\s*\"!;
$cmd .= " $1";
$cmd =~ s/^\s*//;
push(@{$dat->{'cupsfilterlines'}}, $cmd);
} elsif (m!^\*FoomaticIDs:\s*(\S+)\s+(\S+)\s*$!) {
# "*FoomaticIDs: "
my $id = $1;
my $driver = $2;
# Store the values
$dat->{'id'} = $id;
$dat->{'driver'} = $driver;
$isfoomatic = 1;
} elsif (m!^\*FoomaticRIPPostPipe:\s*\"(.*)$!) {
# "*FoomaticRIPPostPipe: "
my $line = $1;
# Store the value
# Code string can have multiple lines, read all of them
my $cmd = "";
while ($line !~ m!\"!) {
if ($line =~ m!&&$!) {
# line continues in next line
$cmd .= substr($line, 0, -2);
} else {
# line ends here
$cmd .= "$line\n";
}
# Read next line
$i ++;
$line = $ppd->[$i];
chomp $line;
}
$line =~ m!^([^\"]*)\"!;
$cmd .= $1;
$dat->{'postpipe'} = unhtmlify($cmd);
} elsif (m!^\*FoomaticRIPCommandLine:\s*\"(.*)$!) {
# "*FoomaticRIPCommandLine: "
my $line = $1;
# Store the value
# Code string can have multiple lines, read all of them
my $cmd = "";
while ($line !~ m!\"!) {
if ($line =~ m!&&$!) {
# line continues in next line
$cmd .= substr($line, 0, -2);
} else {
# line ends here
$cmd .= "$line\n";
}
# Read next line
$i ++;
$line = $ppd->[$i];
chomp $line;
}
$line =~ m!^([^\"]*)\"!;
$cmd .= $1;
$dat->{'cmd'} = unhtmlify($cmd);
} elsif (m!^\*FoomaticRIPCommandLinePDF:\s*\"(.*)$!) {
# "*FoomaticRIPCommandLinePDF: "
my $line = $1;
# Store the value
# Code string can have multiple lines, read all of them
my $cmd = "";
while ($line !~ m!\"!) {
if ($line =~ m!&&$!) {
# line continues in next line
$cmd .= substr($line, 0, -2);
} else {
# line ends here
$cmd .= "$line\n";
}
# Read next line
$i ++;
$line = $ppd->[$i];
chomp $line;
}
$line =~ m!^([^\"]*)\"!;
$cmd .= $1;
$dat->{'cmd_pdf'} = unhtmlify($cmd);
} elsif (m!^\*FoomaticRIPNoPageAccounting:\s*(\S+)\s*$!) {
# "*FoomaticRIPNoPageAccounting: "
my $value = $1;
# Store the value
if ($value =~ /^True$/i) {
$dat->{'drivernopageaccounting'} = 1;
} else {
delete $dat->{'drivernopageaccounting'};
}
} elsif (m!^\*CustomPageSize\s+True:\s*\"(.*)$!) {
# "*CustomPageSize True: "
my $setting = "Custom";
my $translation = "Custom Size";
my $line = $1;
# Make sure that the argument is in the data structure
checkarg ($dat, "PageSize");
checkarg ($dat, "PageRegion");
# "PageSize" and "PageRegion" must be both user-visible as they are
# options required by the PPD spec
undef $dat->{'args_byname'}{"PageSize"}{'hidden'};
undef $dat->{'args_byname'}{"PageRegion"}{'hidden'};
# Make sure that the setting is in the data structure
checksetting ($dat, "PageSize", $setting);
checksetting ($dat, "PageRegion", $setting);
$dat->{'args_byname'}{'PageSize'}{'vals_byname'}{$setting}{'comment'} = $translation;
$dat->{'args_byname'}{'PageRegion'}{'vals_byname'}{$setting}{'comment'} = $translation;
# Store the value
# Code string can have multiple lines, read all of them
my $code = "";
while ($line !~ m!\"!) {
if ($line =~ m!&&$!) {
# line continues in next line
$code .= substr($line, 0, -2);
} else {
# line ends here
$code .= "$line\n";
}
# Read next line
$i ++;
$line = $ppd->[$i];
chomp $line;
}
$line =~ m!^([^\"]*)\"!;
$code .= $1;
if ($code !~ m!^%% FoomaticRIPOptionSetting!m) {
$dat->{'args_byname'}{'PageSize'}{'vals_byname'}{$setting}{'driverval'} = $code;
$dat->{'args_byname'}{'PageRegion'}{'vals_byname'}{$setting}{'driverval'} = $code;
}
} elsif (m!^\*Open(Sub|)Group:\s*\*?([^/]+?)(/(.*)|)$!) {
# "*Open[Sub]Group: [/]
my $group = $2;
chomp($group) if $group;
my $grouptrans = $4;
chomp($grouptrans) if $grouptrans;
if (!$grouptrans) {
$grouptrans = longname($group);
}
if ($currentgroup) {
$currentgroup .= "/";
}
$currentgroup .= $group;
push(@currentgrouptrans,
unhexify($grouptrans, $dat->{"encoding"}));
} elsif (m!^\*Close(Sub|)Group:?\s*\*?([^/]+?)$!) {
# "*Close[Sub]Group: "
my $group = $2;
chomp($group) if $group;
$currentgroup =~ s!$group$!!;
$currentgroup =~ s!/$!!;
pop(@currentgrouptrans);
} elsif (m!^\*Close(Sub|)Group\s*$!) {
# "*Close[Sub]Group"
# NOTE: This expression is not Adobe-conforming
$currentgroup =~ s![^/]+$!!;
$currentgroup =~ s!/$!!;
pop(@currentgrouptrans);
} elsif (m!^\*(JCL|)OpenUI\s+\*([^:]+):\s*(\S+)\s*$!) {
# "*[JCL]OpenUI *