package Foomatic::PPD;
use Foomatic::UIElem;
my @Sections = qw(JCLBegin
JCLSetup
JCLToPSInterpreter
ExitServer
Prolog
DocumentSetup
PageSetup);
sub new {
my ($type, $filename, $poid) = @_;
open PPD, "$filename" or die;
my %ppd;
$ppd{'filename'} = $filename;
my ($opt, $optname);
my ($choice,$choiceverb,$snippet);
my $l;
for $l () {
# skip comments
next if ($l =~ m!^*%!);
# skip blank lines
next if ($l =~ m!^\s*$!);
if (defined($snippet)) {
$snippet = "$snippet$l";
if ($snippet =~ s!\"\s*$!!) {
$opt->add_option($choice, $choiceverb, $snippet);
$snippet = undef;
}
} elsif (defined($opt)) {
# In mid-parse of a UI option clause
if ($l =~ m!^\*CloseUI: \*$optname!) {
# close up the $opt object
push(@{$ppd{'options'}}, $opt);
$optname = $opt = undef;
} elsif ($l =~ m!^\*OrderDependency: ([\.\d]+) (AnySetup|JCLSetup|PageSetup|DocumentSetup|Prolog|ExitServer) \*$optname!) {
my ($order, $section) = ($1, $2);
$opt->set('order_real'=>$order);
$opt->set('order_section'=>$section);
$opt->set('order_keyword'=>$optname);
} elsif ($l =~ m!^\*Default$optname:\s+([0-9\&A-Za-z]+)!) {
$opt->set('default'=>$1);
} elsif ($l =~ m!^\*$optname ([\d\&A-Za-z]+)(\/([^:]+))?:\s*\"([^\"]*)(\")?!) {
if ($5 eq '"') {
$opt->add_option($1,$3?$3:$1,$4);
} else {
$snippet = $4;
$choice = $1;
$choiceverb = $3?$3:$1;
}
}
} else {
# not in UI clause parsing
if ($l =~ m!^\*NickName:\s*\"(.+)\"!) {
$ppd{'NickName'} = $1;
} elsif ($l =~ m!^\*ModelName:\s*\"(.+)\"!) {
$ppd{'ModelName'} = $1;
} elsif ($l =~ m!^\*Manufacturer:\s*\"(.+)\"!) {
$ppd{'Manufacturer'} = $1;
} elsif ($l =~ m!^\*OpenUI \*([0-9\&A-Za-z]+)(\/(.+))?:\s*(Boolean|PickOne|PickMany)!) {
my ($name, $label, $type) = ($1, $3, $4);
# make new $opt object
$optname = $name;
$opt = new Foomatic::UIElem ('name'=>$optname,
'type'=>$type,
'label'=>($label?$label:$name));
}
# yadda...
}
}
close PPD;
my $this = bless \%ppd;
$this->sort_options();
$this->{'printer_id'} = $poid;
return $this;
}
sub sort_options {
my $this = $_[0];
# First, sort all the options into sections
my %sections;
my $o;
while (defined($o=pop(@{$this->{'options'}}))) {
my $sec = $o->{'order_section'};
push(@{$sections{($sec ? $sec : 'Queries')}}, $o);
}
$this->{'options'} = undef;
# Put AnySetup stuff in DocumentSetup (or could be PageSetup)
push(@{$sections{'DocumentSetup'}}, @{$sections{'AnySetup'}});
@{$sections{'AnySetup'}} = ();
# Now sort each section by orderdep number
my $k;
for $k (keys(%sections)) {
my @sorted = sort {$a->{'order_real'}
<=> $b->{'order_real'}} @{$sections{$k}};
$sections{$k} = \@sorted;
}
$this->{'sections'} = \%sections;
}
sub pdq_options {
my $this = $_[0];
my @opts;
my $k;
for $k (@Sections) {
my $o;
for $o (@{$this->{'sections'}->{$k}}) {
my ($name, $label, $type, $default) =
($o->{'name'},$o->{'label'},$o->{'type'},$o->{'default'});
if ($type eq 'PickOne'
or $type eq 'Boolean'
or $type eq 'PickMany') {
push(@opts,
" option {\n",
" var = \"$name\"\n",
" desc = \"$label\"\n",
" default_choice \"$default\"\n");
my $c;
for $c (@{$o->{'options'}}) {
my ($label, $option) = ($c->{'label'}, $c->{'option'});
push(@opts,
" choice \"$name:$option\" {\n",
" value = \"$option\"\n",
" desc = \"$label\"\n",
" }\n");
}
push(@opts,
" }\n");
}
$optnum++;
}
}
return @opts;
}
sub _tag {
my ($t, @v) = @_;
return '' if !defined(@v);
if (0) {
$v =~ s!\&!\&\;!g;
$v =~ s!\" . join('',@v) . "\n";
}
sub foo_options {
my ($this) = (@_);
# We build a list of option xml objects
my @options;
# All of them need to get sandwiched between
# %!PS
# statusdict begin
# opt1
# opt2
# ....
# end
# For each section in the order defined by Adobe, and for each
# option in the order defined by the PPD, we emit shell code to
# generate the proper snippet-o-postscript into the backend
# filter's output.
# TODO: some sections go in the middle of the document! E-gad!
# TODO: JCL incantations - these aren't even parsed from the PPD yet.
my $prn = $this->{'printer_id'};
my $filename = $this->{'filename'};
my $k;
# AnySetup has already been moved to DocumentSetup.
# We don't do the JCL stuff yet.
for $k (qw(Prolog DocumentSetup PageSetup)) {
my $o;
my $optidx = 0;
for $o (@{$this->{'sections'}->{$k}}) {
my (@opt) = ();
# We only do PickOne and Boolean (no PickMany)
if ($o->{'type'} ne 'PickOne'
and $o->{'type'} ne 'Boolean') {
print STDERR ("Skipping option ", $o->{'name'},
" because it is a ", $o->{'type'}, "\n");
next;
}
# Skip "PageRegion", it is the same as "PageSize"
next if ($o->{'name'} eq "PageRegion");
my ($var,$order) = @$o{'name','order_real'};
# Find index of default option
my $c;
my $scanindex = 1;
my $defaultindex = 1; # assume first
for $c (@{$o->{'options'}}) {
my $v = $c->{'option'};
if ($o->{'default'} eq $v) {
$defaultindex = $scanindex;
last;
}
$scanindex++;
}
push (@opt, ("\n");
# Note that we skip the whole thing if there are no choices!
push (@options, { 'id' => "ppd-$prn-$var",
'xml' => \@opt } );
}
}
}
return @options;
}
sub xml_esc {
my ($in) = (@_);
@chars = split(//,$in);
$ascii = "";
foreach (@chars) {
if (ord ($_) > 127) { $_="?"; }
$ascii .= $_;
}
$ascii =~ s!&!&!g;
$ascii =~ s!!>!g;
return $ascii;
}
sub pdq_filter {
my ($this) = $_[0];
my @filt;
push(@filt,
" filter_exec {\n\n",
" echo '%!PS' > \$OUTPUT\n",
" echo 'statusdict begin' >> \$OUTPUT\n\n");
# For each section in the order defined by Adobe, and for each
# option in the order defined by the PPD, we emit shell code to
# generate the proper snippet-o-postscript into the PDQ filter's
# output.
#
# TODO: some sections go in the middle of the document! E-gad!
# TODO: JCL incantations - these aren't even parsed from the PPD yet.
my $k;
for $k (@Sections) {
my $o;
for $o (@{$this->{'sections'}->{$k}}) {
my ($var,$order) = @$o{'name','order_real'};
push (@filt,
" # We put option $var in section $k order numer $order\n");
my $c;
my $first = 1;
for $c (@{$o->{'options'}}) {
my $el = ($first ? '' : 'el');
my $v = $c->{'option'};
my $snippet = $c->{'snippet'};
if ($snippet) {
my @sniplines = split("\n", $snippet);
push(@filt,
" ${el}if [ \"\$$var\" = \"$v\" ]; then\n");
for (@sniplines) {
next if /^\s*$/;
$_ =~ s!\'!\\\'!g; # escape single quotes
# TODO: We should also handle <##> hex numbers!
push(@filt,
" echo \'$_\' >> \$OUTPUT;\n");
}
$first = 0;
}
}
push (@filt, " fi\n\n");
}
}
push (@filt,
" echo 'end' >> \$OUTPUT\n\n",
" cat \$INPUT >> \$OUTPUT\n",
" }\n");
return @filt;
}
sub pdq_driver {
my ($this) = @_;
my $name = $this->get_name();
my $driver = $name;
$driver =~ s!^\s*!!;
$driver =~ s!\s*$!!;
$driver =~ s!(\s+)!\-!g;
$driver = "$driver-0.1";
my @drv;
push (@drv,
"driver $driver {\n\n",
" help \"This driver was automagically converted from the \n",
" PPD file for the $name by ppdtopdq.\"\n\n",
$this->pdq_options(),
"\n",
" language_driver ps {\n",
" filetype_regx = \"postscript\"\n",
" }\n\n",
$this->pdq_filter(),
"}\n");
return @drv;
}
# get a nice pretty english name for this thing
sub get_name {
my ($this) = @_;
my ($mk,$md,$nk) = (@$this{'Manufacturer','ModelName','NickName'});
my $name;
if ($mk) { $name = "$mk"; }
if ($md) { $name = "$name $md"; }
elsif ($nk) { $name = "$name $nk"; }
return $name;
}
1;