Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw

snapdiff -- Compare CPAN autobundle files

by Fletch (Chancellor)
on Oct 16, 2001 at 23:03 UTC ( #119222=sourcecode: print w/replies, xml ) Need Help??
Category: Utility Scripts
Author/Contact Info Mike Fletcher <>
Description: can create a bundle file which contains all of the modules which are currently installed on a box with its autobundle command. This program will compare two such snapshot files against each other, noting what modules are in the first but not in the second (and vice versa) as well as if there are differing versions of the same module. Handy if you're trying to duplicate the configuration of one box on another, or want to see what's changed over time if you keep historical bundles.
## snapdiff -- Compare the contents of two autobundle snapshot
##             files for differing versions
## Mike Fletcher <>
use strict;
use Pod::Parser;

  ## Define a Pod::Parser subclass that pulls version information out
  ## of the autobundle file
  package MyParser;

  our @ISA = qw( Pod::Parser );

  ## command -- note when we see `=head1 CONTENTS'
  sub command {
    my ($parser, $command, $paragraph, $line_num) = @_;

    if( $command eq 'head1' and $paragraph =~ /CONTENTS/ ) {
      $parser->{in_contents} = 1;
    } else {
      $parser->{in_contents} = undef;

  ## textblock -- Pull out module/version pairs if we're inside a
  ##              CONTENTS section
  sub textblock {
    my( $parser, $para, $line_num ) = @_;

    ## Ignore text if we haven't seen a `=head1 CONTENTS' command
    return unless $parser->{in_contents};

    $para =~ /(\S+)\s+(\S+)/;
    $parser->{results}->{$1} = $2;

## back in package main main

## Check that we're given two filenames
die "usage: $0 snap1 snap2\n" unless @ARGV == 2;

my( $snap1, $snap2 ) = @ARGV;

## Create some hashes to hold the results for each file
my $results = {
           $snap1 => {},
           $snap2 => {},

## To track mismatched versions that we've already seen
my %mismatch;

## Parse out the bundle contents from each file
foreach( $snap1, $snap2 ) {
  local( *IN );
  open( IN, $_ ) or die "Error opening $_: $!\n";

  ## Create new MyParser, passing it the hashref to store results into
  ## for the file in question
  my $p = MyParser->new( results => $results->{$_} );

  $p->parse_from_filehandle( \*IN );

  close( IN );

print "$snap1 vs $snap2\n";
cmp_hashes( $results->{$snap1}, $results->{$snap2}, \%mismatch );

print "\n\n$snap2 vs $snap1\n";
cmp_hashes( $results->{$snap2}, $results->{$snap1}, \%mismatch );

exit 0;

## cmp_hashes -- Compare contents of hash $ha to hash $hb.  $mismatch
##               contains keys we already know don't match
sub cmp_hashes {
  my( $ha, $hb, $mismatch ) = @_;

  foreach( sort keys %{ $ha } ) {
    ## format a nice, space justified version of name for printing
    my $name = sprintf "%-35s", $_;

    unless( exists $hb->{$_} ) {
      ## it exists in hash a but not b
      print "$name ver ", $ha->{$_}, " only here\n";
    } else {
      ## If they're not equal and we don't know about the mismatch
      ## already then gripe about it (and make note of the fact)
      if( $ha->{$_} ne $hb->{$_} and not $mismatch->{$_} ) {
    print "$name here ver ", $ha->{$_}, " there ver ", $hb->{$_}, "\n"
    $mismatch->{$_}++;    # note that there was a mismatch


Replies are listed 'Best First'.
Re: snapdiff -- Compare CPAN autobundle files
by JPeacock (Novice) on Jul 24, 2002 at 13:58 UTC
    Excellent! This is exactly what I needed right now. I bought a couple of Cobalt RaQ's to use as qmail relay boxes, but I couldn't stomach running 5.005_03. Now I can figure out what modules to install in order to replicate the management interface in 5.6.1 (can't go to 5.8.0 because it won't run the mod_perl that I cannot upgrade just yet). Thanks
Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://119222]
Discipulus thanks back and passes around a weis bier in the berghastof hummelei celebrative glass

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (5)
As of 2018-05-25 17:03 GMT
Find Nodes?
    Voting Booth?