summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/scripts/dosepsbin
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2011-12-05 00:32:12 +0000
committerKarl Berry <karl@freefriends.org>2011-12-05 00:32:12 +0000
commit3a7b521eec26059dd6c8de57c2fd8d4c7763bfa2 (patch)
treee79acffb889da99fc97c4192f4f315d1deb44b3e /Master/texmf-dist/scripts/dosepsbin
parenta3820a32b1f8c604520d9fcf34069b4e0a73a89a (diff)
new script dosepsbin (11nov11)
git-svn-id: svn://tug.org/texlive/trunk@24759 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf-dist/scripts/dosepsbin')
-rwxr-xr-xMaster/texmf-dist/scripts/dosepsbin/dosepsbin.pl441
1 files changed, 441 insertions, 0 deletions
diff --git a/Master/texmf-dist/scripts/dosepsbin/dosepsbin.pl b/Master/texmf-dist/scripts/dosepsbin/dosepsbin.pl
new file mode 100755
index 00000000000..b87bd25af54
--- /dev/null
+++ b/Master/texmf-dist/scripts/dosepsbin/dosepsbin.pl
@@ -0,0 +1,441 @@
+#!/usr/bin/env perl
+#
+use strict;
+$^W=1;
+
+my $prj = 'dosepsbin';
+my $version = '1.0';
+my $date = '2011/11/10';
+my $author = 'Heiko Oberdiek';
+my $copyright = "Copyright 2011 $author";
+
+my $verbose = 0;
+my $quiet = 0;
+my $inputfile = '';
+my $file_eps = '';
+my $file_wmf= '';
+my $file_tiff = '';
+my $buf_size = 0x1000000;
+
+my $title = "\U$prj\E $date v$version, $copyright\n";
+
+sub die_error ($;$) {
+ my $msg = shift;
+ $msg = "\n!!! Error: $msg!\n";
+ if (@_) {
+ my $ref = shift;
+ foreach my $key (sort keys %$ref) {
+ my $value = $$ref{$key};
+ $key =~ s/ /_/g;
+ $key =~ s/^\d+_?//;
+ $msg .= " [$key: $value]\n";
+ }
+ }
+ die $msg;
+}
+
+sub warning ($) {
+ my $msg = shift;
+ print "!!! Warning: $msg!\n";
+}
+
+sub verbose (@) {
+ return unless $verbose;
+ my @msg = @_;
+ print "* @msg\n";
+}
+
+sub verbose_kv ($$) {
+ return unless $verbose;
+ my $key = shift;
+ my $value = shift;
+ $key =~ s/ /_/g;
+ print " [$key: $value]\n";
+}
+
+sub die_usage {
+ my $msg = $_[0];
+ pod2usage(
+ -exitstatus => 2,
+ -msg => "\n==> $msg!\n");
+}
+
+use Getopt::Long;
+use Pod::Usage;
+
+GetOptions(
+ 'verbose' => sub {
+ $verbose = 1;
+ $quiet = 0;
+ },
+ 'quiet' => sub {
+ $quiet = 1;
+ $verbose = 0;
+ },
+ 'help|?' => sub {
+ print $title;
+ pod2usage(1);
+ },
+ 'man' => sub {
+ pod2usage(-exitstatus => 0, -verbose => 2);
+ },
+ 'version' => sub {
+ print "$prj $date v$version\n";
+ exit(0);
+ },
+ 'inputfile=s' => \$inputfile,
+ 'eps-file=s' => \$file_eps,
+ 'wmf-file=s' => \$file_wmf,
+ 'tiff-file=s' => \$file_tiff,
+) or die_usage('Unknown option');
+
+print $title unless $quiet;
+
+verbose_kv 'program name', $0;
+verbose_kv 'osname', $^O;
+verbose_kv 'perl version', $^V ? sprintf('v%vd', $^V) : $];
+
+$inputfile = shift @ARGV if not $inputfile and @ARGV;
+$inputfile or die_error "Missing input file";
+
+# If input file does not exist, try with extension ".eps"
+if (not -f $inputfile) {
+ my $file = "$inputfile.eps";
+ $inputfile = $file if -f $file;
+}
+-f $inputfile or
+ die_error "Input file not found", {
+ 'input file' => $inputfile
+ };
+verbose_kv 'input file', $inputfile;
+
+# Get file size of input file
+my @tmp = stat $inputfile;
+@tmp or die_error "Getting size of Input file `$inputfile' failed";
+my $inputfile_size = $tmp[7];
+$inputfile_size > 30 or
+ die_error "Input file size is too small", {
+ '1 input file' => $inputfile,
+ '2 file size' => $inputfile_size,
+ };
+verbose_kv 'input file size', $inputfile_size;
+
+# Open input file
+open(IN, '<', $inputfile) or # die_error "Input file `$inputfile' not found";
+ die_error "Cannot open input file", {
+ '1 input file' => $inputfile,
+ '2 os error' => $!,
+ };
+binmode(IN);
+
+# Read header
+my $header;
+read IN, $header, 30 or
+ die_error "Reading the header of the input file failed", {
+ 'file' => $inputfile,
+ 'os error' => $!,
+ };
+# Check ASCII PS header
+if ('%!' eq substr $header, 0, 2) {
+ $header =~ m/^(%![A-Za-z0-9\.\- \t]+)/;
+ my $first_line = $1;
+ die_error "Input file seems to be an ASCII PostScript file", {
+ '1 input file' => $inputfile,
+ '2 file header' => $first_line,
+ }
+}
+my ($id,
+ $offset_ps, $length_ps,
+ $offset_wmf, $length_wmf,
+ $offset_tiff, $length_tiff,
+ $checksum) = unpack 'NV6n', $header;
+
+my $id_hex = unpack 'H8', pack 'N', $id;
+$id_hex = "0x\U$id_hex\E";
+verbose_kv 'header id', $id_hex;
+$id eq 0xC5D0D3C6 or
+ die_error "Input file is not a `DOS EPS binary file'", {
+ '1 input file' => $inputfile,
+ '2 file header id' => $id_hex,
+ };
+
+# Check checksum
+if ($checksum == 0xFFFF) {
+ verbose_kv 'checksum', '0xFFFF (ignored)';
+}
+else {
+ my $cs = 0;
+ map { $cs ^= $_ } unpack 'n14', $header;
+ if ($cs != $checksum) {
+ my $cs_hex = unpack 'H4', pack 'n', $cs;
+ $cs_hex = "0x\U$cs_hex\E";
+ my $cs_found = unpack 'H4', pack 'n', $checksum;
+ $cs_found = "0x\U$cs_found\E";
+ die_error "Checksum mismatch", {
+ '1 input file' => $inputfile,
+ '2 checksum found' => $cs_found,
+ '3 checksum expected' => $cs_hex,
+ };
+ }
+}
+
+verbose_kv 'offset of PS section', $offset_ps;
+verbose_kv 'length of PS section', $length_ps;
+verbose_kv 'offset of WMF section', $offset_wmf;
+verbose_kv 'length of WMF section', $length_wmf;
+verbose_kv 'offset of TIFF section', $offset_tiff;
+verbose_kv 'length of TIFF section', $length_tiff;
+
+{
+ my %check_positions;
+ sub check_section ($$$) {
+ my $type = shift;
+ my $ref_off = shift;
+ my $ref_len = shift;
+ if ($$ref_off == 0 and $$ref_len == 0) {
+ print "--> $type section is not available.\n" unless $quiet;
+ return '<not present>';
+ }
+ $$ref_off >= 32 and $$ref_off < $inputfile_size or
+ die_error "Invalid offset of PS section", {
+ '1 input file' => $inputfile,
+ "2 offset of $type section" => $$ref_off,
+ "3 length of $type section" => $$ref_len,
+ };
+ $$ref_len >= 0 and $$ref_off + $$ref_len <= $inputfile_size or
+ die_error "Invalid length of PS section", {
+ '1 input file' => $inputfile,
+ "2 offset of $type section" => $$ref_off,
+ "3 length of $type section" => $$ref_len,
+ };
+ $check_positions{$$ref_off} = $$ref_off + $$ref_len;
+ print "--> $type section with $$ref_len bytes.\n" unless $quiet;
+ return sprintf '%d..%d', $$ref_off, $$ref_off + $$ref_len - 1;
+ }
+ my $sec_ps = check_section 'PS', \$offset_ps, \$length_ps;
+ verbose_kv 'position of PS section', $sec_ps;
+ my $sec_wmf = check_section 'WMF', \$offset_wmf, \$length_wmf;
+ verbose_kv 'position of WMF section', $sec_wmf;
+ my $sec_tiff = check_section 'TIFF', \$offset_tiff, \$length_tiff;
+ verbose_kv 'position of TIFF section', $sec_tiff;
+ my $pos = 30;
+ foreach my $beg (sort keys %check_positions) {
+ $check_positions{$beg} >= $pos or
+ die_error "Section overlap detected", {
+ '1 input file' => $inputfile,
+ '2 position of header' => "0..29",
+ '3 position of PS section' => $sec_ps,
+ '4 position of WMF section' => $sec_wmf,
+ '5 position of TIFF section' => $sec_tiff,
+ };
+ }
+}
+
+sub write_file ($$$$) {
+ my $type = shift;
+ my $file = shift;
+ my $off = shift;
+ my $len = shift;
+ my $org_len = $len;
+ return unless $file;
+ verbose_kv "$type file", $file;
+ if ($off <= 0 or $len <= 0) {
+ warning "No $type section found";
+ return;
+ }
+ my $position = $off;
+ seek IN, $off, 0 or
+ die_error "Moving to $type section offset failed", {
+ '1 input file' => $inputfile,
+ '2 position' => $off,
+ '3 os error' => $!,
+ };
+ open(OUT, '>', $file) or
+ die_error "Opening $type file for writing failed", {
+ "1 $type file" => $file,
+ '2 os error' => $!,
+ };
+ binmode(OUT);
+ while ($len > 0) {
+ my $read_len = ($len > $buf_size) ? $buf_size : $len;
+ my $buf;
+ my $read_count = read IN, $buf, $read_len;
+ $read_count > 0 or
+ die_error "Reading file failed", {
+ '1 input file' => $inputfile,
+ "2 $type file" => $file,
+ '3 offset' => $position,
+ '4 length' => $read_len,
+ '5 os error' => $!,
+ };
+ $position += $read_count;
+ print OUT $buf or
+ die_error "Writing $type file failed", {
+ "1 $type file" => $file,
+ '2 offset' => $org_len - $len,
+ '3 length' => $read_count,
+ '4 os error' => $!,
+ };
+ $len -= $read_count;
+ }
+ close(OUT);
+ print "==> $type file written: [$file]\n" unless $quiet;
+}
+
+write_file 'TIFF', $file_tiff, $offset_tiff, $length_tiff;
+write_file 'WMF', $file_wmf, $offset_wmf, $length_wmf;
+write_file 'EPS', $file_eps, $offset_ps, $length_ps;
+
+close(IN);
+
+1;
+
+__DATA__
+
+=head1 NAME
+
+dosepsbin -- Extract PS/WMF/TIFF sections from DOS EPS binary files
+
+=head1 VERSION
+
+2011-11-10 v1.0
+
+=head1 SYNOPSIS
+
+The progam B<dosepsbin> analyses an EPS file that is not
+a plain ASCII PostScript file but given as DOS EPS binary file.
+
+ dosepsbin [options] <input file>
+
+First it analyzes the I<input file>, validates its header
+and summarizes the available sections. Depending on the
+given options, the sections are then written to files.
+
+Options:
+
+ --eps-file <file> Write PS section to <file>.
+ --wmf-file <file> Write WMF section to <file>.
+ --tiff-file <file> Write WMF section to <file>.
+ --inputfile <file> The name of the input file.
+ --verbose Verbose output.
+ --quiet Only errors and warnings are printed.
+ --help Brief help message.
+ --man Full documentation.
+ --version Print version identification.
+
+The files for output must be different from the input file.
+
+=head1 DESCRIPTION
+
+=head2 DOS EPS Binary File Format
+
+A Encapsulated PostScript (EPS) file can also given in a special
+binary format to support the inclusion of a thumbnail. The file
+format starts with a binary header that contains the positions of
+the possible sections:
+
+=over
+
+=item * Postscript (PS)
+
+=item * Windows Metafile Format (WMF)
+
+=item * Tag Image File Format (TIFF)
+
+=back
+
+The PS section must be present and either the WMF file or the TIFF
+file should be given.
+
+=head1 OPTIONS
+
+=over
+
+=item B<->B<-eps-file>=<I<file>>
+
+The PS section is written to <I<file>>. The output file must
+be different from the input file.
+
+=item B<->B<-wmf-file>=<I<file>>
+
+The WMF section is written to <I<file>> if present. The output
+file must be different from the input file.
+
+=item B<->B<-tiff-file>=<I<file>>
+
+The TIFF section is written to <I<file>> if present. The output
+file must be different from the input file.
+
+=item B<->B<-inputfile>=<I<file>>
+
+The input file can also be given directly on the command line.
+If the file does not exist, then the file with extension `.eps'
+is tried.
+
+=item B<->B<-verbose>
+
+Verbose messages.
+
+=item B<->B<-quiet>
+
+No messages are printed except for errors and warnings.
+
+=item B<->B<-help>
+
+Display help screen.
+
+=item B<->B<-man>
+
+Prints manual page.
+
+=item B<->B<-version>
+
+Print version identification and exit.
+
+=back
+
+=head1 EXAMPLES
+
+The following command extracts the PS section from file F<test.eps>
+and stores the result in file F<test-ps.eps>:
+
+ dosepsbin --eps-file test-ps.eps test.eps
+
+=head1 AUTHOR
+
+Heiko Oberdiek, email: heiko.oberdiek at googlemail.com
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2011 by Heiko Oberdiek.
+
+This library is free software; you may redistribute it and/or
+modify it under the same terms as Perl itself
+(Perl Artistic License/GNU General Public License, version 2).
+
+=head1 SEE ALSO
+
+The DOS EPS binary file format is described
+in section "5.2 Windows Metafile or TIFF":
+
+ Adobe Developer Support,
+ Encapsulated PostScript File Format Specification,
+ Version 3.0,
+ 1992-05-01,
+ http://partners.adobe.com/public/developer/en/ps/5002.EPSF_Spec.pdf
+
+=head1 HISTORY
+
+=over 2
+
+=item B<2011/11/10 v1.0>
+
+=over 2
+
+=item * First version.
+
+=back
+
+=back
+
+=cut