First bits of PPD generator

ppd/PPD.pm

+package PPD;
+
+use strict;
+use warnings;
+
+use Exporter 'import';
+our @EXPORT = qw(get set maybe_set generate);
+
+my %options = ();
+
+sub format_value($$) {
+	my ($type, $value) = @_;
+	$type //= 'q';
+	if ($type eq 'q') {
+		# Quoted value
+		return '"' . $value . '"';
+	} elsif ($type eq 'i') {
+		# Invocation value
+		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";
+	}
+}
+
+sub get($) {
+	my ($key, $value) = @_;
+	my ($section, $opt) = split /\//, $key;
+	my $o = $options{$section}{$opt};
+	if ($o) {
+		return $o->{'value'};
+	} else {
+		return;
+	}
+}
+
+sub set($$) {
+	my ($key, $value) = @_;
+	my ($section, $opt) = split /\//, $key;
+	my ($opt2, $type) = split /:/, $opt;
+	$options{$section}{$opt2} = { 'type' => $type, 'value' => $value };
+}
+
+sub maybe_set($$) {
+	my ($key, $value) = @_;
+	my ($section, $opt) = split /\//, $key;
+	my ($opt2, $type) = split /:/, $opt;
+	$options{$section}{$opt2} //= { 'type' => $type, 'value' => $value };
+}
+
+sub mand($) {
+	my ($key) = @_;
+	my ($section, $opt) = split /\//, $key;
+	$options{$section}{$opt} = undef;
+}
+
+# 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');
+
+# Section "d": device capabilities
+set('d/ColorDevice:b', 0);
+set('d/DefaultColorSpace:q', 'Gray');
+set('d/FileSystem:b', 0);
+
+sub heading($) {
+	my ($h) = @_;
+	print "\n";
+	print "%* ", "=" x length $h, "\n";
+	print "%* ", $h, "\n";
+	print "%* ", "=" x length $h, "\n";
+	print "\n";
+}
+
+sub emit($) {
+	my ($section) = @_;
+	my $opts = $options{$section};
+	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 fill_missing() {
+	my $model = get('p/ModelName');
+	if (defined $model) {
+		maybe_set('p/Product', "($model)");
+		maybe_set('p/NickName', $model);
+		maybe_set('p/ShortNickName', $model);
+	}
+
+	my $psver = get('p/PSVersion');
+	if (defined($psver) && $psver =~ /\((\d)/) {
+		maybe_set('d/LanguageLevel', $1);
+	}
+}
+
+sub generate() {
+	print "*PPD-Adobe: ", get('f/FormatVersion'), "\n";
+	print "*% PPD file generated by UCW PPD generator\n";
+	fill_missing();
+
+	heading("File version");
+	emit('f');
+
+	heading("Product information");
+	emit('p');
+
+	heading("Device capabilities");
+	emit('d');
+}
+
+42;

ppd/gen-hp

+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use lib ".";
+use PPD;
+
+set('f/FileVersion', '1.0');
+set('f/PCFileName', 'HP4350.PPD');
+
+set('p/Manufacturer', 'HP');
+set('p/ModelName', 'HP LaserJet 4350');
+set('p/PSVersion', '(3010.107) 0');
+
+set('d/Throughput', 35);
+set('d/TTRasterizer:s', 'Type42');
+set('d/VariablePaperSize:b', 1);
+set('d/Protocols:b', 'PJL TBCP');
+
+generate();