bin/compare-snapshots.pl

   1 #!/usr/bin/perl
   2
   3 # use 5.010;
   4 use strict;
   5 use warnings;
   6
   7 =head1 NAME
   8
   9
  10
  11 =head1 SYNOPSIS
  12
  13  compare-snapshots.pl file file
  14
  15 =head1 OPTIONS
  16
  17 =over 8
  18
  19 =cut
  20
  21 my @opt = <<'=back' =~ /B<--(\S+)>/g;
  22
  23 =item B<--help|h!>
  24
  25 This help
  26
  27 =back
  28
  29 =head1 DESCRIPTION
  30
  31 Reads two snapshot files and outputs differing modules.
  32
  33 For the record, snapshot files are generated within the CPAN shell by
  34 running C<autobundle>, frequently with
  35
  36   echo autobundle | cpan
  37
  38 =head1 SEE ALSO
  39
  40 configdiff.pl
  41
  42 =cut
  43
  44
  45 use FindBin;
  46 use lib "$FindBin::Bin/../lib";
  47 BEGIN {
  48     push @INC, qw(       );
  49 }
  50
  51 use Dumpvalue;
  52 use File::Basename qw(dirname);
  53 use File::Path qw(mkpath);
  54 use File::Spec;
  55 use File::Temp;
  56 use Getopt::Long;
  57 use Hash::Util qw(lock_keys);
  58 use List::MoreUtils qw(uniq);
  59
  60 our %Opt;
  61 lock_keys %Opt, map { /([^=]+)/ } @opt;
  62 GetOptions(\%Opt,
  63            @opt,
  64           ) or pod2usage(1);
  65
  66 my($lfile,$rfile) = @ARGV;
  67 pod2usage(1) unless $rfile;
  68 my $left  = {};
  69 my $right = {};
  70 for my $tuple ([$left,$lfile],
  71                [$right,$rfile],
  72               ) {
  73     my($snap,$file) = @$tuple;
  74     open my $fh, $file or die "Could not open '$file': $!";
  75     my $in_list = 0;
  76   SNAPLINE: while (<$fh>) {
  77         if (/^=head1\sCONTENTS$/) {
  78             $in_list = 1;
  79             next SNAPLINE;
  80         } elsif (/^=head1\s/) {
  81             $in_list = 0;
  82         }
  83         next SNAPLINE unless $in_list;
  84         next SNAPLINE if /^\s*$/;
  85         my($mod,$v) = split " ", $_;
  86         $snap->{$mod} = $v;
  87     }
  88 }
  89 my(@miss_left,@miss_right,@diff_version);
  90 my $c1 = 0;
  91 for my $m (uniq keys %$left, keys %$right) {
  92     $c1 = length $m if length $m > $c1;
  93     if (! exists $right->{$m}) {
  94         push @miss_right, [$m, $left->{$m}];
  95         next;
  96     } elsif (! exists $left->{$m}) {
  97         push @miss_left, [$m, $right->{$m}];
  98         next;
  99     }
 100     next if $left->{$m} eq $right->{$m};
 101     push @diff_version, [$m, $left->{$m}, $right->{$m}];
 102 }
 103 my $c2 = 12;
 104 for my $tuple (sort {$a->[0] cmp $b->[0]} @miss_right) {
 105     printf "%${c1}s %${c2}s =>\n", @$tuple;
 106 }
 107 for my $tuple (sort {$a->[0] cmp $b->[0]} @miss_left) {
 108     while (length $tuple->[0] > $c1) {
 109         (my $trim,$tuple->[0]) = unpack("a" . $c1 . "a*", $tuple->[0]);
 110         print "$trim\n";
 111     }
 112     printf "%${c1}s %${c2}s => %${c2}s\n", $tuple->[0], "", $tuple->[1];
 113 }
 114 for my $tuple (sort {$a->[0] cmp $b->[0]} @diff_version) {
 115     printf "%${c1}s %${c2}s => %${c2}s\n", @$tuple;
 116 }
 117
 118 # Local Variables:
 119 # mode: cperl
 120 # cperl-indent-level: 4
 121 # End: