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