contrib/mm/mmroff.pl

   1 #! /usr/bin/perl
   2 # -*- Perl -*-
   3 # Copyright (C) 1989-2014  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
  20 use 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
  27 my $no_exec;
  28 # check for -x and remove it
  29 if (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);
  36 my $check_macro = "groff -rRef=1 -z -mm @ARGV";
  37 my $run_macro = "groff -mm @ARGV";
  38
  39 my (%cur, $rfilename, $max_height, $imacro, $max_width, @out, @indi);
  40 open(MACRO, "$check_macro 2>&1 |") || die "run $check_macro:$!";
  41 while(<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 }
  85 close(MACRO);
  86
  87
  88 if ($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
 101 exit 0 if $no_exec;
 102 exit system($run_macro);
 103
 104 sub 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
 118 sub 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
 138 sub 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
 157 1;
 158 ########################################################################
 159 ### Emacs settings
 160 # Local Variables:
 161 # mode: CPerl
 162 # End: