#!/usr/bin/perl -w 
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version. 
#
# Author : Christian Lackas (delta@clackas.de)
# Webpage: http://www.clackas.de/html/perl.html
# CTAN   : http://www.dante.de/tex-archive/support/psrip/
# Version: 1.3

=head1 NAME

psrip - extracts images from postscript-files

=head1 SYNOPSIS

psrip [B<-d> I<dir>] I<psfile(s)>

extract images in I<psfile(s)> into current directory
or I<dir> if given.

=head2 Examples

psrip foil.ps
  Extract images from foil.ps into current directory.

psrip B<-d> images foil1.ps foil2.ps TeX/*.ps
  Extract images of these ps-files into directory I<images>.

=head1 DESCRIPTION

The script saves the lines between I<'%%BeginDocument: name'>
and I<'%%EndDocument'> to a new file named I<dir/name>.

=head1 BUGS

If there is no 'BoundingBox' specified in the extracted image you
have to insert it by hand. E.g. for DIN-a4 size:
 %%BoundingBox: 0 0 596 842

=head1 AUTHOR

Christian Lackas <F<delta@clackas.de>>, 10 December 1999.

This tool is dedicated to Nikolay 'Snake' Sturm.

Thanks to Rolf Niepraschk for his help in publishing an bug 
reporting.


=head1 LICENSE

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version. 

=cut

use strict;
my ($dir,$count,$verb) = qw(. 0);

print 'psrip v1.3 by Christian Lackas (delta@clackas.de, http://www.clackas.de)',"\n";

unless (@ARGV) {  
  print STDERR<<EOTEXT;
Usage  : psrip [-d dir] psfile(s)
  extracts images from postscriptfiles and saves them in
  the current directory or <dir> if given.
Example: psrip -d images skript1.ps skript2.ps
EOTEXT
  exit
}

if ($ARGV[0] eq '-d') {
	shift; $dir = shift;
	unless (-d $dir) {die "Cannot find directory '$dir'.\n"}
	print "Saving images to directory '$dir'.\n"
}

while (@ARGV) {
  my $file = shift;
  open FILE, $file or warn "Cannot open $file: $!\n" and next;
  print "Checking $file.\n";
  my $bb;
  while (<FILE>) {    
#    $bb = $_ if /^%%BoundingBox:/;
    if (/^%%BeginDocument: (.*\.(ps|eps|fig))/) {
      my $name = $1;
      $name =~ s!/!_!g;
      print "  Found image '$name'.\n";
      $name = "$dir/$name";
      if (-e "$name") {print "    File '$name' exists (skipping).\n"} else {
        open(OUT,">$name") || die "Cannot open $name: $!\n";
        ++$count; $_=<FILE>; print OUT;
        print OUT '%%psrip: (c) delta@clackas.de, http://www.clackas.de/',"\n";
        print OUT "%%psrip: borrowed from $file on ",scalar localtime,"\n";
#	print OUT $bb if defined $bb;
        while (<FILE>) {
          last if /^%%EndDocument/;
          print OUT;
        }  
        close(OUT);
       }	
    }
  }
  close(FILE);
}
print "Finished ($count images extracted)\n";