contrib/groff/contrib/mm/mmroff.pl

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