/contrib/groff/contrib/mm/mmroff.pl

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