1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
#! /usr/bin/perl
use strict;
# runs groff in safe mode, that seems to be the default
# installation now. That means that I have to fix all nice
# features outside groff. Sigh.
# I do agree however that the previous way opened a whole bunch
# of security holes.
my $no_exec;
# check for -x and remove it
if (grep(/^-x$/, @ARGV)) {
$no_exec++;
@ARGV = grep(!/^-x$/, @ARGV);
}
# mmroff should always have -mm, but not twice
@ARGV = grep(!/^-mm$/, @ARGV);
my $check_macro = "groff -rRef=1 -z -mm @ARGV";
my $run_macro = "groff -mm @ARGV";
my (%cur, $rfilename, $max_height, $imacro, $max_width, @out, @indi);
open(MACRO, "$check_macro 2>&1 |") || die "run $check_macro:$!";
while(<MACRO>) {
if (m#^\.\\" Rfilename: (\S+)#) {
# remove all directories just to be more secure
($rfilename = $1) =~ s#.*/##;
next;
}
if (m#^\.\\" Imacro: (\S+)#) {
# remove all directories just to be more secure
($imacro = $1) =~ s#.*/##;
next;
}
if (m#^\.\\" Index: (\S+)#) {
# remove all directories just to be more secure
my $f;
($f = $1) =~ s#.*/##;
&print_index($f, \@indi, $imacro);
@indi = ();
$imacro = '';
next;
}
my $x;
if (($x) = m#^\.\\" IND (.+)#) {
$x =~ s#\\##g;
my @x = split(/\t/, $x);
grep(s/\s+$//, @x);
push(@indi, join("\t", @x));
next;
}
if (m#^\.\\" PIC id (\d+)#) {
%cur = ('id', $1);
next;
}
if (m#^\.\\" PIC file (\S+)#) {
&psbb($1);
&ps_calc($1);
next;
}
if (m#^\.\\" PIC (\w+)\s+(\S+)#) {
eval "\$cur{'$1'} = '$2'";
next;
}
s#\\ \\ $##;
push(@out, $_);
}
close(MACRO);
if ($rfilename) {
push(@out, ".nr pict*max-height $max_height\n") if defined $max_height;
push(@out, ".nr pict*max-width $max_width\n") if defined $max_width;
open(OUT, ">$rfilename") || "create $rfilename:$!";
print OUT '.\" references', "\n";
my $i;
for $i (@out) {
print OUT $i;
}
close(OUT);
}
exit 0 if $no_exec;
exit system($run_macro);
sub print_index {
my ($f, $ind, $macro) = @_;
open(OUT, ">$f") || "create $f:$!";
my $i;
for $i (sort @$ind) {
if ($macro) {
$i = '.'.$macro.' "'.join('" "', split(/\t/, $i)).'"';
}
print OUT "$i\n";
}
close(OUT);
}
sub ps_calc {
my ($f) = @_;
my $w = abs($cur{'llx'}-$cur{'urx'});
my $h = abs($cur{'lly'}-$cur{'ury'});
$max_width = $w if $w > $max_width;
$max_height = $h if $h > $max_height;
my $id = $cur{'id'};
push(@out, ".ds pict*file!$id $f\n");
push(@out, ".ds pict*id!$f $id\n");
push(@out, ".nr pict*llx!$id $cur{'llx'}\n");
push(@out, ".nr pict*lly!$id $cur{'lly'}\n");
push(@out, ".nr pict*urx!$id $cur{'urx'}\n");
push(@out, ".nr pict*ury!$id $cur{'ury'}\n");
push(@out, ".nr pict*w!$id $w\n");
push(@out, ".nr pict*h!$id $h\n");
}
sub psbb {
my ($f) = @_;
unless (open(IN, $f)) {
print STDERR "Warning: Postscript file $f:$!";
next;
}
while(<IN>) {
if (/^%%BoundingBox:\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/) {
$cur{'llx'} = $1;
$cur{'lly'} = $2;
$cur{'urx'} = $3;
$cur{'ury'} = $4;
}
}
close(IN);
}
|
