diff --git a/ppd/PPD.pm b/ppd/PPD.pm index ed74bb51f0435f3557aaf0aa97fc973bc7de661b..36e179f9ea37473ad253e21bff5c0da45d677ded 100644 --- a/ppd/PPD.pm +++ b/ppd/PPD.pm @@ -4,134 +4,203 @@ use strict; use warnings; use Exporter 'import'; -our @EXPORT = qw(get set maybe_set option generate); +our @EXPORT = qw(define_group define_ui_group declare get set maybe_set option generate); -my %options = (); +### PPD data model ### -sub format_value($$) { - my ($type, $value) = @_; - $type //= 'q'; - if ($type eq 'q' || $type eq 'i') { - # Quoted value / Invocation value - if ($value =~ /["\x00-\x08\x0b-\x1f\x7f-\xff]/) { die "Invalid value: $value\n"; } - $value = '"' . $value . '"'; - if ($value =~ /\n/) { $value .= "\n*End"; } - return $value; - } elsif ($type eq 's') { - # String value - return $value; - } elsif ($type eq 'b') { - # Boolean value - return $value ? "True" : "False"; - } else { - die "Unknown type '$type'\n"; +# Key => { +# Key => key, +# Name => name, # descriptive name (default: same as Key) +# Mandatory => bool, +# Group => name, +# +# # For main keywords: +# Type => type, # q=quoted, i=invocation, s=string (unquoted), b=boolean +# Value => string, +# +# # For option keywords: +# Type => 'o', +# Choice => choice, # for UI options: PickOne / PickMany / Boolean +# JCL => 1, # if this is a JCL option +# Section => sec, # OrderDependency section: ExitServer / Prolog / DocumentSetup / +# # PageSetup / JCLSetup (default if JCL=1) / AnySetup (default if JCL=0) +# Priority => pri, # OrderDependency priority, default = 100 +# Values => [ # possible values (mandatory) +# { Key => key, # key (mandatory) +# Name => key, # descriptive name (default: same as Key) +# PS => string, # PS code to emit (mandatory) +# Default => 1, # if this is the default value +# }, +# ] +# } +my %keywords = (); + +# Key => { +# Key => key, +# UI => 1, # if a UI group +# Name => name, # descriptive name +# Keywords => [...] # list of keywords inside the group +# } +my %groups = (); +my @head_groups = (); +my @ui_groups = (); +my @nonui_groups = (); + +sub define_group($$) { + my ($key, $g) = @_; + !defined $groups{$key} or die "Group $key already exists\n"; + $groups{$key} = $g; + $g->{Key} = $key; + if ($g->{UI}) { push @ui_groups, $key; } + elsif ($g->{Head}) { push @head_groups, $key; } + else { push @nonui_groups, $key; } +} + +sub define_head_group($$) { + my ($key, $g) = @_; + $g->{Head} = 1; + define_group($key, $g); +} + +sub define_ui_group($$) { + my ($key, $g) = @_; + $g->{UI} = 1; + define_group($key, $g); +} + +# declare("group", ["keyword", "type[!]", "value"], ...) +sub declare($@) { + my $gn = shift @_; + my $g = $groups{$gn} or die "Group $gn does not exist\n"; + for my $ktn (@_) { + my ($key, $type, $value) = @$ktn; + my $mand = 0; + if ($type =~ s/!$//) { $mand = 1; } + !$keywords{$key} or die "Keyword $key already declared\n"; + $keywords{$key} = { + Key => $key, + Name => $key, + Group => $gn, + Type => $type, + Value => $value, + }; + $keywords{$key}{Mandatory} = 1 if $mand; + push @{$g->{Keywords}}, $keywords{$key}; } } -# get("section/option") +# get("keyword") sub get($) { - my ($key, $value) = @_; - my ($section, $opt) = split /\//, $key; - my $o = $options{$section}{$opt}; - if ($o) { - return $o->{'value'}; + my ($key) = @_; + my $kw = $keywords{$key}; + if ($kw) { + return $kw->{'Value'}; } else { return; } } -# set("section/option[:type]", value) -# types: q=quoted (default), i=invocation, s=string (unquoted), b=boolean +# set("option", value) [must be already declared] sub set($$) { my ($key, $value) = @_; - my ($section, $opt) = split /\//, $key; - my ($opt2, $type) = split /:/, $opt; - $options{$section}{$opt2} = { 'type' => $type, 'value' => $value }; + my $k = $keywords{$key} or die "Unknown keyword $key (missing declaration)\n"; + $k->{Value} = $value; } +# maybe_set("option", value) [must be already declared] sub maybe_set($$) { my ($key, $value) = @_; - my ($section, $opt) = split /\//, $key; - my ($opt2, $type) = split /:/, $opt; - $options{$section}{$opt2} //= { 'type' => $type, 'value' => $value }; + my $k = $keywords{$key} or die "Unknown keyword $key (missing declaration)\n"; + $k->{Value} //= $value; } -sub mand($) { - my ($key) = @_; - my ($section, $opt) = split /\//, $key; - $options{$section}{$opt} = undef; +# option({ Group => group, Key => key, Name => name, ... other keyword parameters }) +sub option($) { + my ($o) = @_; + my $key = $o->{Key}; + !defined $keywords{$key} or die "Keyword $key already known\n"; + my $g = $groups{$o->{Group}} or die "Keyword $key specified with an unknown group\n"; + $o->{Type} = 'o'; + $keywords{$key} = $o; + push @{$g->{Keywords}}, $o; } -# Section "f": file description -set('f/FormatVersion', '4.3'); -set('f/LanguageEncoding:s', 'ISOLatin1'); -set('f/LanguageVersion:s', 'English'); -mand('f/FileVersion'); -mand('f/PCFileName'); - -# Section "p": product description -mand('p/Manufacturer'); -mand('p/ModelName'); -mand('p/NickName'); -mand('p/ShortNickName'); -mand('p/Product'); -mand('p/PSVersion'); +### Known main keywords ### -# Section "d": device capabilities -set('d/ColorDevice:b', 0); -set('d/DefaultColorSpace:q', 'Gray'); -set('d/FileSystem:b', 0); +# Group "f": file description +define_head_group('f', { Name => 'File version' }); +declare('f', + [ 'FormatVersion', 'q!', '4.3' ], + [ 'LanguageEncoding', 's!', 'ISOLatin1' ], + [ 'LanguageVersion', 's!', 'English' ], + [ 'FileVersion', 's!', undef ], + [ 'PCFileName', 's!', undef ], +); -# Section "c": CUPS options -# (none by default) +# Group "p": product description +define_head_group('p', { Name => 'Product description' }); +declare('p', + [ 'Manufacturer', 'q!', undef ], + [ 'ModelName', 'q!', undef ], # default: copy Product + [ 'NickName', 'q!', undef ], # default: copy Product + [ 'ShortNickName', 'q!', undef ], # default: copy NickName + [ 'Product', 'q!', undef ], + [ 'PSVersion', 'q!', undef ], +); -# Section "j": JCL options -# (none by default) +# Group "d": device capabilities +define_head_group('d', { Name => 'Device capabilities' }); +declare('d', + [ 'ColorDevice', 'b', 0 ], + [ 'DefaultColorSpace', 's', 'Gray' ], + [ 'FileSystem', 'b', 0 ], + [ 'Extensions', 's', undef ], + [ 'FaxSupport', 's', undef ], + [ 'LanguageLevel', 'q', undef ], + [ 'Throughput', 'q', undef ], + [ 'TTRasterizer', 's', undef ], + [ '1284Modes', 's', undef ], + [ '1284DeviceID', 'q', undef ], + [ 'FreeVM', 'q', undef ], + # VMOption not supported yet + [ 'VariablePaperSize', 'b', 1 ], + [ 'Protocols', 's', undef ], +); -my @ui_groups = (); - -sub ui_group($) { - my ($g) = @_; - my $key = $g->{'Key'}; - defined $options{'u'}{$key} and die "Duplicate UI group $key\n"; - $options{'u'}{$key} = $g; - push @ui_groups, $g; - $g->{'Options'} = []; -} +# Group "c": CUPS options +define_head_group('c', { Name => 'CUPS options' }); +declare('c', + [ 'cupsProtocol', 's', undef ], +); -# Section "u": UI groups -ui_group({ Key => '' }); +# Group "j": JCL options +define_head_group('j', { Name => 'JCL options' }); +declare('j', + [ 'JCLBegin', 'q', undef ], + [ 'JCLToPSInterpreter', 'q', undef ], + [ 'JCLEnd', 'q', undef ], +); -# Section "n": non-UI options -$options{'n'} = { Key => '', Options => [] }; +### Formatting of PPD ### -# option({ -# Key => key, # (mandatory) -# Name => name, # descriptive name (default: same as Key) -# Type => type, # PickOne (default) / PickMany / Boolean -# UI => group, # UI group ('' if outside groups, default: non-UI option) -# JCL => 1, # if this is a JCL option -# Section => sec, # OrderDependency section: ExitServer / Prolog / DocumentSetup / -# # PageSetup / JCLSetup (default if JCL=1) / AnySetup (default if JCL=0) -# Priority => pri, # OrderDependency priority, default = 100 -# Values => [ # possible values (mandatory) -# { Key => key, # key (mandatory) -# Name => key, # descriptive name (default: same as Key) -# PS => string, # PS code to emit (mandatory) -# Default => 1, # if this is the default value -# }, -# ] -# }) -sub option($) { - my ($o) = @_; - my $ui = $o->{'UI'}; - my $g; - if (defined $ui) { - $g = $options{'u'}{$ui} or die "No such UI group $ui\n"; +sub format_value($$) { + my ($type, $value) = @_; + $type //= 'q'; + if ($type eq 'q' || $type eq 'i') { + # Quoted value / Invocation value + if ($value =~ /["\x00-\x08\x0b-\x1f\x7f-\xff]/) { die "Invalid value: $value\n"; } + $value = '"' . $value . '"'; + if ($value =~ /\n/) { $value .= "\n*End"; } + return $value; + } elsif ($type eq 's') { + # String value + return $value; + } elsif ($type eq 'b') { + # Boolean value + return $value ? "True" : "False"; } else { - $g = $options{'n'}; + die "Unknown type '$type'\n"; } - push @{$g->{'Options'}}, $o; } sub heading($) { @@ -143,21 +212,6 @@ sub heading($) { print "\n"; } -sub emit($;$) { - my ($section, $heading) = @_; - my $opts = $options{$section}; - $opts or return; - heading($heading) if defined $heading; - for my $k (sort keys %$opts) { - my $v = $opts->{$k}; - if (!$v) { - print STDERR "ERROR: Value of mandatory option $k is missing\n"; - } else { - print "*$k: ", format_value($v->{'type'}, $v->{'value'}), "\n"; - } - } -} - sub get_default($) { my ($o) = @_; for my $val (@{$o->{Values}}) { @@ -169,13 +223,14 @@ sub get_default($) { sub emit_option($) { my ($o) = @_; my $key = $o->{Key}; - my $type = $o->{Type} // 'PickOne'; print "%* === $key ===\n"; my $jcl = ($o->{JCL} // ($key =~ /^JCL/)) ? "JCL" : ""; - if (defined $o->{UI}) { print "*${jcl}OpenUI *$key/", ($o->{Name} // $o->{Key}), ": $type\n"; } - my $pri = $o->{Priority} // 100; - my $sec = $o->{Section} // ($jcl ? "JCLSetup" : "AnySetup"); - print '*', ((defined $o->{UI}) ? "" : 'NonUI'), "OrderDependency $pri $sec *$key\n"; + if (defined $o->{Choice}) { + print "*${jcl}OpenUI *$key/", ($o->{Name} // $o->{Key}), ": ", $o->{Choice}, "\n"; + my $pri = $o->{Priority} // 100; + my $sec = $o->{Section} // ($jcl ? "JCLSetup" : "AnySetup"); + print '*', ((defined $o->{UI}) ? "" : 'NonUI'), "OrderDependency $pri $sec *$key\n"; + } print "*Default$key: ", get_default($o), "\n"; for my $v (@{$o->{Values}}) { my $ps = $v->{PS}; @@ -183,56 +238,67 @@ sub emit_option($) { # $ps = "$ps\n" unless $ps =~ /\n$/s; print "*$key ", $v->{Key}, '/', ($v->{Name} // $v->{Key}), ': ', format_value('i', $ps), "\n"; } - if (defined $o->{UI}) { print "*${jcl}CloseUI *$key\n"; } + if (defined $o->{Choice}) { print "*${jcl}CloseUI *$key\n"; } print "\n"; } +sub emit_keyword($) { + my ($k) = @_; + if ($k->{Type} eq 'o') { + emit_option($k); + } elsif (defined $k->{Value}) { + print "*", $k->{Key}, ": ", format_value($k->{'Type'}, $k->{'Value'}), "\n"; + } +} + sub emit_group($) { my ($g) = @_; - if ($g->{Key} ne '') { print '*OpenGroup: ', $g->{Key}, '/', ($g->{Name} // $g->{Key}), "\n\n"; } - for my $o (@{$g->{Options}}) { - emit_option($o); + my $keywords = $g->{Keywords}; + $keywords && @$keywords or return; + heading($g->{Name}); + if ($g->{UI}) { print '*OpenGroup: ', $g->{Key}, '/', ($g->{Name} // $g->{Key}), "\n\n"; } + for my $k (@$keywords) { + emit_keyword($k); } - if ($g->{Key} ne '') { print "\n", '*CloseGroup: ', $g->{Key}, "\n"; } + if ($g->{UI}) { print "\n", '*CloseGroup: ', $g->{Key}, "\n"; } } -sub fill_missing() { - my $model = get('p/ModelName'); +sub fill_defaults() { + my $model = get('ModelName'); if (defined $model) { - maybe_set('p/Product', "($model)"); - maybe_set('p/NickName', $model); - maybe_set('p/ShortNickName', $model); + maybe_set('Product', "($model)"); + maybe_set('NickName', $model); } - my $psver = get('p/PSVersion'); + my $nick = get('NickName'); + if ($nick) { + maybe_set('ShortNickName', $nick); + } + + my $psver = get('PSVersion'); if (defined($psver) && $psver =~ /\((\d)/) { - maybe_set('d/LanguageLevel', $1); + maybe_set('LanguageLevel', $1); } } -sub generate() { - print "*PPD-Adobe: ", get('f/FormatVersion'), "\n"; - print "*% PPD file generated by UCW PPD generator\n"; - fill_missing(); - - emit('f', 'File version'); - emit('p', 'Product information'); - emit('d', 'Device capabilities'); - emit('c', 'CUPS options'); - emit('j', 'JCL setup'); - - for my $g (@ui_groups) { - next if $g->{Key} eq ''; - heading($g->{Name}); - emit_group($g); +sub check_missing() { + for my $key (keys %keywords) { + my $k = $keywords{$key}; + if ($k->{Mandatory} && !defined $k->{Value}) { + die "Mandatory keyword $key not set\n"; + } } +} - heading("General UI options"); - emit_group($ui_groups[0]); +sub generate() { + fill_defaults(); + check_missing(); + + print "*PPD-Adobe: ", get('FormatVersion'), "\n"; + print "*% PPD file generated by UCW PPD generator\n"; - if (@{$options{'n'}->{Options}}) { - heading("Non-UI options"); - emit_group($options{'n'}); + for my $g (@head_groups, @ui_groups, @nonui_groups) { + emit_group($groups{$g}); } } diff --git a/ppd/PPD/PJL.pm b/ppd/PPD/PJL.pm index 9392cd099bb4a25221be809eddb7fd8a7c66c11d..93e40798f00c65a9c93baba98aa00411ee2d63c4 100644 --- a/ppd/PPD/PJL.pm +++ b/ppd/PPD/PJL.pm @@ -3,9 +3,9 @@ package PPD::PJL; use PPD; sub add_jcl() { - set('j/JCLBegin', '<1B>%-12345X@PJL<0A>'); - set('j/JCLToPSInterpreter', '@PJL ENTER LANGUAGE = POSTSCRIPT<0A>'); - set('j/JCLEnd', '<1B>%-12345X@PJL EOJ<0A><1B>%-12345X<0A>'); + set('JCLBegin', '<1B>%-12345X@PJL<0A>'); + set('JCLToPSInterpreter', '@PJL ENTER LANGUAGE = POSTSCRIPT<0A>'); + set('JCLEnd', '<1B>%-12345X@PJL EOJ<0A><1B>%-12345X<0A>'); } 42; diff --git a/ppd/PPD/Paper.pm b/ppd/PPD/Paper.pm index 6e97eab6af0d8eafc27a4c93c6cc289ca403be87..6a67900f24dcd1c304b95fa6868cbc9b2f3e2c59 100644 --- a/ppd/PPD/Paper.pm +++ b/ppd/PPD/Paper.pm @@ -40,10 +40,13 @@ sub add_papers($) { } $o->{DefPaper} //= 'A4'; + define_ui_group('Media', { Name => 'Media settings' }); + option({ + Group => 'Media', Key => 'PageSize', Name => 'Page Size', - UI => '', + Choice => 'PickAny', Priority => 30, Values => [ map { my $k = $_; @@ -58,9 +61,10 @@ sub add_papers($) { }); option({ + Group => 'Media', Key => 'PageRegion', Name => 'Page Region', - UI => '', + Choice => 'PickAny', Priority => 40, Values => [ map { my $k = $_; @@ -75,6 +79,7 @@ sub add_papers($) { }); option({ + Group => 'Media', Key => 'ImageableArea', Values => [ map { my $k = $_; diff --git a/ppd/gen-hp b/ppd/gen-hp index 13a6f4161549a5a4cce2f018949d88ae710ec2c5..9c1f2e38c1f774ec8900edb77419fd385153fa18 100755 --- a/ppd/gen-hp +++ b/ppd/gen-hp @@ -8,24 +8,26 @@ use PPD; use PPD::PJL; use PPD::Paper; -set('f/FileVersion', '1.0'); -set('f/PCFileName', 'HP4350.PPD'); +set('FileVersion', '1.0'); +set('PCFileName', 'HP4350.PPD'); -set('p/Manufacturer', 'HP'); -set('p/ModelName', 'HP LaserJet 4350'); -set('p/PSVersion', '(3010.107) 0'); +set('Manufacturer', 'HP'); +set('ModelName', 'HP LaserJet 4350'); +set('PSVersion', '(3010.107) 0'); -set('d/Throughput', 35); -set('d/TTRasterizer:s', 'Type42'); -set('d/VariablePaperSize:b', 1); -set('d/Protocols:s', 'PJL TBCP'); +set('Throughput', 35); +set('TTRasterizer', 'Type42'); +set('Protocols', 'PJL TBCP'); -set('c/cupsProtocol:s', 'None'); +set('cupsProtocol', 'None'); + +define_ui_group('Basic', { Name => 'Basic options' }); option({ + Group => 'Basic', Key => 'Duplex', Name => '2-Sided Printing', - UI => '', + Choice => 'PickOne', Values => [ { Key => 'None', Name => 'Off (1-Sided)', PS => "<< /Duplex false >> setpagedevice" }, { Key => 'DuplexNoTumble', Name => 'Long-Edge Binding', PS => "<< /Duplex true /Tumble false >> setpagedevice", Default => 1 }, @@ -34,9 +36,10 @@ option({ }); option({ + Group => 'Basic', Key => 'Resolution', Name => 'Printer Resolution', - UI => '', + Choice => 'PickOne', Priority => 5, Section => 'DocumentSetup', Values => [ @@ -47,10 +50,10 @@ option({ }); option({ + Group => 'Basic', Key => 'HPEconoMode', Name => 'EconoMode', - Type => 'Boolean', - UI => '', + Choice => 'Boolean', Values => [ { Key => 'False', Name => 'Highest Quality', PS => '<< /EconoMode false >> setpagedevice', Default => 1 }, { Key => 'True', Name => 'Save Toner', PS => '<< /EconoMode true >> setpagedevice' }, @@ -58,10 +61,10 @@ option({ }); option({ + Group => 'Basic', Key => 'Smoothing', Name => 'Resolution Enhancement', - Type => 'Boolean', - UI => '', + Choice => 'Boolean', Priority => 20, Section => 'DocumentSetup', Values => [ @@ -71,9 +74,9 @@ option({ }); option({ + Group => 'Basic', Key => 'Collate', - Type => 'Boolean', - UI => '', + Choice => 'Boolean', Values => [ { Key => 'False', Name => 'Off', PS => '<< /Collate false >> setpagedevice' }, { Key => 'True', Name => 'On', PS => '<< /Collate true >> setpagedevice', Default => 1 },