Extracting and accessing the release history in perlhist
I needed to make some charts showing the sequence of perl's releases, so I wrote some code to extract all that from perlhist. I thought I might turn it into a module or add it to Module::CoreList, but I have a lot of other things I need to do. If someone else wants to do that, however, here's my script:
#!perl
use 5.010;
use File::Basename;
use File::Which qw(which);
use File::Spec::Functions;
my %Months = qw(
Jan 1
Feb 2
Mar 3
Apr 4
May 5
Jun 6
Jul 7
Aug 8
Sep 9
Oct 10
Nov 12
Dec 12
);
my $perldoc = find_perldoc();
open my( $doc ), "$perldoc -m perlhist |";
1 until( <$doc> =~ /=head1 THE RECORDS/ );
1 until( <$doc> =~ /==================/ );
my $previous_maintainer;
until( (my $line = <$doc>) =~ /=head2 SELECTED RELEASE/ )
{
next if /^\s+$/;
my( $maintainer, $version, $date ) = unpack( 'A9 A14 A12', $line );
next unless $version;
$maintainer =~ s/^\s+|\s+$//;
$maintainer ||= $previous_maintainer;
$previous_maintainer = $maintainer;
$version =~ s/^\s*|\s*$//g;
$date =~ s/^\s*|\s*$//g;
my( $year, $month, $day ) = split /-/, $date;
next if $month eq '???' || $day eq '??';
warn "Month is undefined: $line\n" unless defined $month;
say join "\t", $maintainer, $version,
sprintf( "%4d%02d%02d", $year, $month, $day);
}
sub find_perldoc
{
# need to find the right perldoc for the perl we are running
my $dirname = dirname $^X; $dirname = '' if $dirname = '.';
my $basename = basename $^X;
my( $suffix ) = $basename =~ m/\Aperl(.*)/;
my $perldoc = catfile( $dirname ? $dirname : (), 'perldoc' . $suffix );
print "perldoc is $perldoc\n";
print "x: $^X d: $dirname b: $basename s: $suffix\n";
my $path = which( $perldoc );
print "$path\n";
die "$path is not executable\n" unless -x $path;
return $path;
}
I'm the author of Mastering Perl, and the co-author of Learning Perl (6th Edition), Intermediate Perl, Programming Perl (4th Edition) and Effective Perl Programming (2nd Edition).
C:\projects\sandbox>perl -v
This is perl, v5.10.1 built for MSWin32-x86-multi-thread
(with 2 registered patches, see perl -V for more detail)
Copyright 1987-2009, Larry Wall
Binary build 1007 [291969] provided by ActiveState http://www.ActiveState.com
Built Jan 26 2010 23:15:11
C:\projects\sandbox>diff -urN perlhist-orig.pl perlhistory.pl
--- perlhist-orig.pl Tue May 25 14:05:34 2010
+++ perlhistory.pl Tue May 25 14:00:06 2010
@@ -19,7 +19,7 @@
Oct 10
Nov 12
Dec 12
- );
+);
my $perldoc = find_perldoc();
@@ -28,8 +28,9 @@
1 until( =~ /==================/ );
my $previous_maintainer;
+
until( (my $line = ) =~ /=head2 SELECTED RELEASE/ ) {
- next if /^\s+$/;
+ next if $line =~ /^\s+$/;
my( $maintainer, $version, $date ) = unpack( 'A9 A14 A12', $line );
next unless $version;
@@ -45,25 +46,25 @@
next if $month eq '???' || $day eq '??';
warn "Month is undefined: $line\n" unless defined $month;
+ $month = $Months{$month};
+
say join "\t", $maintainer, $version,
sprintf( "%4d%02d%02d", $year, $month, $day);
}
sub find_perldoc {
-
# need to find the right perldoc for the perl we are running
- my $dirname = dirname $^X; $dirname = '' if $dirname = '.';
+ my $dirname = dirname $^X;
+ $dirname = '' if $dirname eq '.';
my $basename = basename $^X;
- my( $suffix ) = $basename =~ m/\Aperl(.*)/;
- my $perldoc = catfile( $dirname ? $dirname : (), 'perldoc' . $suffix );
+ my $perldoc = catfile( $dirname ? $dirname : (), 'perldoc' );
print "perldoc is $perldoc\n";
- print "x: $^X d: $dirname b: $basename s: $suffix\n";
+ print "x: $^X d: $dirname b: $basename \n";
my $path = which( $perldoc );
- print "$path\n";
die "$path is not executable\n" unless -x $path;
FWIW, Module::CoreList has a hash called %releases which contains a mapping of versions to release dates.
It doesn't have the maintainer name in it though.