FS/FS/Misc/eps2png.pm

   1 package FS::Misc::eps2png;
   2
   3 #based on eps2png by Johan Vromans
   4 #Copyright 1994,2008 by Johan Vromans.
   5 #This program is free software; you can redistribute it and/or
   6 #modify it under the terms of the Perl Artistic License or the
   7 #GNU General Public License as published by the Free Software
   8 #Foundation; either version 2 of the License, or (at your option) any
   9 #later version.
  10
  11 use strict;
  12 use vars qw( @ISA @EXPORT_OK );
  13 use Exporter;
  14 use File::Temp;
  15 use File::Slurp qw( slurp );
  16 #use FS::UID;
  17
  18 @ISA = qw( Exporter );
  19 @EXPORT_OK = qw( eps2png );
  20
  21 ################ Program parameters ################
  22
  23 # Some GhostScript programs can produce GIF directly.
  24 # If not, we need the PBM package for the conversion.
  25 # NOTE: This will be changed upon install.
  26 my $use_pbm = 0;
  27
  28 my $res = 82;                   # default resolution
  29 my $scale = 1;                  # default scaling
  30 my $mono = 0;                   # produce BW images if non-zero
  31 my $format;                     # output format
  32 my $gs_format;                  # GS output type
  33 my $output;                     # output, defaults to STDOUT
  34 my $antialias = 4;              # antialiasing
  35 my $DEF_width;                  # desired widht
  36 my $DEF_height;         # desired height
  37 #my $DEF_width = 90;                    # desired widht
  38 #my $DEF_height = 36;           # desired height
  39
  40 my ($verbose,$trace,$test,$debug) = (0,0,0,0);
  41 #handle_options ();
  42 set_out_type ('png'); # unless defined $format;
  43 warn "Producing $format ($gs_format) image.\n" if $verbose;
  44
  45 $trace |= $test | $debug;
  46 $verbose |= $trace;
  47
  48 ################ Presets ################
  49
  50 ################ The Process ################
  51
  52 my $err = 0;
  53
  54 sub eps2png {
  55     my( $eps, %options ) = @_; #well, no options yet
  56
  57     my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
  58     my $eps_file = new File::Temp( TEMPLATE => 'image.XXXXXXXX',
  59                                    DIR      => $dir,
  60                                    SUFFIX   => '.eps',
  61                                    #UNLINK   => 0,
  62                                  ) or die "can't open temp file: $!\n";
  63     print $eps_file $eps;
  64     close $eps_file;
  65
  66     my @eps = split(/\r?\n/, $eps);
  67
  68     warn "converting eps (". length($eps). " bytes, ". scalar(@eps). " lines)\n"
  69       if $verbose;
  70
  71     my $line = shift @eps; #<EPS>;
  72     unless ( $eps =~ /^%!PS-Adobe.*EPSF-/ ) {
  73         warn "not EPS file (no %!PS-Adobe header)\n";
  74         return; #empty png file?
  75     }
  76
  77     my $ps = "";                # PostScript input data
  78     my $xscale;
  79     my $yscale;
  80     my $gotbb;
  81
  82     # Prevent derived values from propagating.
  83     my $width = $DEF_width;
  84     my $height = $DEF_height;
  85
  86     while ( @eps ) {
  87
  88         $line = shift(@eps)."\n";
  89
  90         # Search for BoundingBox.
  91         if ( $line =~ /^%%BoundingBox:\s*(\S+)\s+(\S+)\s+(\S+)\s+(\S+)/i ) {
  92             $gotbb++;
  93             warn "$eps_file: x0=$1, y0=$2, w=", $3-$1, ", h=", $4-$2
  94                 if $verbose;
  95
  96             if ( defined $width ) {
  97                 $res = 72;
  98                 $xscale = $width / ($3 - $1);
  99                 if ( defined $height ) {
 100                     $yscale = $height / ($4 - $2);
 101                 }
 102                 else {
 103                     $yscale = $xscale;
 104                     $height = ($4 - $2) * $yscale;
 105                 }
 106             }
 107             elsif ( defined $height ) {
 108                 $res = 72;
 109                 $yscale = $height / ($4 - $2);
 110                 if ( defined $width ) {
 111                     $xscale = $width / ($3 - $1);
 112                 }
 113                 else {
 114                     $xscale = $yscale;
 115                     $width = ($3 - $1) * $xscale;
 116                 }
 117             }
 118             unless ( defined $xscale ) {
 119                 $xscale = $yscale = $scale;
 120                 # Calculate actual width.
 121                 $width  = $3 - $1;
 122                 $height = $4 - $2;
 123                 # Normal PostScript resolution is 72.
 124                 $width  *= $res/72 * $xscale;
 125                 $height *= $res/72 * $yscale;
 126                 # Round up.
 127                 $width  = int ($width + 0.5) + 1;
 128                 $height = int ($height + 0.5) + 1;
 129             }
 130             warn ", width=$width, height=$height\n" if $verbose;
 131
 132             # Scale.
 133             $ps .= "$xscale $yscale scale\n"
 134               if $xscale != 1 || $yscale != 1;
 135
 136             # Create PostScript code to translate coordinates.
 137             $ps .= (0-$1) . " " . (0-$2) . " translate\n"
 138               unless $1 == 0 && $2 == 0;
 139
 140             # Include the image, show and quit.
 141             $ps .= "($eps_file) run\n".
 142               "showpage\n".
 143                 "quit\n";
 144
 145             last;
 146         }
 147         elsif ( $line =~ /^%%EndComments/i ) {
 148             last;
 149         }
 150     }
 151
 152     unless ( $gotbb ) {
 153         warn "No bounding box in $eps_file\n";
 154         return;
 155     }
 156
 157     #it would be better to ask gs to spit out files on stdout, but c'est la vie
 158
 159     #my $out_file;              # output file
 160     #my $pbm_file;              # temporary file for PBM conversion
 161
 162     my $out_file = new File::Temp( TEMPLATE => 'image.XXXXXXXX',
 163                                    DIR      => $dir,
 164                                    SUFFIX   => '.png',
 165                                    #UNLINK   => 0,
 166                                  ) or die "can't open temp file: $!\n";
 167
 168     my $pbm_file = new File::Temp( TEMPLATE => 'image.XXXXXXXX',
 169                                    DIR      => $dir,
 170                                    SUFFIX   => '.pbm',
 171                                    #UNLINK   => 0,
 172                                  ) or die "can't open temp file: $!\n";
 173
 174     # Note the temporary PBM file is created where the output file is
 175     # located, since that will guarantee accessibility (and a valid
 176     # filename).
 177     warn "Creating $out_file\n" if $verbose;
 178
 179     my $gs0 = "gs -q -dNOPAUSE -r$res -g${width}x$height";
 180     my $gs1 = "-";
 181     $gs0 .= " -dTextAlphaBits=$antialias -dGraphicsAlphaBits=$antialias"
 182       if $antialias;
 183     if ( $format eq 'png' ) {
 184         mysystem ("$gs0 -sDEVICE=". ($mono ? "pngmono" : $gs_format).
 185                   " -sOutputFile=$out_file $gs1", $ps);
 186     }
 187     elsif ( $format eq 'jpg' ) {
 188         mysystem ("$gs0 -sDEVICE=". ($mono ? "jpeggray" : $gs_format).
 189                   " -sOutputFile=$out_file $gs1", $ps);
 190     }
 191     elsif ( $format eq 'gif' ) {
 192         if ( $use_pbm ) {
 193             # Convert to PPM and use some of the PBM converters.
 194             mysystem ("$gs0 -sDEVICE=". ($mono ? "pbm" : "ppm").
 195                       " -sOutputFile=$pbm_file $gs1", $ps);
 196             # mysystem ("pnmcrop $pbm_file | ppmtogif > $out_file");
 197             mysystem ("ppmtogif $pbm_file > $out_file");
 198             unlink ($pbm_file);
 199         }
 200         else {
 201             # GhostScript has GIF drivers built-in.
 202             mysystem ("$gs0 -sDEVICE=". ($mono ? "gifmono" : "gif8").
 203                       " -sOutputFile=$out_file $gs1", $ps);
 204         }
 205     }
 206     else {
 207         warn "ASSERT ERROR: Unhandled output type: $format\n";
 208         exit (1);
 209     }
 210
 211 #    unless ( -s $out_file ) {
 212 #       warn "Problem creating $out_file for $eps_file\n";
 213 #       $err++;
 214 #    }
 215
 216     slurp($out_file);
 217
 218 }
 219
 220 exit 1 if $err;
 221
 222 ################ Subroutines ################
 223
 224 sub mysystem {
 225     my ($cmd, $data) = @_;
 226     warn "+ $cmd\n" if $trace;
 227     if ( $data ) {
 228         if ( $trace ) {
 229             my $dp = ">> " . $data;
 230             $dp =~ s/\n(.)/\n>> $1/g;
 231             warn "$dp";
 232         }
 233         open (CMD, "|$cmd") or die ("$cmd: $!\n");
 234         print CMD $data;
 235         close CMD or die ("$cmd close: $!\n");
 236     }
 237     else {
 238         system ($cmd);
 239     }
 240 }
 241
 242 sub set_out_type {
 243     my ($opt) = lc (shift (@_));
 244     if ( $opt =~ /^png(mono|gray|16|256|16m|alpha)?$/ ) {
 245         $format = 'png';
 246         $gs_format = $format.(defined $1 ? $1 : '16m');
 247     }
 248     elsif ( $opt =~ /^gif(mono)?$/ ) {
 249         $format = 'gif';
 250         $gs_format = $format.(defined $1 ? $1 : '');
 251     }
 252     elsif ( $opt =~ /^(jpg|jpeg)(gray)?$/ ) {
 253         $format = 'jpg';
 254         $gs_format = 'jpeg'.(defined $2 ? $2 : '');
 255     }
 256     else {
 257         warn "ASSERT ERROR: Invalid value to set_out_type: $opt\n";
 258         exit (1);
 259     }
 260 }
 261
 262 #                            'antialias|aa=i'   => \$antialias,
 263 #                            'noantialias|noaa' => sub { $antialias = 0 },
 264 #                            'scale=f'     => \$scale,
 265 #                            'width=i'     => \$width,
 266 #                            'height=i'    => \$height,
 267 #                            'resolution=i' => \$res,
 268
 269 #    die ("Antialias value must be 0, 1, 2, 4, or 8\n")
 270
 271 #    -width XXX         desired with
 272 #    -height XXX                desired height
 273 #    -resolution XXX    resolution (default = $res)
 274 #    -scale XXX         scaling factor
 275 #    -antialias XX      antialias factor (must be 0, 1, 2, 4 or 8; default: 4)
 276 #    -noantialias       no antialiasing (same as -antialias 0)
 277
 278 1;