summaryrefslogtreecommitdiff
path: root/support/psrip/psrip
blob: 9fa00fc108550079e97c9736a94ba9dd4fb0309a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
#!/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";