use Perl

In a similar vein to this post, I once again need to see which modules are loaded. However, even with Sean Burke's excellent Module::Versions::Report, I can't tell if modules without version numbers are different, so I hacked up my Loaded.pm (first link), to generate md5 sums if no version number is present -- very common with in-house code -- but also to let me filter my version lists:

package Loaded;

use strict;
use warnings;
use Module::Info;
use Digest::MD5 'md5_hex';

################################################################## ############

=head1 NAME

Loaded -- identify which modules are loaded

=head1 SYNOPSIS

use Test::More 'no_plan';
use Loaded;
# all your tests
END { diag Loaded::versions() }

=head1 DESCRIPTION

This module allows you to dump out a list of loaded module versions at any
point in a program (typically at the end).  This is useful when you debugging
subtle problems.  Dump the version lists from separate installations to a file
and run C<diff> on them.

However, sometimes modules (particularly in-house code) doesn't have version
numbers.  When that happens, we just try to read the code and call
C<Digest::MD5::md5_hex()> on it.

You can pass a string to the import list and only modules whose name matches
that string (as a regex) will be loaded:

use Loaded '^Template::';   # get versions of all loaded Template:: modules

END { diag Loaded::versions() }

=cut

my $TARGET;

sub import {
    my $class = shift;
    my ($regex) = @_;
    $TARGET = qr/$regex/ if @_;
}

sub versions {
    my @modules;
    my $max = 0;
    while ( my ( $module, $path ) = each %INC ) {
        $module =~ s/\.pm$//;
        $module =~ s/\//::/g;
        next if $module =~ /^::/;
        next if __PACKAGE__ eq $module;
        next if $TARGET && $module !~ $TARGET;

        if ( length $module > $max ) {
            $max = length $module;
        }
        push @modules => [ $module, get_identifier( $module, $path ) ];
    }
    @modules = sort { $a->[0] cmp $b->[0] } @modules;
    $max += 2;
    no warnings 'uninitialized';
    return join "\n", map { sprintf "%-${max}s %s", @$_ } @modules;
}

sub get_identifier {
    my ( $module, $path ) = @_;

    my $mod = Module::Info->new_from_loaded($module);
    my $version = $mod ? $mod->version : '';
    return $version if $version;

    open my $fh, '<', $path
      or return "Could not determine version";
    my $text = do { local $/; <$fh> };

    # attempt to account for line endings.  May be a stupid idea.
    $text =~ s/[\n\r]//g;
    return md5_hex($text);
}

1;

Sample partial output:

# Regexp::Common::net             2.105
# Regexp::Common::number          2.108
# Regexp::Common::profanity       2.104
# Regexp::Common::whitespace      2.103
# Regexp::Common::zip             2.112
# SQL::Stripper                   4c8c58da79dddb6eb8760980c4446f5e
# Scalar::Util                    1.19
# SelectSaver                     1.01
# Storable                        2.15
# Sub::Uplevel                    0.09
# Symbol                          1.06
# Test::Class::Base               4a4587ee0b4a6b7fe9753f3e73cf9aeb
# Test::Database                  c8263967ebe0a2295b7bb2802d515266