src/devices/gropdf/pdfmom.pl

   1 #!@PERL@ -w
   2 #
   3 #       pdfmom          : Frontend to run groff -mom to produce PDFs
   4 #       Deri James      : Friday 16 Mar 2012
   5 #
   6
   7 # Copyright (C) 2012-2014
   8 #      Free Software Foundation, Inc.
   9 #      Written by Deri James <deri@chuzzlewit.demon.co.uk>
  10 #
  11 # This file is part of groff.
  12 #
  13 # groff is free software; you can redistribute it and/or modify it under
  14 # the terms of the GNU General Public License as published by the Free
  15 # Software Foundation, either version 3 of the License, or
  16 # (at your option) any later version.
  17 #
  18 # groff is distributed in the hope that it will be useful, but WITHOUT ANY
  19 # WARRANTY; without even the implied warranty of MERCHANTABILITY or
  20 # FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  21 # for more details.
  22 #
  23 # You should have received a copy of the GNU General Public License
  24 # along with this program. If not, see <http://www.gnu.org/licenses/>.
  25
  26 use strict;
  27 use File::Temp qw/tempfile/;
  28 my @cmd;
  29 my $dev='pdf';
  30 my $preconv='';
  31 my $readstdin=1;
  32
  33 $ENV{PATH}=$ENV{GROFF_BIN_PATH}.':'.$ENV{PATH} if exists($ENV{GROFF_BIN_PATH});
  34 $ENV{TMPDIR}=$ENV{GROFF_TMPDIR} if exists($ENV{GROFF_TMPDIR});
  35
  36 while (my $c=shift)
  37 {
  38     $c=~s/(?<!\\)"/\\"/g;
  39
  40     if (substr($c,0,2) eq '-T')
  41     {
  42         if (length($c) > 2)
  43         {
  44             $dev=substr($c,2);
  45         }
  46         else
  47         {
  48             $dev=shift;
  49         }
  50         next;
  51     }
  52     elsif (substr($c,0,2) eq '-K')
  53     {
  54         if (length($c) > 2)
  55         {
  56             $preconv=$c;
  57         }
  58         else
  59         {
  60             $preconv=$c;
  61             $preconv.=shift;
  62         }
  63         next;
  64     }
  65     elsif (substr($c,0,2) eq '-k')
  66     {
  67         $preconv=$c;
  68         next;
  69     }
  70     elsif ($c eq '-z' or $c eq '-Z')
  71     {
  72         $dev=$c;
  73         next;
  74     }
  75     elsif ($c eq '-v')
  76     {
  77         print "GNU pdfmom (groff) version @VERSION@\n";
  78         exit;
  79     }
  80     elsif (substr($c,0,1) eq '-')
  81     {
  82         if (length($c) > 1)
  83         {
  84             push(@cmd,"\"$c\"");
  85             push(@cmd,"'".(shift)."'") if length($c)==2 and index('dDfFIKLmMnoPrwW',substr($c,-1)) >= 0;
  86         }
  87         else
  88         {
  89             # Just a '-'
  90
  91             push(@cmd,$c);
  92             $readstdin=2;
  93         }
  94     }
  95     else
  96     {
  97         # Got a filename?
  98
  99         push(@cmd,"\"$c\"");
 100         $readstdin=0 if $readstdin == 1;
 101
 102     }
 103
 104 }
 105
 106 my $cmdstring=' '.join(' ',@cmd).' ';
 107
 108 if ($readstdin)
 109 {
 110     my ($fh,$tmpfn)=tempfile('pdfmom-XXXXX', UNLINK=>1);
 111
 112     while (<STDIN>)
 113     {
 114         print $fh ($_);
 115     }
 116
 117     close($fh);
 118
 119     $cmdstring=~s/ - / $tmpfn / if $readstdin == 2;
 120     $cmdstring.=" $tmpfn " if $readstdin == 1;
 121 }
 122
 123 if ($dev eq 'pdf')
 124 {
 125     system("groff -Tpdf -dPDF.EXPORT=1 -mom -z $cmdstring 2>&1 | grep '^\.ds' | groff -Tpdf -mom - $preconv $cmdstring");
 126 }
 127 elsif ($dev eq 'ps')
 128 {
 129     system("pdfroff -mpdfmark -mom --no-toc $cmdstring");
 130 }
 131 elsif ($dev eq '-z') # pseudo dev - just compile for warnings
 132 {
 133     system("groff -Tpdf -mom -z $cmdstring");
 134 }
 135 elsif ($dev eq '-Z') # pseudo dev - produce troff output
 136 {
 137     system("groff -Tpdf -mom -Z $cmdstring");
 138 }
 139 else
 140 {
 141     print STDERR "Not compatible with device '-T $dev'\n";
 142     exit 1;
 143 }
 144