#!/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.4 $ =~ /(\d+)\.(\d+)/) - 1;
# $Id: patchaperlup,v 1.4 2000/02/27 09:58:26 k Exp k $

%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];
  if (system("zcat $pathdiff | $patchcommand")==0) {
    verbose "\rapplied patch # %s.%s", $d, $Opt{verbose}>0 ? "\n" : " ";
  } elsif ($d==$diffs[0]) {
    # need to be tolerant with first patch (see above)
    my $ls = `zcat $pathdiff | perl Porting/patchls - `;
    chomp $ls;
    if ($ls eq "-: Changes") {
      warn "Patch error on Changes file can be ignored\n";
    } else {
      warn "Problem with patch $d\n";
      push @fails, $d;
    }
  } 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 very 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.

There are currently the following places to access the Archive of Perl
Changes (APC):

=over

=item ftp://ftp.linux.activestate.com/pub/staff/gsar/APC/

A voluminous complete history of all changes since 5.005_58. The
00README file there is recommended for details about the status of the
APC.

=item rsync://ftp.linux.activestate.com/perl-current/

The perl-current directory of the APC.

=item rsync://ftp.linux.activestate.com/perl-diffs/

The diffs directory of the APC. This contains patches for each change
submitted to the Perl repository since the last release.

=back

To get a copy of today's perl you'd just do

  rsync -auvz rsync://ftp.linux.activestate.com/perl-current/ perl-current

If you're hunting for a bug though, you'd like to try several
different recent perls. That's where you want to have the C<diffs/>
directory mirrored and use patchapaerlup to get apply selected
patches.

The alternative way to get today's perl is the following. Untar a
recent perl distribution, mirror the C<diffs/> directory, run
this C<patchaperlup> utility, and run the perl build commands as
usual.

Untarring a recent perl snapshot is usually done with the tar command,
say

  tar xvzf /local/path/to/perl5.5.660.tar.gz

Mirroring the pumpkin's patch repositury can be done with C<rsync>,
e.g.

  rsync -auvz rsync://ftp.linux.activestate.com/diffs diffs

Now patchaperlup could 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 that day's perl at the time of
writing and stuffed it into a directory of its own. Please fill in
your nearest CPAN site in line 2:

  DEVPERL=perl5.5.660
  wget -m -nd -v ftp://cpan.host.and.path/authors/id/GSAR/$DEVPERL.tar.gz
  tar xzf $DEVPERL.tar.gz
  rsync -auvz 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 lThere are some tiny patch problems if
you do that, I haven't investigated how serious they are.

=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

