#!/usr/bin/perl
#
# (C) 2005,2006,2007 Matthias Ferdinand EDV-Beratung
#
# CPAN+changelog.pl	-	show changelog entries for upgradeable 
#				CPAN Perl modules
#-----------------------------------------------------------------------
# $Id: _usr_local_bin_CPAN+changelog.pl,v 1.38 2008/11/18 12:56:25 mferd Exp $
#
# $Log: _usr_local_bin_CPAN+changelog.pl,v $
# Revision 1.38  2008/11/18 12:56:25  mferd
# - change sub distparse to match "-RCnn.tgz"
#   e.g. for N/NW/NWCLARK/perl-5.8.9-RC1.tar.gz
#   important to avoid installing a full perl interpreter when
#   you actually wanted to just update a module
#
# Revision 1.37  2007/10/08 09:25:11  mferd
# - use function &distparse (parse distribution file name) also for
#   "-history" and "-clone"
# - sub distparse: accept a "v" before version number
#   (e.g. D/DC/DCONWAY/Text-Balanced-v2.0.0.tar.gz)
#
# Revision 1.36  2007/06/05 10:54:44  mferd
# - somewhere around v1.90, CPAN switched to using temp dirs under
#   <cpan_home>/build/, with a few consequences:
#     * every time we called get() on a module, it would be extracted
#       into a new temp dir, even if we had called get() before
#       workaround: check if the dir() method returns a path, and
#                   skip calling get() if it does
#     * unless $CPAN::Config->{'build_dir_reuse'} was set (new config
#       option), each check with '-r' created a new unpacked temp dir
#       for every upgradeable module found
#       workaround: if called with '-r' or '-init', force build_dir_reuse
#                   to 1.
#                   No danger here, because all we want are the
#                   changelogs
# - suppress CPANs "CPAN: <module xy> loaded ok" message during
#   CPAN::HandleConfig() in cron job situations. Potential later
#   messages of the same type are already taken care of by
#   our conditional output redirection (-t STDIN)
#
# Revision 1.35  2007/04/11 14:02:48  mferd
#  (forgotten changelog entry for 1.34)
#  * for "-r", sort upgradeables-list according to release date
#    (approximated by mtime of the Changelog file)
#
# Revision 1.34  2007/04/11 13:53:39  mferd
#  * s/CPAN::expand/CPAN::Shell->expand/g
#    CPAN::expand methods not available anymore in CPAN 1.90
#
#  * Ignore list: try to ignore admin-configured list of distribution files.
#      works well for "-r"
#      does not help much with "-install", since we can't influence
#      automatic dependency resolution in CPAN.
#    switches: -addignore <module_or_distribution>
#              -delignore <module_or_distribution>
#              -showignore
#    useful e.g. to avoid broken libnet-1.20 for amavisd-new setups
#
#  * first attempt at "-clone"
#    produce a Bundle-file that generates the _exact_ same versions on another
#    Perl installation.
#    this shall (once really working) help with installing the exact same
#    module versions as you had in your tested setup
#
# Revision 1.33  2006/05/20 22:06:58  mferd
# (-r) corrected finding the build dir where to find a modules Changelog
#      (was broken e.g. for T/TK/TKISHEL/DBD-Multiplex-1.99-1.tar.gz)
#
# Revision 1.32  2006/04/01 18:20:49  mferd
# bug fix: create BuildLog-dir when needed (wrong condition)
#
# Revision 1.31  2006/03/30 14:07:07  mferd
# bug fix: '-shell' did not create BuildLog-dir if necessary
# bug fix: move loading of CPAN config after argument handling,
#          '-version' might otherwise not show version, but
#          start CPAN configuration dialog instead :-)
#
# Revision 1.30  2006/03/28 13:23:05  mferd
# add -shell (combine BuildLog, auto-autobundle and interactive features! :-)
# set $env{"COLUMNS"} and $env{"LINES"} for -shell and for -install,
#   otherwise Term::Readline fails to determine screen size
#   (output is not a tty, since we are redirected)
#
# Revision 1.29  2006/03/05 00:25:10  mferd
# incorporate disclaimer into output of -license
#
# Revision 1.28  2006/03/03 14:49:28  mferd
# beautify Usage message
#
# Revision 1.27  2006/03/03 14:34:51  mferd
# corrected RCS revision tag for -version
#
# Revision 1.26  2006/03/03 14:33:59  mferd
# added -license and -version options
#
# Revision 1.25  2006/03/02 16:38:09  mferd
# catch CPAN breaking in case of bad package checksum
# unknown cmd line args not beginning with "-" now also treated as error
#
# Revision 1.24  2006/02/02 13:25:13  mferd
# BuildLog file name erroneously truncated for -history
# workaround for zgrep anomaly on SuSE8.2 (additional '(standard input):' after filename)
#
# Revision 1.23  2006/01/23 17:09:55  mferd
# add ChangeLog.svn to @CHANGELOGNAMES
# support multiple changelog files per distribution
#
# Revision 1.22  2006/01/23 16:13:46  mferd
# give warnings when CPAN/CPANPLUS modules have changed, they might
#    require interactive reconfiguration
#
# Revision 1.21  2006/01/20 14:35:28  mferd
# support -force with -install
# abort if more than one mode of operation is given (-r/-init/-history/-install)
#
# Revision 1.20  2006/01/12 19:35:20  mferd
# prefix some warnings with '# '
# 'use CPAN::Config;' not sufficient, use CPAN::Config->load or CPAN::HandleConfig->load
#
# Revision 1.19  2006/01/11 17:35:23  mferd
# prefix ChangeLog-update message with "# "
#
# Revision 1.18  2006/01/10 17:35:27  mferd
# Prefix own output with "# " (except for "-history")
# "-history": shorten output using relative pathnames,
#                show $CPANHOME only once
#             abandon assigning BuildLogs to Snaphots, treat
#                 any of them as a separate entity
#             show modules that disappeared from one Snapshot to another
#                 as "!!!MISSING!!!"
#             support "all" Wildcard
#             remove -printf from call to find, not supported on NetBSD
# add EDRI support teaser
#
# Revision 1.17  2006/01/10 00:59:32  adminmf
# "-history": show "-install" argument from BuildLog
#             rearrange BuildLog output
#
# Revision 1.16  2006/01/10 00:02:02  mferd
# "-history": do not create ChangeLogs-Dir if missing
#
# Revision 1.15  2006/01/09 23:47:46  adminmf
# "-history": find distribution files even when maintainer has changed
#             improve readability when multiple modules are given
#
# Revision 1.14  2006/01/09 01:35:14  mferd
# suppress CPAN output while retrieving ChangLogs for "-r"
# show "-r" summary before _and_ after ChangeLog changes
#
# Revision 1.13  2005/12/24 00:56:10  mferd
# fixed changelog retrieval for distfile installs
# fixed -history to also show relevant BuildLogs where no Snapshot was created
# fixed -init to actually check every installed module
# added long comment about difficulty to find the distfile that produced current module version
# some general beautifying
#
# Revision 1.12  2005/12/20 01:46:05  mferd
# allow installation of Bundles and Distributions as well
# installing Distributions allows downgrading of modules, btw
#
# Revision 1.11  2005/12/19 18:32:05  mferd
# added history function
#
# Revision 1.10  2005/12/12 17:59:21  mferd
# show changelog changes for packages that had no changelog previously
# show changelog changes also in install mode so they are included in
#   buildlogs
# restrict changelog display to 300 lines
#
# Revision 1.8  2005/12/07 15:15:32  mferd
# SKIPPED_MODULES flag was missing for base distribution modules
#
# Revision 1.7  2005/12/06 20:30:59  mferd
# mode -r: start report with module overview
#
# Revision 1.6  2005/12/06 16:08:37  mferd
# show summary line with upgradeable modules at the top
# show diff against last autobundle()-generated Snapshot
# show warning for modules with unchanged version numbers after install
#
# Revision 1.5  2005/12/03 22:00:29  mferd
# mferd: add BuildLog funcionality for "-install" option
#
# Revision 1.4  2005/11/17 14:08:51  mferd
# mferd: extended handling of bogus htmlop from w3mir-1.0.10
#
# Revision 1.3  2005/11/16 19:37:20  mferd
# corrected multiple modules as arg to -install
#
# Revision 1.2  2005/11/16 17:52:34  mferd
# renamed program name and mode names;
# added 'install' mode
#
# Revision 1.1  2005/11/16 14:24:27  mferd
# Initial revision
#
#-----------------------------------------------------------------------

$|=1;
use CPAN;
#use CPAN::Config;
use File::Basename;
use File::Temp qw/ tempfile /;
use FileHandle;

$REVISION= '$Revision: 1.38 $';	# filled by RCS
($VERSION)=($REVISION=~m/: ([0-9.]+) /);

$DISCLAIMER=<<EODISCLAIMER;
CPAN+changelog.pl DISCLAIMER
============================
Date: 2006/02/18

THERE ARE NO WARRANTIES OF ANY KIND!
This program is intended to be useful, but there are no warranties
to the extend applicable by law, not even an implied warranty for
fitness for a particular purpose. The author is not responsible
for any direct or indirect damage that might arise through use
or inability to use this program.
This program probably does have bugs and shortcomings, you have
been warned. 


EDRi IS NOT RESPONSIBLE FOR CPAN+changelog.pl!
Although I chose a non-free license in favour of EDRi, EDRi has
no responsibilities concerning this program. 
I (Matthias Ferdinand) own the copyright for this program and
any bug therein is mine, not EDRi's. So please don't complain to
them if there is anything to complain about (see the "no warranties"
section above)
EODISCLAIMER

$LICENSE=<<EOLICENSE;
CPAN+changelog.pl LICENSE
=========================
Date: 2006/02/18


You are allowed to copy and distribute the software.
You are allowed to modify the software for your own use as long
  as the license conditions for unmodified use are met.
Your are allowed to distribute the modified software provided
  - you do not change the license
  - you keep the disclaimer intact (but you can add your own)
  - the software is clearly marked as modified

To use this software for anything except evaluation purposes, you
are required to donate 20 Euro to
        European Digital Rights (EDRi)
for every Perl installation that you want to use it for.
I heartily encourage you to donate higher amounts if you think
the software is worth more or if you think EDRi would be worthy
of more support.

At the time of writing, their bank account was
  Name: European Digital Rights Asbl
  Bank account nr.: 733-0215021-02
  IBAN: BE32 7330 2150 2102
  BIC: KREDBEBB
but please check against http://www.edri.org/about/sponsoring
Please put "EDRIgram" into the reason field.

If and only if you really cannot afford to donate 20 Euro 
(carefully think about it!) then you can alternatively completely
and thoroughly read two of their EDRi-gram newsletters, which can
be found at http://www.edri.org/edrigram, and you will be allowed
to use the software.

EDRi is an international non-profit association concerned with 
defending civil rights in the information society.
From http://www.edri.org/about
  "Some examples of regulations and developments that have the
   attention of European Digital Rights are data retention
   requirements, spam, telecommunications interception, copyright
   and fair use restrictions, the cyber-crime treaty, rating,
   filtering and blocking of internet content and
   notice-and-takedown procedures of websites."
Please visit their website and find out about todays dangers for
your digital civil rights.
EOLICENSE

$LICENSE_NOTES=<<EOLICENSE_NOTES;
NOTES ABOUT THE LICENCE
=======================
Date: 2006/02/22


- NOT FREE, BUT IT'S ABOUT FREEDOM
  This is kind of a Donateware, you are entitled to use it when
  you have donated the amount of 20,- EURO to EDRi, and you are
  allowed to have an evaluation period before that. You even may
  intensively test and evaluate, but please be honest and donate when
  you are done with testing or please stop using it. For those who
  really and honestly can't afford 20 EURO, there is an exception that
  requires you to read 2 EDRi-gram newsletters.
  EDRi is defending digital civil rights, and a donation to them 
  helps protect freedom in the information society.

- NO UPGRADE FEES, NO TIME LIMITS
  When you have met the license conditions, you can use upated
  versions at any time, with no expiration to either the license
  or your upgrade entitlement. I don't promise to release updates,
  though. All caveats from _00_DISCLAIMER.txt apply.

- BOUND TO ONE PERL INSTALLATION
  Your license applies to a single Perl installation. For this
  licensed installation, you may upgrade the program whenever you want.
  But if you want to use it for another Perl installation, you need
  another license (i.e. donate again).

- REUSABLE
  If you stop using it on one Perl installation, e.g. because you
  retired the machine or just the Perl installation on it, your
  license does not expire, and you can reuse it for another
  Perl installation. 
EOLICENSE_NOTES

@CHANGELOGNAMES=qw( Changes ChangeLog Whatsnew ChangeLog.svn );
@DISTR_EXTENSIONS=('.tar','.tar.gz','.tgz','.tar.bz','.tar.bz2','.tar.Z');

# blacklisted or some other reason
%SKIPPED_MODULES=();
$FORCE=0;


while ($ARGV[0]=~m/^-/)
  { if ($ARGV[0] eq '-init')
      { shift; 
        if ($MODE) { &Err_SingleMode; }
        $MODE='init';
      }
    elsif ($ARGV[0] eq '-r')
      { shift; 
        if ($MODE) { &Err_SingleMode; }
        $MODE='r';
      }
    elsif ($ARGV[0] eq '-install')
      { shift; 
        if ($MODE) { &Err_SingleMode; }
        $MODE='install';
        if ($#ARGV<0)
          { print STDERR "ERROR: no args for -install\n";
            &Usage;
          }
        $INSTALL_LIST=$ARGV[0];
        shift;
      }
    elsif ($ARGV[0] eq '-history')
      { shift;
        if ($MODE) { &Err_SingleMode; }
        $MODE='history';
        if ($#ARGV<0)
          { print STDERR "ERROR: no args for -history\n";
            &Usage;
          }
        $HISTORYLIST=$ARGV[0];
        shift;
      }
    elsif ($ARGV[0] eq '-shell')
      { shift;
        if ($MODE) { &Err_SingleMode; }
        $MODE='shell';
      }
    elsif ($ARGV[0] eq '-clone')
      { shift;
        if ($MODE) { &Err_SingleMode; }
        $MODE='clone';
        if ($#ARGV<0)
          { print STDERR "ERROR: no args for -clone\n";
            &Usage;
          }
        $CLONELIST=$ARGV[0];
        shift;
      }
    elsif ($ARGV[0] eq '-force')
      { shift;
        $FORCE=1;
      }
    elsif ($ARGV[0] eq '-v' || $ARGV[0] eq '-version')
      { print "This is CPAN+changelog.pl version $VERSION\n";
        exit 0;
      }
    elsif ($ARGV[0] eq '-licence' || $ARGV[0] eq '-license')
      { &License;
        exit 0;
      }
    elsif ($ARGV[0] eq '-addignore')
      { shift;
        if ($MODE) { &Err_SingleMode; }
	$MODE='addignore';
        if ($#ARGV<0)
          { print STDERR "ERROR: no args for -addignore\n";
            &Usage;
          }
        $ADDIGNORE_LIST=$ARGV[0];
        shift;
      }
    elsif ($ARGV[0] eq '-delignore')
      { shift;
        if ($MODE) { &Err_SingleMode; }
	$MODE='delignore';
        if ($#ARGV<0)
          { print STDERR "ERROR: no args for -delignore\n";
            &Usage;
          }
        $DELIGNORE_LIST=$ARGV[0];
        shift;
      }
    elsif ($ARGV[0] eq '-showignore' || $ARGV[0] eq '-showignores')
      { shift;
        if ($MODE) { &Err_SingleMode; }
        $MODE='showignores';
      }
    else
      { print STDERR "ERROR: unknown option $ARGV[0]\n";
        &Usage;
      }
  }

# too many arguments is an error
if ($#ARGV>=0)
  { print STDERR "ERROR: unknown argument $ARGV[0]\n";
    &Usage;
  }

if (!$MODE)
  { $MODE='r';	# default mode; other possibilites: init, install, history, addignore, delignore, showignores
  }

# With CPAN version 1.81, loading of CPAN configuration setting moved
#    from CPAN::Config->load (in CPAN.pm)
#    to   CPAN::HandleConfig->load (in CPAN/HandleConfig.pm)
# you can still call CPAN::Config->load (as of CPAN v1.83), but you get
# an ugly warning message in return.
# "Dispatching deprecated method 'CPAN::Config::load' to CPAN::HandleConfig"
# We try to be nice and use the new method, if possible
if (eval {require CPAN::HandleConfig;})	# eval discards error message
  { require CPAN::HandleConfig;
    $CPAN::Be_Silent++ if (! -t STDIN);
    CPAN::HandleConfig->load;
    $CPAN::Be_Silent-- if (! -t STDIN);
    # force build_dir_reuse unless we are installing
    if ($MODE eq 'r'   or   $MODE eq 'init')
      { $CPAN::Config->{'build_dir_reuse'}=1; }
  }
else
  { CPAN::Config->load; }

$BUILDDIR=$CPAN::Config->{'build_dir'};
$CPANHOME=$CPAN::Config->{'cpan_home'};
$CHLOGSDIR="$CPANHOME/ChangeLogs";
$BUILDLOGSDIR="$CPANHOME/BuildLogs";
$BUNDLEDIR="$CPANHOME/Bundle";
$IGNOREFILE="$CPANHOME/CPAN+changelog.ignore";

#print "BUILDDIR: $BUILDDIR\n"; exit;

if (! -d $CHLOGSDIR)
  { if ($MODE ne 'history')
      { if (!mkdir $CHLOGSDIR)
          { die "cannot create $CHLOGSDIR"; }
      }
  }
if (! -d $BUILDLOGSDIR)
  { if ($MODE eq 'install' || $MODE eq 'shell')
      { if (!mkdir $BUILDLOGSDIR)
          { die "cannot create $BUILDLOGSDIR"; }
      }
  }
if ($MODE eq 'install' && $FORCE && $INSTALL_LIST=~m/,/)
  { print STDERR "ERROR: will only install single item with -force\n";
    &Usage;
  }

@modlist=();


# nag on tty, but don't in cron job situations or when doing ignore file management
unless (($MODE eq 'r' and ! -t STDIN) || $MODE=~m/ignore/)
  { # advertise EDRI
    print "# Support EDRI! They defend your civil digital rights.\n";
    print "#    see http://www.edri.org/edrigram for why this is necessary.\n";
    print "#".('-'x71)."\n";
  }

if ($MODE eq 'init')
  { # single pass
    @modlist=&All_Modules;
    @REPORT=&work_on_modlist($MODE, @modlist);
    print @REPORT;
  }

elsif ($MODE eq 'r')
  { # single pass
    my $oldout;
    if (! -t STDIN)
      { # suppress CPAN output while retrieving Changelogs
        open $oldout, ">&STDOUT"     or die "Can't dup STDOUT: $!";
        close(STDOUT); open(STDOUT, ">/dev/null") || die "Can't open /dev/null";
      } 
    @modlist=&Upgradeable_Modules;
    if (scalar @modlist)
      { # only if there are modules to be upgraded
        @REPORT=&work_on_modlist($MODE, @modlist);
      }
    if (! -t STDIN)
      { open(STDOUT, ">&", $oldout); }
    if (scalar @REPORT)
      { # there might be blacklisted modules, so we check again
        @shortreport=grep { /^# .* current:.* cpan:/ } @REPORT;
        @sorted_mod_ids=sort { $CHANGELOG_MTIME{$a} cmp $CHANGELOG_MTIME{$b} }
                        grep { !$SKIPPED_MODULES{$_} } map { $_->id; } @modlist;
        # print summary at the start - useful for email
        print '#'.('-'x71)."\n";
        print "# Upgradeables: ",join(',', @sorted_mod_ids),"\n";
        print reverse sort @shortreport;
        print @REPORT;
        # print summary at the end - useful for the terminal
        print '#'.('-'x71)."\n";
        print "# Upgradeables: ",join(',', @sorted_mod_ids),"\n";
        print reverse sort @shortreport;
        
      }
  }

elsif ($MODE eq 'install')
  { &Buildlog_Wrap(\&Do_Install); }

elsif ($MODE eq 'history')
  { # show upgrade installation history of named Perl CPAN modules
    $mod=CPAN::Shell->expand("Module",'B'); 	# init CPAN, those messages might mix with ours
    # hack for complete history of all modules:
    # simulate they were all given on cmdline
    if ($HISTORYLIST eq 'all')
      { $HISTORYLIST=join(',', map { $_->id; } &All_Modules); }
    $localdistsourcesdir="$CPANHOME/sources/authors/id";
    print "\nCPAN home: $CPANHOME\n";
    #print "\nLocal distribution files under $localdistsourcesdir:\n";
    print "\nLocal distribution files under sources/authors/id:\n";
    foreach $id (split(',',$HISTORYLIST))
      { $mod=CPAN::Shell->expand("Module",$id); 
        next if ($showhist{$id});	# avoid duplicates
        $showhist{$id}=1;
        # look for local copies of older module source packages
        $file=$mod->cpan_file;
	($base,$path,$type,$dist_base,$dist_ver)=&distparse($file);
        push(@find_names, $dist_base) unless ($find_name{$dist_base});
	$find_name{$dist_base}=1;
        #$key=$path.$dist_base; 
        # leave out path with author initials and we can support maintainer change!
        $key=$dist_base;
        $path_base{$id}=$key;
	$RELEVANT_KEY{$key}=1;
      }
    $find_expr_names=join(' -o ', map { "-name '${_}-*'"; } @find_names);
    #NetBSD find does not support "-printf" :-(
    #$find_expr="-type f \\( $find_expr_names \\) -printf '%P\\n'";
    $find_expr="-type f \\( $find_expr_names \\)";
    $cmd="find $localdistsourcesdir $find_expr";
    #print join(",", @find_names),"\n";
    #print "$find_expr_names\n";
    #print "$cmd\n";
    open(FIND, "$cmd |") || die "can't start find: $!";
    while ($dist_path=<FIND>)
      { chomp $dist_path;
	($dist_file)=($dist_path=~m/^$localdistsourcesdir\/(.*)$/);
	#print "$dist_path $dist_file\n";
        push(@localdistfiles,$dist_file);
        ($base,$path,$type,$dist_base,$dist_ver)=&distparse($dist_file);
        $DIST_FILE_VER{$dist_file}=$dist_ver;
      }
    close(FIND);
    foreach $find_name (@find_names)
      { print map { "        $_\n"; } 
              sort { $DIST_FILE_VER{$a} cmp $DIST_FILE_VER{$b} }
                   grep { /\/${find_name}-[^\/]*$/; } @localdistfiles;
      }

    &Eval_BuildLogs;
             
    # go through all autobundle'd Snapshot_yyyy_mm_dd_nn.pm files and look for
    # changed version numbers of the modules we are interested in
    opendir(BUNDLES, $BUNDLEDIR) || warn "# cannot open $BUNDLEDIR";
    @SNAPSHOTS=sort grep { m/^Snapshot_\d{4}_\d{2}_\d{2}_\d{2}.pm$/ } readdir BUNDLES;
    closedir(BUNDLES);
    foreach $snapshot (@SNAPSHOTS)
      { # extract date of snapshot build
        ($yyyy,$mm,$dd,$nn)=($snapshot=~m/^Snapshot_(\d{4})_(\d{2})_(\d{2})_(\d{2})/);
        $yyyymmdd="$yyyy$mm$dd";
        $yyyy{$snapshot}=$yyyy; $mm{$snapshot}=$mm; $dd{$snapshot}=$dd;
        $yyyymmdd{$snapshot}=$yyyymmdd;
        undef $hh; undef $min; undef $ss;
        %SNAPSHOT_VERSION=(); %SNAPSHOT_LINE=();
        open(SNAP, "<$BUNDLEDIR/$snapshot") || warn "# cannot read $BUNDLEDIR/$snapshot: $!";
        while ($line=<SNAP>)
          { chomp $line;
            if ($line=~m/^Bundle::Snapshot_${yyyy}_${mm}_${dd}_${nn} - Snapshot of installation on \S+ on \S+\s+\S+\s+\S+\s+(\d{2}):(\d{2}):(\d{2}) $yyyy/)
              { $hh=$1; $min=$2; $ss=$3; $hhmmss="$hh$min$ss";
                $yyyymmddhhmmss{$snapshot}=$yyyymmdd.$hhmmss;
                $tspec="$yyyymmdd-$hhmmss";
              }
            if ($line=~m/^(\S+)\s+(\S+)/)
	      { # be simplistic and take everything for a module name
                next if (!$showhist{$1});
                # now we have one of the modules to be watched
                $id=$1; $ver=$2;
                $SNAPSHOT_VERSION{$id}=$ver;
		$SNAPSHOT_LINE{$id}=$line;
	      }
	  }
        close(SNAP);
	$modules_count=0;
        foreach $id (sort keys %showhist)
	  { $ver=$SNAPSHOT_VERSION{$id};
            next if ($ver eq $last_seen_version{$id});
	    $line=$SNAPSHOT_LINE{$id};
	    if (!defined $line)
	      { $line="$id !!!MISSING!!!"; }
            else
              { if (length($last_seen_version{$id}))
                  { $line.="    ($last_seen_version{$id})"; }
              }
	    # ok, new version number
            #print "$line: $BUNDLEDIR/$snapshot\n";
	    $history_report{$tspec}=[] unless (defined $history_report{$tspec});
	    if (!$modules_count++)
              { push(@{$history_report{$tspec}}, "Bundle/$snapshot ($tspec):\n"); }
            push(@{$history_report{$tspec}}, "        $line\n");
            #$localcopy=$localsrc{$id}->{$ver};
            #$localcopy="(package file not found)" if (!defined $localcopy);
            #print "    $localcopy\n";
            # look for buildlog entries that mention this version

            #$distr_file_base="$path_base{$id}-$ver";
            ##print "lookup key: $distr_file_base\n";
            ## a Snapshot file is referred to by at most one BuildLog file
            #foreach $buildlog (@{$packagebuildlogref{$path_base{$id}}})
	    #  { if ($buildlog=~m/^$SNAPSHOT2BUILDLOG{$snapshot}:/)
	    #      { push(@{$history_report{$tspec}}, "    $buildlog\n"); 
	    #        if ($buildlog=~m/^(\S+):Running make for /)
            #	  { delete $UNASSIGNED_BUILDLOG{$1}; }
	    #      }
	    #  }
                    
            $last_seen_version{$id}=$ver;
            #$last_snapshot_before{$id}->{$ver}=$last_snapshot_before;
          }

# mf, 10.01.2006: do not assign snapshot and buildlog at all
#        # alternate version, only the single one BuildLog file
#        # for this Snapshot (if any)
#        if ((scalar keys %SNAPSHOT_VERSION) and exists $SNAPSHOT2BUILDLOG{$snapshot})
#          { $buildlog_name=$SNAPSHOT2BUILDLOG{$snapshot};
#            push(@{$history_report{$tspec}}, "    $buildlog_name:\n");
#            push(@{$history_report{$tspec}}, "        $INSTALLING{$buildlog_name}\n");
#            push(@{$history_report{$tspec}}, map { "        $_\n"; } @{$UNASSIGNED_BUILDLOG{$buildlog_name}});
#            #print "assigned: $snapshot $buildlog_name\n";
#            delete $UNASSIGNED_BUILDLOG{$buildlog_name};
#          }
                    
        $last_snapshot_before=$snapshot;
      }
    # walk through remaining buildlogs that have not led to a snapshot
    foreach $buildlog_name (sort keys %UNASSIGNED_BUILDLOG)
      { if ($buildlog_name=~m/^$BUILDLOGSDIR\/(BuildLog-(\d{8})-(\d{6})-\S{6}.*)/)
	  { $tspec="$2-$3";
	    $buildlog_base=$1;
	    $history_report{$tspec}=[] unless (defined $history_report{$tspec});
            #push(@{$history_report{$tspec}}, "$buildlog_name:\n");
            push(@{$history_report{$tspec}}, "BuildLogs/$buildlog_base:\n");
	    if (exists $INSTALLING{$buildlog_name})
              { push(@{$history_report{$tspec}}, "        $INSTALLING{$buildlog_name}\n"); }
            push(@{$history_report{$tspec}}, map { "        $_\n"; } @{$UNASSIGNED_BUILDLOG{$buildlog_name}});
	    if (exists $BUILDLOG2SNAPSHOT{$buildlog_name})
	      { push(@{$history_report{$tspec}}, "        Wrote bundle file $BUNDLEDIR/$BUILDLOG2SNAPSHOT{$buildlog_name}\n"); }
	    #foreach $buildlogline (@{$UNASSIGNED_BUILDLOG{$buildlog}})
	    #  { push(@{$history_report{$tspec}}, "$buildlogline\n"); }
	  }
      }


    # now print time sorted history
    foreach $tspec (sort keys %history_report)
      { print "\n";
	print @{$history_report{$tspec}};
      }
  }

elsif ($MODE eq "shell")
  { 
    # Term::ReadKey (CPAN::shell, CPANPLUS) wants to know terminal size for
    # Readline, but cannotdetermine the size when output is redirected to the
    # BuildLog.
    # Try to determine screen size from "stty -a" and set environment
    # variables
    &Get_Terminalsize;

    print "# Command output will be redirected, but the command prompt goes\n";
    print "# directly to your terminal. If you don't see the 'cpan>' prompt\n";
    print "# when a command has finished, try pressing RETURN.\n";
    print '#'.('-'x71)."\n";
    &Buildlog_Wrap(\&CPAN::shell);
  }

elsif ($MODE eq "clone")
  { # produce an enhanced version of an autobundle()-file: 
    #   * list of all installed modules (standard)
    #       generated via CPAN::Shell->expand("Module")
    #       alphabetical listing
    #   * list of installed distribution files
    #       generated by parsing the BuildLogs
    #       in order of [successful] appearance, which can be thought
    #        of as a sequence fulfilling dependency requirements;
    #        the first occurence of a distribution is substituted with
    #        the currently installed version, later occurrences are
    #        omitted. We possibly produce dependency problems here
    #        when installing fresh with this clone, but having the
    #        complete module list above should have already installed
    #        the newest versions correctly, so that the distribution
    #        install either changes nothing or results in a downgrade.
    $mod=CPAN::Shell->expand("Module",'B'); 	# init CPAN, those messages might mix with ours
    # hack for complete history of all modules:
    # simulate they were all given on cmdline
    if ($CLONELIST eq 'all')
      { @all_modules=&All_Modules;
        $CLONELIST=join(',', map { $_->id; } @all_modules);
      }
    $localdistsourcesdir="$CPANHOME/sources/authors/id";
    foreach $id (split(',',$CLONELIST))
      { $mod=CPAN::Shell->expand("Module",$id); 
        next if ($showhist{$id});	# avoid duplicates
        $showhist{$id}=1;
        # look for local copies of older module source packages
        $file=$mod->cpan_file;
	($base,$path,$type,$dist_base,$dist_ver)=&distparse($file);
        push(@find_names, $dist_base) unless ($find_name{$dist_base});
	$find_name{$dist_base}=1;
        #$key=$path.$dist_base; 
        # leave out path with author initials and we can support maintainer change!
        $key=$dist_base;
        $path_base{$id}=$key;
	$RELEVANT_KEY{$key}=1;
      }

    &Eval_BuildLogs;
    
    # create a unique file name for the Clone
    # use underscore to separate components (BuildLogs use '-')
    # otherwise CPAN does not recognize it as a valid package name
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
    my $timedescr=sprintf("%04d_%02d_%02d_%02d%02d%02d", $year+1900, $mon+1, $mday,
                                                       $hour, $min, $sec);
    my $localtime=scalar(localtime);

    my $CloneAttemptModName="$BUNDLEDIR/Snapshot_${timedescr}_CloneAttempt_01mod.pm";
    my ($bundlename_mod)=fileparse($CloneAttemptModName, ".pm");
    my $CloneAttemptModFH=new FileHandle;
    open($CloneAttemptModFH, ">$CloneAttemptModName") ||
      die "cannot open file $CloneAttemptModName: $!"; 

    my $CloneAttemptPkgName="$BUNDLEDIR/Snapshot_${timedescr}_CloneAttempt_02packages.details.txt";
    my $CloneAttemptPkgFH=new FileHandle;
    open($CloneAttemptPkgFH, ">$CloneAttemptPkgName")
      || die "cannot open file $CloneAttemptPkgName: $!";

    my $CloneAttemptDistName="$BUNDLEDIR/Snapshot_${timedescr}_CloneAttempt_03dist.pm";
    my ($bundlename_dist)=fileparse($CloneAttemptDistName, ".pm");
    my $CloneAttemptDistFH=new FileHandle;
    open($CloneAttemptDistFH, ">$CloneAttemptDistName")
      || die "cannot open file $CloneAttemptDistName: $!";

    my $CloneAttemptDistTarName="$BUNDLEDIR/${bundlename_dist}.tar";

    @all_modules=&All_Modules unless (scalar @all_modules);
    @bundle=map { sprintf("%s %s\n", $_->id, $_->inst_version); } @all_modules;
    @distr= map { sprintf("%s\n", $LAST_INSTALLED_DISTR{$_}); } @DISTR_INSTALL_ORDER;
    #print join(",", map {  $LAST_INSTALLED_DISTR{$_} } @DISTR_INSTALL_ORDER),"\n";
    #-------------------------------------------------------------------
    # Create a tar file of the currently installed distribution files
    $tar=$CPAN::Config->{'tar'};
    if (! -x $tar)
      { warn "# no tar executable found at '$tar'"; }
    else
      { $cmd="$tar -cvf $CloneAttemptDistTarName -C $CPANHOME/sources/authors/id -T -";
        print "# invoking tar: $cmd\n";
        if (open(TAR, "| $cmd"))
          { print TAR join("", @distr)
              || warn "# error while sending bundle filenames to tar ($tar): $!\n";
          }
        else
          { warn "# unable to start tar ($tar): $!\n"; }
        close(TAR)
          || warn "# error while closing pipe to tar ($tar): $!\n";
        if (-r $CloneAttemptDistName)
          { print "# Wrote distribution clone archive to $CloneAttemptDistTarName\n";
          }
      }
    #-------------------------------------------------------------------
    # Create a Module snapshot, looking very much like an autobundle one
    # Bundle generation statement shamelessly ripped from CPAN.pm
    $CloneAttemptModFH->print(
               "package Bundle::$bundlename_mod;\n\n",
               "\$VERSION = '0.01';\n\n",
               "1;\n\n",
               "__END__\n\n",
               "=head1 NAME\n\n",
               "Bundle::$bundlename_mod - CloneAttempt snapshot of installation on ",
               $Config::Config{'myhostname'},
               " on ",
               scalar(localtime),
               "\n\n=head1 SYNOPSIS\n\n",
               "perl -MCPAN -e 'install Bundle::$bundlename_mod'\n\n",
               "=head1 CONTENTS\n\n",
               join("\n", @bundle),
               "\n\n=head1 CONFIGURATION\n\n",
               Config->myconfig,
               "\n\n=head1 AUTHOR\n\n",
               "This Bundle has been generated automatically ",
               "by the -clone routine in CPAN+changelog.pl.\n",
              ) || warn "# error writing to $CloneAttemptModName: $!";
    $CloneAttemptModFH->close;
    print "# Wrote modules clone file to $CloneAttemptModName\n";
    #-------------------------------------------------------------------
    # Create a distribution package list for the explicitly currently
    #   installed distributions
    my (%installed_distr);
    foreach $distr (values %LAST_INSTALLED_DISTR)
      { ($base,$path,$type,$dist_base,$dist_ver)=&distparse($distr);
        print "$distr -> $dist_base\n";
        $installed_distr{$dist_base}=$distr;
      }
    foreach $mod (@all_modules)
      { my ($base,$path,$type,$dist_base,$dist_ver)=&distparse($mod->cpan_file);
        #print $mod->id."  ".$mod->cpan_file." $dist_base $installed_distr{$dist_base}\n";
        if ($installed_distr{$dist_base})
          { 
            $line=sprintf("%-32s %8s %s\n", $mod->id, $mod->inst_version,
                                            $installed_distr{$dist_base});
            print $line;
            print $CloneAttemptPkgFH $line;
          }
      }
    $CloneAttemptPkgFH->close;
    print "# Wrote distr package list clone file to $CloneAttemptPkgName\n";
      
    #-------------------------------------------------------------------
    # Create a Snapshot containing the explicit distribution names
    #   currently installed
    # Bundle generation statement shamelessly ripped from CPAN.pm
    $CloneAttemptDistFH->print(
               "package Bundle::$bundlename_dist;\n\n",
               "\$VERSION = '0.01';\n\n",
               "1;\n\n",
               "__END__\n\n",
               "=head1 NAME\n\n",
               "Bundle::$bundlename_dist - CloneAttempt snapshot of installation on ",
               $Config::Config{'myhostname'},
               " on ",
               scalar(localtime),
               "\n\n=head1 SYNOPSIS\n\n",
               "perl -MCPAN -e 'install Bundle::$bundlename_dist'\n\n",
               "=head1 CONTENTS\n\n",
               join("\n", @distr),
               "\n\n=head1 CONFIGURATION\n\n",
               Config->myconfig,
               "\n\n=head1 AUTHOR\n\n",
               "This Bundle has been generated automatically ",
               "by the -clone routine in CPAN+changelog.pl.\n",
              ) || warn "# error writing to $CloneAttemptDistName: $!";
    $CloneAttemptDistFH->close;
    print "# Wrote distribution clone file to $CloneAttemptDistName\n";
  }

elsif ($MODE eq 'addignore')
  { my ($ignore_entry,%old_ignores,%new_ignores,$n_new,$mod,$comment);
    my ($distfile);
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
    my $timedescr=sprintf("%04d_%02d_%02d_%02d%02d%02d", $year+1900, $mon+1, $mday,
                                                       $hour, $min, $sec);

    $comment=$timedescr;
    %old_ignores=&Read_Ignores;
    foreach $ignore_entry (split(/,/, $ADDIGNORE_LIST))
      { if ($ignore_entry=~m{^./../.+/})
          { # arg is already a distribution file name
	    $distfile=$ignore_entry;
	  }
	else
          { # convert module name to distribution file name
            $mod=CPAN::Shell->expand("Module",$ignore_entry);
	    if (!defined($mod))
	      { print STDERR "no module $ignore_entry found, skipping\n";
	        next;
              }
	    $distfile=$mod->cpan_file;
          }
        if (exists($old_ignores{$distfile}))
          { print STDERR "addignore: $distfile already listed: ".
	                 "$old_ignores{$distfile}\n";
	  }
        else
	  { $new_ignores{$distfile}=$comment; 
	    print "addignore: added $distfile $comment\n";
	    $n_new++;
	  }
      }
    if ($n_new>0)
      { &Add_Ignores(%new_ignores); }
  }

elsif ($MODE eq 'delignore')
  { my ($ignore_entry,%ignores,$n_removed,$comment,$distfile);

    %ignores=&Read_Ignores;
    foreach $ignore_entry (split(/,/, $DELIGNORE_LIST))
      { if ($ignore_entry=~m{^./../.+/})
          { # arg is already a distribution file name
	    $distfile=$ignore_entry;
	  }
	else
          { # convert module name to distribution file name
            $mod=CPAN::Shell->expand("Module",$ignore_entry);
	    if (!defined($mod))
	      { print STDERR "no module $ignore_entry found, skipping\n";
	        next;
              }
	    $distfile=$mod->cpan_file;
          }
        if (!exists($ignores{$distfile}))
          { print STDERR "delignore: $distfile not on list\n"; }
        else
	  { $comment=$ignores{$distfile};
	    delete($ignores{$distfile});
	    print "delignore: removed $distfile $comment\n";
	    $n_removed++;
	  }
      }
    if ($n_removed>0)
      { &Write_Ignores(%ignores); }
  }

elsif ($MODE eq 'showignores')
  { my ($ignore_entry,%ignores,$comment,$n);
  
    $n=0;
    %ignores=&Read_Ignores;
    foreach $ignore_entry (sort { $ignore_entry{$a} cmp $ignore_entry{$b} } keys %ignores)
      { $comment=$ignores{$ignore_entry};
        print "$ignore_entry\t$comment\n";
        $n++;
      }
    if ($n==0)
      { print "ignore list is empty\n"; }
  }


else
  { print STDERR "ERROR: [internal] mode \"$MODE\" not handled\n";
    exit 99;
  }
                
      

sub All_Modules
  { my (@modlist, $mod);

    # next section copied from "perldoc CPAN"...
    # list all modules
    for $mod (CPAN::Shell->expand("Module","/./")){
      next unless $mod->inst_file;
      push(@modlist, $mod);
    }
    return(@modlist);
  }
  
sub Representative_Modules
  { my (@modlist, $mod);
    my (%seen, $file);

    # next section copied from "perldoc CPAN"...
    # list all first modules for all installation files
    for $mod (CPAN::Shell->expand("Module","/./")){
      next unless $mod->inst_file;
      $file=$mod->cpan_file;
      next if ($seen{$file});
      $seen{$file}=1;
      push(@modlist, $mod);
    }
    return(@modlist);
  }

sub Upgradeable_Modules
  { my (@modlist, $mod, $tmpmod);
    my (%seen, $file);
    my (%ignores);

    %ignores=&Read_Ignores;
    # next section copied from "perldoc CPAN"...
    # list all modules on my disk that have newer versions on CPAN
    for $mod (CPAN::Shell->expand("Module","/./")){
      next unless $mod->inst_file;
      next if ($mod->uptodate && $MODE ne 'init');
      $file=$mod->cpan_file;
      next if ($seen{$file});
      #printf "%s is installed as %s, could be updated to %s from CPAN %s\n",
      #       $mod->id, $mod->inst_version, $mod->cpan_version, $mod->cpan_file;
      $seen{$file}=1;
      next if ($file=~m/^Contact Author/); 	# not really a file to download...
      next if (exists($ignores{$file}));	# skip distfiles from ignorelist
      if ($file eq 'J/JA/JANL/w3mir-1.0.10.tar.gz' && $id eq 'htmlop')
        { # htmlop v0.2.6 is from w3mir-1.0.10.tar.gz, but 
          # it will always be shown to be upgradeable :-(
          ($tmpmod)=CPAN::Shell->expand("Module",$id);
          #push(@report, "# found htmlop ($file), ver ".$mod->inst_version."\n");
          if ($tmpmod->inst_version eq 'v0.2.6' || $tmpmod->inst_version eq 'w3mir')
            { $SKIPPED_MODULES{$id}=1;
              next;
            }
        }
      push(@modlist, $mod);
    }
    return(@modlist);
  }

sub work_on_modlist
  { my ($mode,@modlist)=@_;
    my ($mod);
    my (@report, @warns);
    my (%seen, $file);
    my ($inst_version, $cpan_version);
    my ($lno);
    my ($base,$path,$type,$dist_base);
    my ($dist_name, $dist);
    my ($report_ref, %report_ref_byname);

    sub add_warning
      { my ($warn_text)=@_;
        push(@warns,  "# WARN: $warn_text\n");
        #push(@report, "# WARN: $warn_text\n");
        push(@{$report_ref}, "# WARN: $warn_text\n");
      }

    sub add_report
      { my ($line)=@_;
        push(@{$report_ref}, $line);
      }
       
    foreach $mod (@modlist)
      { 
        $id=$mod->id;
        $report_ref=[]; $report_ref_byname{$id}=$report_ref;
        $inst_version=$mod->inst_version;
        $cpan_version=$mod->cpan_version;
        $file=$mod->cpan_file;
        ($base,$path,$type,$dist_base,$dist_ver)=&distparse($file);
        
        #print "# $id\t$file\t$base\t$path\t$type\n";
        next if ($seen{$file}); $seen{$file}=1;
        if ($dist_base eq 'perl')
          { # we won't do a complete perl update here
            $SKIPPED_MODULES{$id}=1;
            next;
          }
        # if we look for upgradeable modules ($mode eq 'r') then
        # we need to retrieve Changelogs from the current CPAN version
        # otherwise we (try to, see below) take them from the currently
	# installed distribution file
	$expanddir='';
    	&add_report('#'.('-'x71)."\n");
        if ($mode eq 'r')
          { $dist=CPAN::Shell->expand("Distribution", $file);
            if (!defined CPAN::Distribution::dir($dist))
              { eval { CPAN::Module::get($mod); };
                if ($@)
                  { &add_warning("get failed for $id with error: $@"); 
                    &add_warning("perhaps you need to remove $CPANHOME/sources/authors/id/$file");
                    $SKIPPED_MODULES{$id}=1;
                    next;		# do not proceed with failed item
                  }
              }
            $expanddir=CPAN::Distribution::dir($dist);
          }
        else
          { #($base,$path,$type)=fileparse($file,@DISTR_EXTENSIONS);
            #($dist_base,$dist_ver)=($base=~m/^(.*)-([\.0-9]+)$/);

            # $mod->cpan_file points to the newest distribution, not
	    #   the one $mod was extracted and built from.
            # We want to know which distribution version $mod came from,
	    #   but CPAN does not provide us with that information.
	    # This is a severe limitation of the Perl / CPAN build system.
	    # Unless manually removed, valid candidates are the
	    #   distribution files under $CPANHOME/sources/authors/id
	    #   (CPAN only purges the build cache under $CPANHOME/build/)
	    # But I could not find a deterministic way to find out module
	    #   version numbers inside a distribution file, or even 
	    #   which modules are provided from a distribution file
	    #   ($VERSION variable is set inside a module using perl code
	    #    and I could not be tempted to solve the halting problem;
	    #    if I knew the module names, I might mangle an unpacked
	    #    distribution directory into @INC and actually eval
            #    'use $mod;', but I deemed this to be rather fragile and
	    #    not worth the trouble, it is only problematic for '-init'
	    #    and when errors arise during '-install')
	    # 
	    # Assumption: a module with a changed version number is either
	    #          from CPAN current version or is from an explicitly
	    #          named distribution file.
	    #
	    # When installing multiple modules/bundles/distributions within 
	    #   a single invocation, modules from a distribution file on the
	    #   command line might be overwritten later with either another
	    #   distribution file version via cmd line or with the most 
	    #   recent CPAN version. The winner is the distfile version that
	    #   was installed last. In '-install' mode, the %INSTALLED_DIST
	    #   hash contains the distfile name that has been installed last,
	    #   found out by reading our own BuildLog ("Running make for...").
	    # Beware, this might still be inconsistent with module version
	    #   numbers, as the installation might have not finished for some
	    #   error. CPAN's install() functions do not return anything, so 
	    #   we do not get informed of errors during make/make install,
	    #   so we'd need more powerful BuildLog parsing.

            if ($INSTALLED_DIST{$dist_base})
	      { $dist_name=$INSTALLED_DIST{$dist_base}; }
	    else
	      { $dist_name=$file; }

            print "# Calling get for distribution $dist_name\n";
            $dist=CPAN::Shell->expand("Distribution", $dist_name);
            if ($dist)
              { if (!defined CPAN::Distribution::dir($dist))
                  { eval { CPAN::Distribution::get($dist); };
                    if ($@)
                      { &add_warning("get failed for distribution $dist with error: $@"); 
                        &add_warning("perhaps you need to remove $CPANHOME/sources/authors/id/$file");
                        $SKIPPED_MODULES{$id}=1;	# is this at all used when not doing -r ?
                        next;		# do not proceed with failed item
                      }
                  }
                $expanddir=CPAN::Distribution::dir($dist);
              }
            else
              { warn "# WARN: cannot expand distribution $dist_name"; }
          }
        @changelognames=&FindChangelog($expanddir);
        if (0 == scalar @changelognames)
          #{ warn "# no changelog found for $id"; }
          #{ push(@report, "# WARN: no changelog found for $id\n"); }
          { &add_warning("no changelog found for $id");
            push(@changelognames,'');
          }
        my $nchangelog=0;
        foreach $changelogname (@changelognames)
          { $nchangelog++;
            #$newchanges="$BUILDDIR/$base/$changelogname";
            $newchanges="$expanddir/$changelogname";
            $oldchanges="$CHLOGSDIR/$dist_base/$changelogname";
            if ($mode eq 'r')
              { # show changes against current CPAN version
                my ($mtime);
                if (-f $newchanges)
                  { ($mtime)=(stat($newchanges))[9]; }
                else
                  { ($mtime)=(stat($expanddir))[9]; }
                $CHANGELOG_MTIME{$id}=$mtime;
                my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($mtime);
                my $timedescr=sprintf("%04d%02d%02d-%02d%02d%02d", $year+1900, $mon+1, $mday,
                                                       $hour, $min, $sec);
    	        &add_report('#'.('-'x71)."\n") if ($nchangelog>1);
        	&add_report(sprintf ("# %s  %s  current:%s  cpan:%s\n", $timedescr,
                                       $id, $inst_version, $cpan_version));
                next unless (-f $newchanges);
                if (! -f $oldchanges)
    	          { &add_warning("no previous changelogs for $id at $oldchanges"); 
    	            #next;
    	          }          
    	        if (!open(DIFF, "diff --unidirectional-new-file $oldchanges $newchanges |"))
    	          { &add_warning("cannot start diff --unidirectional-new-file $oldchanges $newchanges");
                    next;
                  }
        	&add_report("# $id $file $oldchanges $newchanges\n");
                $lno=0;
                while (<DIFF>)
                  { &add_report($_);
                    $lno++;
                    if ($lno>=300)
                      { while (<DIFF>) { $lno++; }
			&add_report(sprintf("#   [ skipping %d lines of changelog for %s ]\n", $lno-300, $id));
                        last;
                      }
                  }
        	close(DIFF);
                if ($lno == 0)
                  { &add_warning("no changes found in $changelogname"); }
              }
            elsif ($mode eq 'init' || $mode eq 'install' || $mode eq 'update')
              { # fill in current changelogs
    	        # !!!WARNING!!! Changelogs are taken from current CPAN versions, 
    	        #               not locally installed versions!!!
		# only if we have installed an explicitly named distribution
	        # file within this program invocation we know how to choose the
		# correct non-CPAN-version (see long comment above)
                if (! -d "$CHLOGSDIR/$dist_base")
                  { if (!mkdir "$CHLOGSDIR/$dist_base")
                      { warn "# cannot create $CHLOGSDIR/$dist_base"; 
                        next;
                      }
                  }
                if (!open (NEW, "<$newchanges")) { warn "# cannot open $newchanges"; next; }
                if (!open (OLD, ">$oldchanges")) { warn "# cannot open $oldchanges"; next; }
                print OLD <NEW>;
                close(OLD);
                close(NEW);
                &add_report("# updated $oldchanges with $newchanges\n");
              }
          }
      }
    # put together the single reports in reverse mtime order
    # (newest information first)
    foreach $id (reverse sort { $CHANGELOG_MTIME{$a} cmp $CHANGELOG_MTIME{$b} } keys %CHANGELOG_MTIME)
      { push(@report, @{$report_ref_byname{$id}}); }

    if (0 == scalar @warns || scalar @report == scalar @warns)
      { # avoid unnecessary repetition of warnings
        return(@report);
      }
    else
      { # have all warnings appear at the beginning and at the end
        return('#'.('-'x71)."\n",@warns,@report,'#'.('-'x71)."\n",@warns);
      }
  }

# do the actual installation work
sub Do_Install
  { my (%ignores,$file);

    if ($FORCE)
      { print "# Force installing: $INSTALL_LIST\n"; }
    else
      { print "# Installing: $INSTALL_LIST\n"; }

    %ignores=&Read_Ignores;

    foreach $id (split(/,/,$INSTALL_LIST))
      { if (exists($ignores{$id}))
          { print "# ignoring $id: $ignores{$id}\n";
	    next;
	  }
        $mod=CPAN::Shell->expand("Module",$id);
	if ($mod)
	  { $file=$mod->cpan_file;
	    if (exists($ignores{$file}))
	      { print "# ignoring $id: $file $ignores{$file}\n";
	        next;
	      }
            push(@install_modlist, $mod);
	  }
      }
    if (scalar @install_modlist)
      { # only if there are modules to be installed
        @REPORT=&work_on_modlist('r', @install_modlist);
        if (scalar @REPORT)
          { # there might be blacklisted modules, so we check again
    	    print '#'.('-'x71)."\n";
            if ($FORCE)
              { print "# Force installing modules: $INSTALL_LIST\n"; }
            else
              { print "# Installing modules: $INSTALL_LIST\n"; }
            print grep { /^# .* current:.* cpan:/ } @REPORT;
            print @REPORT;
          }
      }
  
    # we need ',' to fit everything into 1 arg, but install()
    # wants single arg or array
    eval { foreach $id (split(/,/,$INSTALL_LIST))
             { print '#'.('-'x71)."\n";
	       if (exists($ignores{$id}))
                 { print "# ignoring $id: $ignores{$id}\n";
	           next;
                 }
               $mod=CPAN::Shell->expand("Module",$id);
	       if ($mod)
	         { # if $id is a Bundle or a Distribution, then
                   # calling inst_version or cpan_version might
	           # break the entire install loop
		   $file=$mod->cpan_file;
	           if (exists($ignores{$file}))
	             { print "# ignoring $id: $file $ignores{$file}\n";
	               next;
	             }
                   print sprintf ("# %s  current:%s  cpan:%s\n", $id,
                                  $mod->inst_version, $mod->cpan_version);
	         }
               # Term::ReadKey (CPAN::shell, CPANPLUS) wants to know terminal size for
               # Readline, but cannotdetermine the size when output is redirected to the
               # BuildLog.
               # Try to determine screen size from "stty -a" and set environment
               # variables
               if (-t STDIN) { &Get_Terminalsize; }

               if ($FORCE)
                 { print "# Calling CPAN::Shell->force('install',$id)\n";
                   CPAN::Shell->force('install',$id);
                 }
               else
                 { print "# Calling CPAN::Shell->install($id)\n";
                   CPAN::Shell->install($id);
                 }
               #print "# Returned from CPAN::Shell->install($id)\n";
             }
         };	# catch aborts with eval
    if ($@) 
      { print "\n# WARN: install broke with error $@\n"; }

  }

# install a CloneAttempt
sub Do_CloneInstall
  { 
    $dist='R/RH/RHANDOM/Net-Server-0.90.tar.gz';
    $mod='Net::Server';
    $id = $CPAN::META->instance('CPAN::Module',$mod);
    $dist_userid= $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;

    $userid = $id->userid || $dist_userid;
    $id->set(
             'CPAN_USERID' => $userid,
             'CPAN_VERSION' => $version,
             'CPAN_FILE' => $dist,
            );

    &Do_Install;
  }


sub Usage
  { print STDERR <<EOUSAGE;
Usage: CPAN+changelog.pl [-r] [-force] [-shell] [-install <module>,...] 
			[-history <module>,...] [-init] [-version] [-license]

shows Changelog entries for new versions of Perl modules on CPAN. Using the
CPAN module, upgrade recommendations are evaluated (similar to CPAN::Shell->r).
For upgradeable modules, the module distribution file will be downloaded and
unpacked, and changes in the Changelogs are displayed.

	-r	  default mode; see above
	-shell    invoke CPAN::shell, with output copied to a BuildLog file.
		    Upon exit, if there are changes in installed modules,
		    update local ChangeLog database and run autobundle().
                    Note: output is redirected via pipe to the tee program,
                          while CPANs terminal handling (via readline)
                          takes place on the tty. Therefore, command prompts
                          may not be exactly where you expect them.
                          Usually, an extra RETURN gets back the prompt.
	-install  install/upgrade named CPAN Perl modules, update local
		    Changelog database, and run autobundle()
	-history  shows upgrade installation history for named CPAN Perl
		    modules from autobundle()'d snapshots and shows local
		    copies of older module packages (downgrade candidates,
		    should the need ever arise) as well as the names of the
		    relevant BuildLogs
	-init	  populate ChangeLog directory
		      $CPAN::Config->{cpan_home}/ChangeLogs with
		    Changelogs from current CPAN module versions
		    Note: only do this when your Perl modules are in sync
		     with CPAN, otherwise the ChangeLogs database will be
		     inconsistent with your installation
	-force	  (only used with -install)
		    use CPANs "force install" instead of install
			!!! use with extreme caution !!!
		    -install will only accept a single install object
                   with -force set
	-addignore	add module or distribution file to ignore list
	-delignore	remove module or distribution file from ignore list
	-showignore	show complete ignore list
	-version	show version of CPAN+changelog.pl
	-license	show license of CPAN+changelog.pl
EOUSAGE
    exit(7);
  }

sub License
  { print "$DISCLAIMER\n";
    print "\n$LICENSE\n";
    print "\n$LICENSE_NOTES\n";
    exit(7);
  }


sub FindChangelog
  { my ($path)=@_;
    my ($changelogname, $candidate, $entry);
    my (@found_changelognames, @lcchangelognames);
    my (@direntries, @lcdirentries);

    #print "reading dir $path\n";
    opendir D, $path || warn "# cannot open $expanddir";
    @direntries=sort readdir(D);
    closedir(D);
    #print "direntries(",scalar @direntries,"):",join(",",@direntries),"\n";
    @lcchangelognames=map { lc($_); } @CHANGELOGNAMES;
    @found_changelognames=grep { $entry=lc($_); scalar grep { $entry eq $_; } @lcchangelognames; } @direntries;
    #print "# changelogs: ",join(",",@found_changelognames),"\n";
#    foreach $candidate (@CHANGELOGNAMES)
#      { #print "cand: $candidate\n";
#        ($changelogname)=grep { /^${candidate}$/i } sort @direntries;
#        last if (defined $changelogname);
#      }
#    return($changelogname);
    return(@found_changelognames);
  }

sub Err_SingleMode
  { print STDERR "ERROR: only use one of -r/-install/-history/-init/-shell/-clone\n";
    &Usage;
  }

# prepare logging of stdout and stderr to a buildlog file
sub Buildlog_Wrap
  { my ($wrapped_sub_ref, $wrapped_sub_args_ref)=@_;
    
    # create a unique file name for the build log
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
    my $timedescr=sprintf("%04d%02d%02d-%02d%02d%02d", $year+1900, $mon+1, $mday,
                                                       $hour, $min, $sec);
    my $template="BuildLog-$timedescr-XXXXXX";
    my ($BuildlogFH,$BuildlogName);
    ($BuildlogFH,$BuildlogName)=tempfile($template, DIR=>$BUILDLOGSDIR);
    die "error in tempfile: $!" if (!$BuildlogFH or !$BuildlogName);
    close($BuildlogFH);	# not needed, tee opens the file on its own
    # open a pipe to tee and redirect stdout and stderr to the pipe
    $BuildlogTeePid=open(TEE, "| tee $BuildlogName >&2"); autoflush TEE 1;
    open my $oldout, ">&STDOUT"     or die "Can't dup STDOUT: $!";
    open my $olderr, ">&STDERR"     or die "Can't dup STDERR: $!";
    close(STDOUT); open(STDOUT, ">&TEE") || die "Can't dup TEE: $!"; autoflush STDOUT 1;
    close(STDERR); open(STDERR, ">&TEE") || die "Can't dup TEE: $!"; autoflush STDERR 1;
    print "# all output will be copied to $BuildlogName\n";

    # 1. save current status
    print "# Finding version numbers for installed modules...\n";
    foreach $mod (&All_Modules)
      { $OLDVER{$mod->id}=$mod->inst_version;
        push(@modlist, $mod) unless ($mod->uptodate);
      }

    # 2. call the wrapped function
    eval { &$wrapped_sub_ref(@{$wrapped_sub_args_ref}); };
    if ($@) 
      { print "\n# WARN: buildlog-wrapped function broke with error $@\n"; } 

    # 3. check which modules have changed during install
    print '#'.('-'x71)."\n";
    print "# Finding new/changed modules...";
    @modlist=(); %seen=();
    foreach $mod (&All_Modules)
      { $CURRENT_VER{$mod->id}=$mod->inst_version;
        if ($CURRENT_VER{$mod->id} ne $OLDVER{$mod->id})
          { # new or updated module
            $file=$mod->cpan_file;
            next if ($seen{$file});
            $seen{$file}=1;
            push(@modlist,$mod);
            push(@CHANGED_MODULENAMES,$mod->id);
          }
      }
    # 3a. find the distribution files that have been tried to install
    open(BUILDLOGSOFAR, "<$BuildlogName") || warn ("# cannot open $BuildlogName: $!");
    while (<BUILDLOGSOFAR>)
      { if (m/^Running make for\s+(\S+)/)
	  { $file=$1;
            ($base,$path,$type,$dist_base,$dist_ver)=&distparse($file);
	    $INSTALLED_DIST{$dist_base}=$file;
	  }
      }
    close(BUILDLOGSOFAR);
	    

    # 4. create the current Snapshot Bundle
    if ($#modlist>=0)
      { # only if there has been anything successfully upgraded...
        print "\n# Updating Changelogs database...\n";
        @REPORT=&work_on_modlist('update', @modlist);
        print @REPORT;

	# snapshot bundle
        CPAN::Shell->autobundle;

        # show a diff between this and the last bundle
        opendir(BUNDLES, $BUNDLEDIR);
        @SNAPSHOTS=sort grep { m/^Snapshot_\d{4}_\d{2}_\d{2}_\d{2}.pm$/ } readdir BUNDLES;
        if (scalar @SNAPSHOTS >= 2)
          { $currentsnap=pop(@SNAPSHOTS);
            $lastsnap=pop(@SNAPSHOTS);
            print "# Autobundle changes:\n";
            system("diff $BUNDLEDIR/$lastsnap $BUNDLEDIR/$currentsnap");
          }
      }
    else
      { # strange: nothing updated
        print " none. autobundle() not called\n";
      }

    # 5. check for unchanged versions in modules that should have been upgraded
    @UNCHANGED_ID=grep { ($CURRENT_VER{$_} eq $OLDVER{$_}) && exists($CURRENT_VER{$_}) } split(',',$INSTALL_LIST);
    if (scalar @UNCHANGED_ID)
      { print "# WARN: unchanged version number in ", join(',',@UNCHANGED_ID),"\n"; }

    # 5a. check for changed versions of CPAN/CPANPLUS
    
    @CPANCHANGED=grep { m/\bCPAN\b/ } @CHANGED_MODULENAMES;
    @CPANPLUSCHANGED=grep { m/\bCPANPLUS\b/ } @CHANGED_MODULENAMES;
    if (scalar @CPANCHANGED)
      { print "# WARN: ",join(',',@CPANCHANGED)," have changed. CPAN might require reconfiguration.\n"; }
    if (scalar @CPANPLUSCHANGED)
      { print "# WARN: ",join(',',@CPANPLUSCHANGED)," have changed. CPANPLUS might require reconfiguration.\n"; }

    # close and compress the buildlog
    print "# BuildLog will be saved as $BuildlogName.gz\n";
    close(STDERR); close(STDOUT); close(TEE);
    open(STDOUT, ">&", $oldout); open(STDERR, ">&", $olderr);
    waitpid($BuildlogTeePid,0);
    system("gzip -9 $BuildlogName");
  }


# Term::ReadKey (CPAN::shell, CPANPLUS) wants to know terminal size for
# Readline, but cannotdetermine the size when output is redirected to the
# BuildLog.
# Try to determine screen size from "stty -a" and set environment
# variables
sub Get_Terminalsize
  { my ($item, $rows, $columns);

    # NetBSD2.1: <n> rows, Linux: rows <n>
    if (!open(STTY, "stty -a |"))
      { warn "# cannot start stty - not setting LINES/COLUMNS"; }
    else
      { while (<STTY>)
          { #print "stty>$_";
            while (m/\s*([^;]+);/g)
              { $item=$1;
                if ($item=~m/rows\s+(\d+)/ || $item=~m/(\d+)\s+rows/)
                  { $rows=$1; }
                if ($item=~m/columns\s+(\d+)/ || $item=~m/(\d+)\s+columns/) 
                  { $columns=$1; }
              }
          }
        
        if (!$rows || !$columns)
          { warn "# cannot determine rows/columns from stty - not setting LINES/COLUMNS"; }
        else
          { $ENV{"COLUMNS"}=$columns; $ENV{"LINES"}=$rows; }
       }
  }

# read all BuildLog files, record (relevant) distribution file installs
# as array refs in hash %UNASSIGNED_BUILDLOG (indexed by buildlog name)
# and remember their install order and last installed versions
# (@DISTR_INSTALL_ORDER, %LAST_INSTALLED_DISTR ( indexed by distr base name))
# also assign Snapshot files and BuildLog entries
# (%SNAPSHOT2BUILDLOG, BUILDLOG2SNAPSHOT)
sub Eval_BuildLogs
  {
    # look what has been tried to "make" in what BuildLog
    $cmd="ls $BUILDLOGSDIR/BuildLog-* | xargs zgrep -E -H ".
                  "'(^Running .* for )|".
                   "( -- OK\$)|".
                   "( -- NOT OK\$)|".
                   "(^# Installing: )|".
                   "(^# Force installing: )|".
                   "(^    $BUNDLEDIR/Snapshot_[0-9]*_[0-9]*_[0-9]*_[0-9]*\.pm\$)' |";
    #print "cmd: $cmd\n";
    open(MAKEFOR, $cmd)
      || warn "# cannot read BuildLog: $!";
    $key=''; $file='';
    $distr_install_log_ended=0;	# flags if current line means a previous install is finished (either OK or NOT OK)
    # do not use "next" statements in the following while loop, the section 
    # at the end is required
    while ($line=<MAKEFOR>)
      { #print $line;
        chomp $line;
        if ($line=~m/^(.*):/)
          { ($buildlog)=($1=~m/^([^:]*)/);	# remove possible '(standard input):' after filename (SuSE8.2)
            if ($buildlog ne $last_buildlog)
              { $distr_install_log_ended=1; }
          }
        else
          { warn "# zgrep - no buildlog filename found\n";
            next;
          }

        if ($line=~m/^(.*):(# (Force )?Installing: .*)$/i)
          { $what=$2;
            #($buildlog)=($1=~m/^([^:]*)/);	# remove possible '(standard input):' after filename (SuSE8.2)
            $INSTALLING{$buildlog}=$what;
          }
        elsif ($line=~m/^(.*):(Running make for (\S*))$/)
          { #print "found 'Running make for' $1 $3\n";
            $buildlog_entry=$2;
            $file=$3;
            #($buildlog)=($1=~m/^([^:]*)/);	# remove possible '(standard input):' after filename (SuSE8.2)
            #$buildlog=$1;

	    ($base,$path,$type,$dist_base,$dist_ver)=&distparse($file);
            #$key=$path.$dist_base; 
            # leave out path with author initials and we can support maintainer change!
            $key=$dist_base;
            $distr_install_log_ended=1;
            $ok=0;				# needs at least 1 "OK" to be 
						#    considered successful
            $not_ok=0;				# install unsuccessful if at
						#    least one "NOT OK" encountered
            $relevant=$RELEVANT_KEY{$key};	# save "relevant" state for following lines
            if ($relevant)
              {
                #print "  key: $key\n";
                $packagebuildlogref{$key}=[] unless (defined $packagebuildlogref{$key});
                # ls sorts entries, therefore this array is sorted, too
                push(@{$packagebuildlogref{$key}},$line);
	        $UNASSIGNED_BUILDLOG{$buildlog}=[] unless defined($UNASSIGNED_BUILDLOG{$buildlog});
	        #push(@{$UNASSIGNED_BUILDLOG{$buildlog}},$line);
	        push(@{$UNASSIGNED_BUILDLOG{$buildlog}},$buildlog_entry);
              }
          }
        elsif ($line=~m/^(.*):(.* --( NOT)? OK$)/)
          { #print "# debug: line='$line', key=$key, relevant=$relevant\n";
            if ($relevant)
              { $buildlog_entry=$2;
	        push(@{$UNASSIGNED_BUILDLOG{$buildlog}},$buildlog_entry);
                if ($3 eq ' NOT')
                  { $not_ok++; }
                else
                  { $ok++; }
              }
          }
        elsif ($line=~m/^(.*):    $BUNDLEDIR\/(Snapshot_\d+_\d+_\d+_\d+\.pm)/)
          { #print "found Snapshot created: $1 $2\n";
            $what=$2;
            #($buildlog)=($1=~m/^([^:]*)/);	# remove possible '(standard input):' after filename (SuSE8.2)
            $SNAPSHOT2BUILDLOG{$2}=$buildlog;
            $BUILDLOG2SNAPSHOT{$buildlog}=$what;
            $distr_install_log_ended=1;
          }

        # try to find currently installed distribution files and their
        # install order
        if ($distr_install_log_ended && $last_key)
          { # check if we had a successful install
            if ($last_ok>0 && $not_ok==0)
              { # success - note distr file name
                if (!$LAST_INSTALLED_DISTR{$last_distr_base})
                  { # first install of this distribution - note in ordered list
                    push(@DISTR_INSTALL_ORDER, $last_distr_base);
                  }
                $LAST_INSTALLED_DISTR{$last_distr_base}=$last_file;
              }
            $distr_install_log_ended=0;
          }
                
        $last_buildlog=$buildlog;
        $last_ok=$ok;
        $last_notok=$notok;
        $last_key=$key;
        $last_distr_base=$dist_base;
        $last_file=$file;
      }
    close(MAKEFOR);
    $distr_install_log_ended=1;
        if ($distr_install_log_ended && $last_key)
          { # check if we had a successful install
            if ($last_ok>0 && $not_ok==0)
              { # success - note distr file name
                if (!$LAST_INSTALLED_DISTR{$last_distr_base})
                  { # first install of this distribution - note in ordered list
                    push(@DISTR_INSTALL_ORDER, $last_distr_base);
                  }
                $LAST_INSTALLED_DISTR{$last_distr_base}=$last_file;
              }
            $distr_install_log_ended=0;
          }
  }

sub distparse
  { my ($dist)=@_;
    my ($base,$path,$type,$dist_base,$dist_ver);

    #print STDERR "distparse($dist)\n";
    ($base,$path,$type)=fileparse($dist,@DISTR_EXTENSIONS);
    ($dist_base,$dist_ver)=($base=~m/^(.*)-(v?[\.0-9]+)(?:-rc\d*)?$/i);
    return($base,$path,$type,$dist_base,$dist_ver);
  }


sub Read_Ignores
  { my (%ignore);
    my ($name,$comment);

    open(I, "<$IGNOREFILE");
    while (<I>)
      { chomp;
        ($name,$comment)=split(/\s+/,$_,2);
        if (length($name)>0)
          { $ignore{$name}=$comment; }
      }
    close(I);
    return(%ignore);
  }

sub Add_Ignores
  { my (%ignore)=@_;
    my ($k,$v);

    open(I, ">>$IGNOREFILE") || die "cannot write ignorefile $IGNOREFILE: $!";
    while (($k,$v)=each %ignore)
      { print I "$k $v\n" || die "error writing ignorefile $IGNOREFILE: $!"; }
    close(I) || die "error writing ignorefile $IGNOREFILE: $!";
  }

sub Write_Ignores
  { my (%ignore)=@_;
    my ($k,$v);

    open(I, ">$IGNOREFILE") || die "cannot write ignorefile $IGNOREFILE: $!";
    while (($k,$v)=each %ignore)
      { print I "$k $v\n" || die "error writing ignorefile $IGNOREFILE: $!"; }
    close(I) || die "error writing ignorefile $IGNOREFILE: $!";
  }