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

https://bitbucket.org/freebsd/freebsd-head/ · Perl · 137 lines · 110 code · 16 blank · 11 comment · 21 complexity · ecde707a8b0103d949d25104853df67d MD5 · raw file

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