1#! /usr/bin/perl
2# -*- Perl -*-
3# Copyright (C) 1989-2018 Free Software Foundation, Inc.
4#
5# This file is part of groff.
6#
7# groff is free software; you can redistribute it and/or modify it under
8# the terms of the GNU General Public License as published by the Free
9# Software Foundation, either version 3 of the License, or
10# (at your option) any later version.
11#
12# groff is distributed in the hope that it will be useful, but WITHOUT ANY
13# WARRANTY; without even the implied warranty of MERCHANTABILITY or
14# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
15# for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with this program.  If not, see <http://www.gnu.org/licenses/>.
19
20use strict;
21# runs groff in safe mode, that seems to be the default
22# installation now. That means that I have to fix all nice
23# features outside groff. Sigh.
24# I do agree however that the previous way opened a whole bunch
25# of security holes.
26
27my $no_exec;
28# check for -x and remove it
29if (grep(/^-x$/, @ARGV)) {
30	$no_exec++;
31	@ARGV = grep(!/^-x$/, @ARGV);
32}
33
34# mmroff should always have -mm, but not twice
35@ARGV = grep(!/^-mm$/, @ARGV);
36my $check_macro = "groff -rRef=1 -z -mm @ARGV";
37my $run_macro = "groff -mm @ARGV";
38
39my (%cur, $rfilename, $max_height, $imacro, $max_width, @out, @indi);
40open(MACRO, "$check_macro 2>&1 |") || die "run $check_macro:$!";
41while(<MACRO>) {
42	if (m#^\.\\" Rfilename: (\S+)#) {
43		# remove all directories just to be more secure
44		($rfilename = $1) =~ s#.*/##;
45		next;
46	}
47	if (m#^\.\\" Imacro: (\S+)#) {
48		# remove all directories just to be more secure
49		($imacro = $1) =~ s#.*/##;
50		next;
51	}
52	if (m#^\.\\" Index: (\S+)#) {
53		# remove all directories just to be more secure
54		my $f;
55		($f = $1) =~ s#.*/##;
56		&print_index($f, \@indi, $imacro);
57		@indi = ();
58		$imacro = '';
59		next;
60	}
61	my $x;
62	if (($x) = m#^\.\\" IND (.+)#) {
63		$x =~ s#\\##g;
64		my @x = split(/\t/, $x);
65		grep(s/\s+$//, @x);
66		push(@indi, join("\t", @x));
67		next;
68	}
69	if (m#^\.\\" PIC id (\d+)#) {
70		%cur = ('id', $1);
71		next;
72	}
73	if (m#^\.\\" PIC file (\S+)#) {
74		&psbb($1);
75		&ps_calc($1);
76		next;
77	}
78	if (m#^\.\\" PIC (\w+)\s+(\S+)#) {
79		eval "\$cur{'$1'} = '$2'";
80		next;
81	}
82	s#\\ \\ $##;
83	push(@out, $_);
84}
85close(MACRO);
86
87
88if ($rfilename) {
89	push(@out, ".nr pict*max-height $max_height\n") if defined $max_height;
90	push(@out, ".nr pict*max-width $max_width\n") if defined $max_width;
91
92	open(OUT, ">$rfilename") || "create $rfilename:$!";
93	print OUT '.\" references', "\n";
94	my $i;
95	for $i (@out) {
96		print OUT $i;
97	}
98	close(OUT);
99}
100
101exit 0 if $no_exec;
102exit system($run_macro);
103
104sub print_index {
105	my ($f, $ind, $macro) = @_;
106
107	open(OUT, ">$f") || "create $f:$!";
108	my $i;
109	for $i (sort @$ind) {
110		if ($macro) {
111			$i = '.'.$macro.' "'.join('" "', split(/\t/, $i)).'"';
112		}
113		print OUT "$i\n";
114	}
115	close(OUT);
116}
117
118sub ps_calc {
119	my ($f) = @_;
120
121	my $w = abs($cur{'llx'}-$cur{'urx'});
122	my $h = abs($cur{'lly'}-$cur{'ury'});
123	$max_width = $w if $w > $max_width;
124	$max_height = $h if $h > $max_height;
125
126	my $id = $cur{'id'};
127	push(@out, ".ds pict*file!$id $f\n");
128	push(@out, ".ds pict*id!$f $id\n");
129	push(@out, ".nr pict*llx!$id $cur{'llx'}\n");
130	push(@out, ".nr pict*lly!$id $cur{'lly'}\n");
131	push(@out, ".nr pict*urx!$id $cur{'urx'}\n");
132	push(@out, ".nr pict*ury!$id $cur{'ury'}\n");
133	push(@out, ".nr pict*w!$id $w\n");
134	push(@out, ".nr pict*h!$id $h\n");
135}
136
137
138sub psbb {
139	my ($f) = @_;
140
141	unless (open(IN, $f)) {
142		print STDERR "Warning: Postscript file $f:$!";
143		next;
144	}
145	while(<IN>) {
146		if (/^%%BoundingBox:\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/) {
147			$cur{'llx'} = $1;
148			$cur{'lly'} = $2;
149			$cur{'urx'} = $3;
150			$cur{'ury'} = $4;
151		}
152	}
153	close(IN);
154}
155
156
1571;
158########################################################################
159### Emacs settings
160# Local Variables:
161# mode: CPerl
162# End:
163