extproc perl -wS
$VERSION = '0.01';

use strict;
use Getopt::Std;
use File::Copy 'copy';

my %opts;
getopts('dhtv', \%opts);

print <<EOP and exit if $opts{h} or not @ARGV;
Fix PDF files generated by misconfigured Distiller 4 for Acrobat 3.0, for
details see http://www.camblab.com/nugget/colorspc.htm

Usage: $0 [-h] [-d] [-c] [-V] pdffile...
 -d            Display debug messages
 -h            Display this message
 -t            Test mode - orginal unchanged
 -v            Display progress messages
 --version     Display version
EOP

my %subst = ( 1 => '/DeviceGray', 3 => '/DeviceRGB', 4 => '/DeviceCMYK');
for my $file (@ARGV) {
  printf "reading `%s', age %.3f days, size %#x\n", $file, -M $file, -s $file
    if $opts{v};
  open IN, $file or die "open '$file': $!";
  binmode IN;
  undef $/;				# Read whole file at once
  my $in = <IN>;			# Read it
  close IN or die "close '$file': $!";

  # Scan and edit colorspace settings: look for "[ /ICCBased xxx yyy R ]",
  # xxx yyy are numbers, CR's may be embedded

  my @based;				# o1 => xxx, o2 => yyy, end, len
  push @based, {o1 => $2, o2 => $3, len => length $1, S => pos($in)-length $1}
    while $in =~ m{ ( \[ \s+ /ICCBased \s+ (\d+) \s+ (\d+) \s+ R \s+ \] ) }gx;
  printf "... found %d instances to edit\n", scalar @based if $opts{v};

  #    2. find object "xxx yyy obj<< /N ? /Alternate /DeviceRGB" ..., as in
  #48 0 obj
  #<< /N 3 /Alternate /DeviceRGB /Length 2575 /Filter /FlateDecode >>

  # Allow for something like
  #   /Length 16 0 R
  # before /N

  my ($c, $replace);
  for my $o (@based) {
    undef pos $in;			# Rewind
    while ($in =~ m{ \b $o->{o1} \s+ $o->{o2} \s+ obj \s+
		     << \s+ (?:/Length \s+ \d+ \s+ \d+ \s+ R \s+)? /N \s+ (\d+) \b}xg ) {
      die "Repeated definition for '$o->{o1} $o->{o2}' found" if $o->{r};

      #  3. Replace "[/ICCBased...]" with /Device(Gray|RGB|CMYK) for N=1,3,4;
      #     pad with spaces to preserve length ==> no need to update xref table
      $replace = $subst{$1} or die "Unknown type $1 for /ICCBased" ;
      $replace .= ' ' x ($o->{len} - length $replace);	# Pad

      $c++;
      $o->{r} = $replace;
      printf "Definition for $o->{o1} $o->{o2} at offset %#x: /N $1\n", pos $in
	if $opts{v};
    }
    die "No definition for '$o->{o1} $o->{o2}' found" unless exists $o->{r};
  }

  print("Nothing to replace for '$file'"), next unless $c;
  next if $opts{t};
  for my $o (@based) {
    if ($opts{v}) {
      (my $t = substr $in, $o->{S}, $o->{len}) =~ s/\r/\n/g;	# to printable
      printf "Edit at offset %#x: '$t' ===> '$o->{r}'\n", $o->{S};
    }
    substr($in, $o->{S}, $o->{len}) = $o->{r};
  }

  my $tmp = $ENV{TMP} || $ENV{TMPDIR} || $ENV{TEMP};
  die "Need to have TMP or TMPDIR or TEMP defined" unless $tmp;
  (my $bak = $file) =~ s(^.*[\\/])();		# basename
  copy $file, "$tmp/$bak" or die "copy $file, $tmp/$bak: $!";
  open OUT, ">$file" or die "open `$file' for write: $!";
  binmode OUT or die;
  print OUT $in;
  close OUT or die "close `$file' for write: $!";
}