diff options
Diffstat (limited to 'Master/texmf-dist/doc/generic/pst-geo/pst-geo-decompress.pl')
| -rw-r--r-- | Master/texmf-dist/doc/generic/pst-geo/pst-geo-decompress.pl | 120 |
1 files changed, 120 insertions, 0 deletions
diff --git a/Master/texmf-dist/doc/generic/pst-geo/pst-geo-decompress.pl b/Master/texmf-dist/doc/generic/pst-geo/pst-geo-decompress.pl new file mode 100644 index 00000000000..38574176ce4 --- /dev/null +++ b/Master/texmf-dist/doc/generic/pst-geo/pst-geo-decompress.pl @@ -0,0 +1,120 @@ +#!/usr/bin/env perl +use strict; +$^W=1; +# pst-geo-uncompress.pl +# Copyright (C) 2009 Heiko Oberdiek. +# +# This work may be distributed and/or modified under the +# conditions of the LaTeX Project Public License, either version 1.3 +# of this license or (at your option) any later version. +# The latest version of this license is in +# http://www.latex-project.org/lppl.txt +# and version 1.3 or later is part of all distributions of LaTeX +# version 2005/12/01 or later. +# +# This work has the LPPL maintenance status `maintained'. +# +# The Current Maintainer of this work is Heiko Oberdiek. +# +# See file "README" for a list of files that belong to this project. +my $file = "pst-geo-uncompress.pl"; +my $program = uc($&) if $file =~ /^\w+/; +my $version = "1.0"; +my $date = "2009/07/30"; +my $author = "Heiko Oberdiek"; +my $copyright = "Copyright (c) 2009 by $author."; +# History: +# 2009/07/30 v1.0: First release. +my $title = "$program $version, $date - $copyright\n"; +print STDERR $title; +my $prg_gs = "gs"; +$prg_gs = "gs386" if $^O =~ /dos/i; +$prg_gs = "gsos2" if $^O =~ /os2/i; +$prg_gs = "gswin32c" if $^O =~ /mswin32/i; +$prg_gs = "gswin32c" if $^O =~ /cygwin/i; +$prg_gs = "mgs" if defined($ENV{"TEXSYSTEM"}) and + $ENV{"TEXSYSTEM"} =~ /miktex/i; + +$::opt_help = 0; + +my $usage = <<"END_OF_USAGE"; +Function: Compresses data files for pst-geo +Syntax: $0 <input file> [output file] +If the output file is not given, standard output is used. +Options: (defaults:) + --help print usage + --gscmd <name> call of ghostscript ($prg_gs) +END_OF_USAGE +use Getopt::Long; +GetOptions( + "help!", + "gscmd=s" => \$prg_gs +) or die $usage; +!$::opt_help or die $usage; + +(@ARGV == 1 or @ARGV == 2) or die $usage; + +my $input = $ARGV[0]; +my $output = $ARGV[1]; + +open(IN, '<', $input) or die "!!! Error: Cannot open file `$input'!\n"; +my $header = <IN> . <IN>; +$header =~ /^%!PS\s+(.*)currentfile((<<[^>]+>>)?\/[\w\d]+ filter) cvx exec\s*$/s + or die "!!! Error: Unknown file format of `$input'!\n"; +my $decode = $2; +my $pos = tell(IN); +my $ps_input = unpack 'H*', $input; +my $ps_output = ''; +my $ps_output = unpack 'H*', $output if $output; + +my $ps_code = <<"END_PS_CODE"; +%!PS +/buf 10000 string def +<$ps_input> (r) file +dup $pos setfileposition +$decode +END_PS_CODE +$ps_code .= <<"END_PS_CODE" if $output; +<$ps_output> (w) file +exch +END_PS_CODE +$ps_code .= <<"END_PS_CODE"; +{ dup buf readstring exch +END_PS_CODE +$ps_code .= <<"END_PS_CODE" unless $output; + print +END_PS_CODE +$ps_code .= <<"END_PS_CODE" if $output; + 3 index exch writestring +END_PS_CODE +$ps_code .= <<"END_PS_CODE"; + not {exit} if +} loop +closefile +END_PS_CODE +$ps_code .= <<"END_PS_CODE" if $output; +closefile +END_PS_CODE +$ps_code .= <<"END_PS_CODE"; +quit +%%EOF +END_PS_CODE +my @cmd = ( + $prg_gs, + '-q', + '-sDEVICE=nullpage', + '-dBATCH', + '-c', + $ps_code +); +system @cmd; +if ($? & 127) { + die sprintf "!!! Error: Ghostscript died with signal %d!\n", + ($? & 127); +} +elsif ($? != 0) { + die sprintf "!!! Error: Ghostscript exited with error code %d!\n", + $? >> 8; +} +print STDERR "* `$output' written.\n" if $output; +__END__ |