Recently I realized that I had many outdated CPAN modules - and their associated bugs.

The CPAN POD has a few lines about how to interrogate the CPAN database from a script, but it really didn't do what I wanted. So, out came the coding pencil...

Here's what I came up with. It reports by distributions, not modules so the number of things to update is minimized. You can get module level detail, or course. You can run it as a cron job, exclude modules and/or distributions that you don't want to update (say, you have a local custom version or the latest is broken on your machine), get list of install commands for new modules. (I don't like stealth updates by automated processes - too much risk of something breaking.)

I run it as a weekly cron job with a few exclustions. It works for me; perhaps it will work for you. 

#!/usr/bin/perl

use strict;
use warnings;

use CPAN;
use File::Basename;

my $prog = fileparse($0);

sub usage() {
    print <<"HELP";
$prog helps you to maintain CPAN modules.

-c      This is a cron job.  Output '$prog: ' at the start of each lin
+e so
        $prog | grep -P '^$prog: ' will send mail only when updated mo
+dules are
        available.

-d      Print raw, unfiltered module data for debugging.

-i      Output just install commands for updated modules.

-x mod  Exclude modules that you don't want to update for administrati
+ve reasons

-X dst  Exclude distributions that you don't want to update for admini
+strative reasons

-v      Verbose output: List each module that needs updating, not just
+ distributions.

Exclusions will match versions:
  -X perl       Will not report perl updates (any version)
  -X perl-5.12  Will not report perl 5.12 (or 5.12.3)
and module names:
  -x ModPerl::MethodLookup

Administrative reasons might be an incompatibility with your software,
+ or perhaps
a dependency on a package not yet available for your platform.
HELP
    exit 1;
}

my( $d_cmd, $i_cmd, $c_cmd, $v_cmd, %x, %X );

$c_cmd = '';
while( $ARGV[0] && $ARGV[0] =~ m/^-/ ) {
  my $s = shift @ARGV;

  if( $s eq '-c' ) {
      $c_cmd = "$prog: ";
      next;
  }
  if( $s eq '-d' ) {
      $d_cmd = 1;
      next;
  }
  if( $s eq '-i' ) {
      $i_cmd = 1;
      next;
  }
  if( $s eq '-v' ) {
      $v_cmd = 1;
      next;
  }

  if( $s =~ /^-(h|\?)/ ) {
      usage();
      exit;
  }

  my $a = shift @ARGV if( $ARGV[0] !~ m/^-/ );
  if( $s =~ /^-x$/i ) {
      die "argument required for $s\n" unless( $a );

      my( $m, $v );
      if( $a =~ /(.*?)-(\d+\.\d+(?:\.\d+)*)$/ ) {
        ($m, $v) = ($1, ($2 || ''));
      } else {
        $m = $a;
        $v = '*';
      }
      if( $s eq '-x' ) {
        $x{$m} = $v;
      } else {
        $X{$m} = $v;
      }
      next;
  }

  die "$prog: Unknown switch \"$s\", try -h\n";
}

# Redirect stdout so we can filter idle chatter - especially
# for cron jobs and e-mail.

open my $oldout, ">&STDOUT"     or die "Can't dup STDOUT: $!\n";
my $out = '';
close STDOUT;
open STDOUT, ">", \$out or die "Can't redirect STDOUT\n";

my %dists;
for my $mod  (CPAN::Shell->expand("Module","/./")) {
    next unless $mod->inst_file;
    next if $mod->uptodate;
    printf "CPAN-update: Module %s version %s installed; version %s is
+ available.\n",
            $mod->id, $mod->inst_version, $mod->cpan_version if( $d_cm
+d );

    if( (my $xv = $x{$mod->id}) ) {
      next if( $xv eq '*' || $mod->cpan_version =~ /^$xv/ );
    }

    my $dist = CPAN::Shell->expand(
                                    "Module", $mod->id
                                  )->distribution();
    my $distribution = $dist->base_id();
    my( $m, $v );
    if( $distribution =~ /(.*?)-(\d+\.\d+(?:\.\d+)*)$/ ) {
      ($m, $v) = ($1, ($2 || ''));
    } else {
      $m = $distribution;
      $v = '*';
    }
    if( (my $xv = $X{$m}) ) {
      next if( $xv eq '*' || $v =~ /^$xv/ );
    }
    unless( $dists{$distribution} ) {
        $dists{$distribution} = { count => 0,
                                  name => $dist->pretty_id,
                                  modlist => {},
        };
    }
    $dists{$distribution}{count}++;
    $dists{$distribution}{modlist}{$mod->id}{inst} = $mod->inst_versio
+n;
    $dists{$distribution}{modlist}{$mod->id}{new} = $mod->cpan_version
+;
}
for my $d (sort keys %dists) {
    my( $m, $v );
    if( $d =~ /(.*?)-(\d+\.\d+(?:\.\d+)*)$/ ) {
        ($m, $v) = ($1, " to version " . ($2 || '?'));
    } else {
        $m = $d;
        $v = '';
    }

    if( $i_cmd ) {
        printf "%sinstall %s\n", $c_cmd, $dists{$d}{name};
        next;
    }
    my $c = $dists{$d}{count};
    printf "%s%s should be updated%s for %d module%s\n", $c_cmd, $m, $
+v, $c, ($c == 1? '' : 's');
    if( $v_cmd ) {
        for my $m (sort keys %{$dists{$d}{modlist}}) {
            printf "%s    %s: installed version %s, new version %s\n",
+ $c_cmd, $m,
                             $dists{$d}{modlist}{$m}{inst},
                             $dists{$d}{modlist}{$m}{new};
        }
    }
}

close STDOUT;
open STDOUT, ">&", $oldout or die "Can't re-redirect STDOUT:$!\n";
close $oldout;

# Strip idle chatter (conveniently, ANSI highlighting marks most of th
+e offensive lines)

print map { ( m!^\033|(?:\s*ftp://.*/CPAN/(?:modules|authors)/)!? '' :
+ "$_\n" ) } split( "\n", $out );

[download]

This communication may not represent my employer's views, if any, on the matters discussed.

Back to Cool Uses for Perl