contrib/mm/mmroff.pl

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