2 # extractres: extract resources from PostScript file
4 # Copyright (C) Angus J. C. Duggan 1991-1995
5 # See file LICENSE for details.
7 $prog = ($0 =~ s
=.*/==);
9 %resources = (); # list of resources included
10 %merge = (); # list of resources extracted this time
11 %extn = ("font", ".pfa", "file", ".ps", "procset", ".ps", # resource extns
12 "pattern", ".pat", "form", ".frm", "encoding", ".enc");
13 %type = ("%%BeginFile:", "file", "%%BeginProcSet:", "procset",
14 "%%BeginFont:", "font"); # resource types
18 if (/^-m(erge)?$/) { $merge = 1; }
20 print STDERR
"Usage: $prog [-merge] [file]\n";
28 if (defined($ENV{TMPDIR
})) { # set body file name
29 $body = "$ENV{TMPDIR}/body$$.ps";
34 open(BODY
, $body) && die "Temporary file $body already exists";
35 open(BODY
, ">$body") || die "Can't write file $body";
37 sub filename
{ # make filename for resource in @_
39 foreach (@_) { # sanitise name
40 s/[!()\$\#*&\\\|\`\'\"\~\{\}\[\]\<\>\?]//g;
43 $name =~ s@
.*/@@
; # drop directories
44 die "Filename not found for resource ", join(" ", @_), "\n"
49 $output = STDOUT
; # start writing header out
51 if (/^%%BeginResource:/ || /^%%BeginFont:/ || /^%%BeginProcSet:/) {
52 local($comment, @res) = split(/\s+/); # look at resource type
53 local($type) = defined($type{$comment}) ?
$type{$comment} : shift(@res);
54 local($name) = &filename
(@res, $extn{$type}); # make file name
56 if (!$resources{$name}) {
57 print "%%IncludeResource: $type ", join(" ", @res), "\n";
58 if (!open(RES
, $name)) {
59 open(RES
, ">$name") || die "Can't write file $name";
60 $resources{$name} = $name;
61 $merge{$name} = $merge;
63 } else { # resource already exists
67 } elsif ($merge{$name}) {
68 open(RES
, ">>$name") || die "Can't append to file $name";
70 } else { # resource already included
73 } elsif (/^%%EndResource/ || /^%%EndFont/ || /^%%EndProcSet/) {
74 if (defined $output) {
80 } elsif ((/^%%EndProlog/ || /^%%BeginSetup/ || /^%%Page:/)) {
87 close(BODY
); # close body output file
89 open(BODY
, $body); # reopen body for input
90 while (<BODY
>) { # print it all
95 unlink($body); # dispose of body file