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 FTR, snapshot files are generated within the CPAN shell by running C<autobundle>.
  34
  35 =head1 SEE ALSO
  36
  37 configdiff
  38
  39 =cut
  40
  41
  42 use FindBin;
  43 use lib "$FindBin::Bin/../lib";
  44 BEGIN {
  45     push @INC, qw(       );
  46 }
  47
  48 use Dumpvalue;
  49 use File::Basename qw(dirname);
  50 use File::Path qw(mkpath);
  51 use File::Spec;
  52 use File::Temp;
  53 use Getopt::Long;
  54 use Hash::Util qw(lock_keys);
  55 use List::MoreUtils qw(uniq);
  56
  57 our %Opt;
  58 lock_keys %Opt, map { /([^=]+)/ } @opt;
  59 GetOptions(\%Opt,
  60            @opt,
  61           ) or pod2usage(1);
  62
  63 my($lfile,$rfile) = @ARGV;
  64 pod2usage(1) unless $rfile;
  65 my $left  = {};
  66 my $right = {};
  67 for my $tuple ([$left,$lfile],
  68                [$right,$rfile],
  69               ) {
  70     my($snap,$file) = @$tuple;
  71     open my $fh, $file or die "Could not open '$file': $!";
  72     my $in_list = 0;
  73   SNAPLINE: while (<$fh>) {
  74         if (/^=head1\sCONTENTS$/) {
  75             $in_list = 1;
  76             next SNAPLINE;
  77         } elsif (/^=head1\s/) {
  78             $in_list = 0;
  79         }
  80         next SNAPLINE unless $in_list;
  81         next SNAPLINE if /^\s*$/;
  82         my($mod,$v) = split " ", $_;
  83         $snap->{$mod} = $v;
  84     }
  85 }
  86 my(@miss_left,@miss_right,@diff_version);
  87 my $c1 = 0;
  88 for my $m (uniq keys %$left, keys %$right) {
  89     $c1 = length $m if length $m > $c1;
  90     if (! exists $right->{$m}) {
  91         push @miss_right, [$m, $left->{$m}];
  92         next;
  93     } elsif (! exists $left->{$m}) {
  94         push @miss_left, [$m, $right->{$m}];
  95         next;
  96     }
  97     next if $left->{$m} eq $right->{$m};
  98     push @diff_version, [$m, $left->{$m}, $right->{$m}];
  99 }
 100 my $c2 = 12;
 101 for my $tuple (sort {$a->[0] cmp $b->[0]} @miss_right) {
 102     printf "%${c1}s %${c2}s =>\n", @$tuple;
 103 }
 104 for my $tuple (sort {$a->[0] cmp $b->[0]} @miss_left) {
 105     while (length $tuple->[0] > $c1) {
 106         (my $trim,$tuple->[0]) = unpack("a" . $c1 . "a*", $tuple->[0]);
 107         print "$trim\n";
 108     }
 109     printf "%${c1}s %${c2}s => %${c2}s\n", $tuple->[0], "", $tuple->[1];
 110 }
 111 for my $tuple (sort {$a->[0] cmp $b->[0]} @diff_version) {
 112     printf "%${c1}s %${c2}s => %${c2}s\n", @$tuple;
 113 }
 114
 115 # Local Variables:
 116 # mode: cperl
 117 # cperl-indent-level: 4
 118 # End: