#!/usr/bin/perl -w

use strict;
use File::Spec;
use Cwd;
use Getopt::Long;
use vars qw(%Opt $VERSION);

$VERSION = sprintf "%.3f", (sprintf "%d.%03d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/) - 1;
# $Id: patchaperlup,v 1.7 2000/11/02 09:17:14 k Exp $

%Opt = ();

# options get and build are undocumented as they might be considered bloatware
GetOptions( \%Opt, qw( upto=i perldir=s diffdir=s quiet! version+ verbose+) );

sub verbose {
  return if $Opt{quiet};
  printf STDERR @_;
}

print "Version: $VERSION\n";
if ($Opt{version}) {
  exit;
}

sub usage () {
  "Usage $0
    --perldir  perldirectory-to-alter
    --diffdir  patchdirectory
    [--upto    number-of-last-patch]
    [--quiet]
    [--verbose]
    [--version]";
}

my $perldir = $Opt{perldir} or die usage;
my $diffdir = $Opt{diffdir} or die usage;
$Opt{verbose} ||= 0;

die "perldir[$perldir] not found" unless -d $perldir;
print "Perldir: $perldir\n";
open F, "$perldir/Changes" or die "Couldn't open $perldir/Changes: $!";
my $already_patched;
while (<F>) {
  next unless /^\[\s*(\d+)\]\sBy:\s/;
  $already_patched = $1;
  last;
}
$|=1;

die "diffdir[$diffdir] not found" unless -d $diffdir;
print "Diffdir: $diffdir\n";
my $diffdir_abs = File::Spec->file_name_is_absolute($diffdir) ?
    $diffdir : File::Spec->catdir(Cwd::cwd,$diffdir);
opendir DIR, $diffdir_abs or die "Couldnt opendir";
my @diffs = sort { $a <=> $b } grep s/^(\d+)\.gz/$1/, readdir DIR;
if ($already_patched > $diffs[0]) {
  verbose "Your patchdirectory starts with patch %d, but your perldir
has the patches up to %d already applied. Skipping those not needed.
", $diffs[0], $already_patched;
  shift @diffs while $diffs[0] <= $already_patched;
}

# Now it is possible that the first patch we have here is only
# patching the Changes file and that this patch has already been
# applied during the release. We need to be more tolerant on the first
# patch.

my $latest = $diffs[-1];
$latest =~ s/\D.*//;
if ($Opt{upto}) {
  if ($Opt{upto} > $latest) {
    die "Invalid option for upto[$Opt{upto}].
Latest patch in your diffdir is $latest\n";
  } elsif ($Opt{upto}<$diffs[0]) {
    die "Invalid option for upto[$Opt{upto}].
First patch in your diffdir is $diffs[0]\n";
  } else {
    pop @diffs while $diffs[-1] > $Opt{upto};
    $latest = $Opt{upto};
  }
}
chdir $perldir or die "Couldn't chdir to $perldir: $!";
my @fails;
verbose "Prescanning all patch files for contents\n";
my $tmpfile = "tmp.patchls.$$";
open F, "| perl Porting/patchls - > $tmpfile";
for my $d ( @diffs ){
  verbose "\r%10s of %10s to %10s", $d, $diffs[0], $diffs[-1];
  my $pathdiff = "$diffdir_abs/$d.gz";
  die "Couldn't find pathdiff[$pathdiff]" unless -f $pathdiff;
  open G, "zcat $pathdiff|";
  local $/;
  print F <G>;
  close G;
}
close F;
verbose "\n";

open F, $tmpfile or die "Couldn't open $tmpfile: $!";
my %pfiles;
while (<F>) {
  s/^-:\s//;
  chomp $_;
  my @pfiles = grep { -f $_ } split m{ }, $_;
  @pfiles{@pfiles} = ();
}
close F;
unlink $tmpfile;

sub contains_cr {
  my($file) = shift;
  open F, $file or die "Couldn't open $file: $!";
  local($/) = "\n";
  my $firstline = <F>;
  $firstline =~ /\cM/;
}

@ARGV = grep contains_cr($_), keys %pfiles;

if (@ARGV) {
  verbose "Removing CR from %d files\n", scalar @ARGV;
  $^I = "";
  my $i = 0;
  my $b = 0;
  while (<>) {
    s/\r$//;
    print;
    if (eof(ARGV)){
      verbose "\r%5d files, %6d lines", ++$i, $.;
    }
  }
  my $lines = $.;
  verbose "\n";
}
my $patchcommand = sprintf(
                           "patch %s -p1 -N",
                           $Opt{verbose}>0 ? "" : "-s"
                          );

for my $d ( @diffs ){
  my $pathdiff = "$diffdir_abs/$d.gz";
  verbose "\rapplying patch # %s.\n", $d if $Opt{verbose}>0;
  print "Firstpatch: $d\n" if $d==$diffs[0];
  my $pout = `zcat $pathdiff | $patchcommand 2>&1`;
  if ($? == 0) {
    verbose "\rapplied patch # %s.%s", $d, $Opt{verbose}>0 ? "\n" : " ";
  } else {
    my $ls = `zcat $pathdiff | perl Porting/patchls -`;
    print $pout;
    chomp $ls;
    if ($ls eq "-: Changes") {
      warn "Patch error on Changes file can be ignored\n";
    } elsif ($pout =~ /patch: \*\*\*\* Only garbage was found in the patch input./) {
	warn "PAPU: These Only Garbage patch errors can be ignored.";
    } else {
      warn "Problem with patch $d\n";
      push @fails, $d;
    }
  }
}
verbose "\n";
if (@fails) {
  verbose "The following patches had errors:\n";
  verbose join "", map {"\t$_\n"} @fails;
  verbose "\n";
  die "Errors while patching\n";
} else {
  print "Lastpatch: $diffs[-1]\n";
}

verbose qq{Now you can make a new perl by running e.g.:
  cd $perldir && ./Configure -des && make test
};


__END__

=head1 NAME

patchaperlup - apply a couple of patches in a perl source directory

=head1 SYNOPSIS

  patchaperlup --perldir perldir
               --diffdir diffdir
               [ --upto patch-number ]
               [ --quiet ]
               [ --version ]

=head1 DESCRIPTION

This utility runs a batch of jobs that upgrade a recent development
perl with selected patches to produce a recent development snapshot of
perl.

The status of this script is alpha as the applicability of the
assumptions about where the current patches are, how they are named
and treated, etc. are unstable. The script is only reflecting current
practice which is subject to change without notice.

How to get at the patches is described in the perlhack manpage.

Be careful though, Sarathy posted a recommendation:

  From: Gurusamy Sarathy <gsar@ActiveState.com>
  Subject: Re: rsync'ed patches vs. rsync'ed source 
  Date: Wed, 01 Nov 2000 09:58:08 -0800

  I'd strongly recommend sticking with rsync.

  The rsync mirror is automatic and syncs with the repository every five
  minutes.

  Updating the patch area still requires manual intervention (with all
  the goofiness that implies, which you've noted) and is typically on
  a daily cycle.  Making this process automatic is on my tuit list,
  but don't ask me when.

I take it that for the real recent perl of the day, you should use
rsync to the perl-current area, but if you want to track down when a
bug was introduced or fixed, the patch repository is the natural
choice.

When you have unpacked a recent perl, patchaperlup should be run as

  perl patchaperlup --perldir perl5.5.660 --diffdir diffs

C<patchaperlup> checks which highest numbered patch has already been
applied to the perl in the C<perldir>. The --upto argument defaults to
the highest numbered patch in the directory given by the --diffdir
argument.

The batch job is pretty verbose and explains what it is doing. The
reason for the verbosity was that it can take a while until
C<patchaperlup> is finishing. Verbosity can be turned off with the
--quiet switch and increased with the --verbose switch.

C<patchaperlup> prints a few mail-header-like lines to standard
output, namely

  Version: version of patchaperlup
  Perldir: perl directory
  Diffdir: directory containing the patches
  Firstpatch: number of the first applied patch
  Lastpatch: number of the last applied patch

The --version switch prints the version and exits.

=head1 EXAMPLE

The following shell script built today's perl and stuffed it into a
directory of its own. Please fill in your own path to DEVPERL.

  DEVPERL=perl-5.7.0
  tar xzf /path/to/devperl/$DEVPERL.tar.gz
  rsync -avz rsync://ftp.linux.activestate.com/diffs diffs
  patchaperlup --perldir $DEVPERL --diffdir diffs > patchaperlup.out
  LPATCH=`awk '$1=="Lastpatch:"{print $2}' patchaperlup.out`
  mv $DEVPERL $DEVPERL@$LPATCH
  cd $DEVPERL@$LPATCH && ./Configure -des && make test

If all patches from the APC are merged into a single diffs directory,
it is possible to run the above example with any DEVPERL from 5.005_58
upwards. At the time of writing, there were some tiny patch problems
if you do that. I'm planning to special-case them so that patchaperlup
does not report unnecessary errors.

=head1 PREREQUISITES

The programs C<zcat> and C<patch> must be in your path. Likewise
C<perl> must be available in the path to run the utility C<patchls>
which can be found in recent perl distributions.

=head1 AUTHOR

Andreas Koenig <andreas.koenig@anima.de>

=cut

