remove dupes
[andk-cpan-tools.git] / bin / show-history.pl
blob9b5f31b6e93ccd28257adeb9a626cef65178a5f3
1 #!/usr/local/bin/perl
3 =pod
5 $0 [--logs=logsdir] distro
7 looks at all dirents in logsdir (which defaults to C<./logs>). If an
8 entry looks like a megainstall directory it is probed for distro XML
9 file and if it is there, one line is output.
11 $0 --logs=megainstalldir
13 looks at all dirents in this megainstall directory that end in C<.xml>
14 and outputs a line for each.
16 =cut
19 use strict;
20 use warnings;
22 use FindBin ();
23 use Getopt::Long;
24 use XML::LibXML;
25 our %Opt;
27 sub Usage (){
28 "Usage: $0 [--logs=logsdirector] [distro]";
31 GetOptions(\%Opt, "logs=s"
32 ) or die Usage;
34 my $logdir = $Opt{logs} || "$FindBin::Bin/../logs";
35 opendir my $dh, $logdir or die "cannot opendir '$logdir': $!";
37 my $distro = shift;
38 if ($distro) {
39 $distro =~ s!\.(tar.gz|tgz|tar.bz2|tbz|zip)?$!.xml!;
40 $distro =~ s|$|.xml| unless $distro =~ /\.xml$/;
41 $distro =~ s|/|!|g;
43 my $p = XML::LibXML->new;
44 for my $dirent (sort readdir $dh) {
45 next if $dirent =~ /^\./;
46 my $abs = "$logdir/$dirent";
47 next unless $abs =~ /(?:^|\/)megainstall\.(\d+T\d+)\.d(?:\/|$)/;
48 my $time = $1;
49 my $xfile = sprintf "%s/%s", $logdir, $dirent;
50 $xfile .= "/$distro" if $distro;
51 next unless $xfile =~ /\.xml$/;
52 next unless -e $xfile;
53 my $xml = $p->parse_file($xfile);
54 my($ok,$seq,$perl,$patchlevel,$branch);
55 $ok = $xml->findvalue("/distro/\@ok");
56 $seq = $xml->findvalue("/distro/\@seq") || 0;
57 $perl = $xml->findvalue("/distro/\@perl");
58 ($branch,$patchlevel) = $perl =~ m|/installed-perls/(.*?)/p.*?/perl-5.*?@(\d+)|;
59 printf("%s %-10s %6d %4d %-6s",
60 $time,
61 $branch,
62 $patchlevel,
63 $seq,
64 $ok,
66 if ($distro) {
67 print "\n";
68 } else {
69 print " $dirent\n";