Skip to content
Snippets Groups Projects
Commit 19b6c9d6 authored by Martin Mareš's avatar Martin Mareš
Browse files

PPD: Data model split off generator itself

parent 01363340
No related branches found
No related tags found
No related merge requests found
......@@ -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);
}
# get("section/option")
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("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"; }
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});
}
}
......
......@@ -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;
......@@ -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 = $_;
......
......@@ -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 },
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment