first commit: repackaged Devel::ModInfo -> Devel::ModuleDumper

Build.PL

@@ -13,10 +13,10 @@ my $builder = Module::Build->new(
     },
     build_requires      => {
         'Test::More' => 0.88,
+        'Capture::Tiny' => 0,
     },
     requires => {
         'perl' => '5.008001',
-        'Carp' => 0,
     },
     add_to_cleanup      => [ 'Devel-ModuleDumper-*' ],
     meta_merge     => {

META.json

@@ -0,0 +1,53 @@
+{
+   "abstract" : "show module information automatically",
+   "author" : [
+      "Dai Okabayashi <bayashi@cpan.org>"
+   ],
+   "dynamic_config" : 1,
+   "generated_by" : "Module::Build version 0.4005, CPAN::Meta::Converter version 2.132830",
+   "license" : [
+      "perl_5"
+   ],
+   "meta-spec" : {
+      "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+      "version" : "2"
+   },
+   "name" : "Devel-ModuleDumper",
+   "prereqs" : {
+      "build" : {
+         "requires" : {
+            "Capture::Tiny" : "0",
+            "Test::More" : "0.88"
+         }
+      },
+      "configure" : {
+         "requires" : {
+            "Module::Build" : "0.38"
+         }
+      },
+      "runtime" : {
+         "requires" : {
+            "perl" : "5.008001"
+         }
+      }
+   },
+   "provides" : {
+      "Devel::ModuleDumper" : {
+         "file" : "lib/Devel/ModuleDumper.pm",
+         "version" : "0.01"
+      }
+   },
+   "release_status" : "stable",
+   "resources" : {
+      "bugtracker" : {
+         "web" : "http://github.com/bayashi/Devel-ModuleDumper/issues"
+      },
+      "license" : [
+         "http://dev.perl.org/licenses/"
+      ],
+      "repository" : {
+         "url" : "http://github.com/bayashi/Devel-ModuleDumper"
+      }
+   },
+   "version" : "0.01"
+}

lib/Devel/ModuleDumper.pm

@@ -1,34 +1,221 @@
 package Devel::ModuleDumper;
 use strict;
 use warnings;
-use Carp qw/croak/;
+
+our %seen;
+BEGIN {
+    %seen = %INC;
+}
 
 our $VERSION = '0.01';
 
-sub new {
-    my $class = shift;
-    my $args  = shift || +{};
+our %pragmas;
+for my $pragma (qw/
+    charnames  constant
+    diagnostics
+    encoding
+    feature  fields  filetest
+    if  integer
+    less  lib  locale
+    mro
+    open  ops  overload  overloading
+    parent
+    re
+    sigtrap  sort  strict  subs
+    threads  threads::shared
+    utf8
+    vars  vmsish
+    warnings  warnings::register
+/) {
+    $pragmas{$pragma} = 1;
+}
+
+our %skips;
+for my $class (qw/
+    AutoLoader
+    Benchmark
+    base
+    bytes
+    Config
+    DynaLoader
+    XSLoader
+/) {
+    $skips{$class} = 1;
+}
+
+my $ALL = $ENV{MODULEDUMPER_SHOW_ALL};
+
+our $SHOWN = 0;
+
+sub show {
+    my $result = '';
+
+    return $result if $SHOWN;
+
+    my $modules = _get_module_information();
+
+    $result .= "Perl\t$]\n";
+
+    for my $module (sort { uc($a) cmp uc($b) } keys %{$modules}) {
+        $result .= sprintf "%s\t%s\n", $module, $modules->{$module}->{version};
+    }
+
+    $SHOWN = 1;
 
-    bless $args, $class;
+    return $result;
 }
 
+sub _get_module_information {
+    my %modules;
+    for my $module_path (keys %INC) {
+        my $class = _path2class($module_path);
+        unless ($ALL) {
+            next if $seen{$module_path}
+                        || $module_path !~ m!\.pm$!
+                        || $pragmas{$class}
+                        || $skips{$class}
+                        || $class eq __PACKAGE__;
+        }
+        $modules{$class} = {
+            version => _get_version($class),
+        };
+    }
+    return \%modules;
+}
+
+sub _path2class {
+    my $path = shift;
+
+    my $class = $path;
+    $class =~ s!/!::!g;
+    $class =~ s!\.pm$!!;
+
+    return $class;
+}
+
+sub _get_version {
+    my $module = shift;
+
+    my $version = eval {
+        my $v = $module->VERSION;
+        unless (defined $v) {
+            $v = ${"${module}::VERSION"};
+        }
+        $v;
+    };
+    if ($@ || !defined $version) {
+        $version = 'none';
+    }
+
+    return $version;
+}
+
+END {
+    my $info = show();
+    print $info;
+}
+
+package # hide the package from the PAUSE indexer
+    DB;
+sub DB {}
+
 1;
 
 __END__
 
 =head1 NAME
 
-Devel::ModuleDumper - one line description
+Devel::ModuleDumper - show module information automatically
 
 
 =head1 SYNOPSIS
 
-    use Devel::ModuleDumper;
+    $ perl -d:ModuleDumper -MData::Dumper -e 'print "foo!\n"'
+    foo!
+    Perl    5.012002
+    Carp    1.17
+    Data::Dumper    2.125
+    Exporter        5.64_01
 
 
 =head1 DESCRIPTION
 
-Devel::ModuleDumper is
+C<Devel::ModuleDumper> shows the module information at the end of your script.
+
+This module is especially useful for a L<Benchmark> report.
+
+For example, here is the benchmark script.
+
+    # crypt_benchmark.pl
+    
+    use strict;
+    use warnings;
+
+    use Benchmarks sub {
+
+        use Digest::HMAC_SHA1 qw(hmac_sha1_hex);
+        use Digest::HMAC_MD5 qw(hmac_md5_hex);
+
+        my $STR = '@test123';
+        my $KEY = 'ABC';
+
+        {
+            'hmac_sha1' => sub { hmac_sha1_hex($STR, $KEY); },
+            'hmac_md5'  => sub { hmac_md5_hex($STR, $KEY); },
+            'crypt'     => sub { crypt($STR, $KEY); },
+        };
+    };
+
+To invoke with C<Devel::ModuleDumper>.
+
+    $ perl -d:ModuleDumper crypt_benchmark.pl
+    
+    Benchmark: running crypt, hmac_md5, hmac_sha1 for at least 1 CPU seconds...
+         crypt:  1 wallclock secs ( 1.06 usr +  0.00 sys =  1.06 CPU) @ 108196.23/s (n=114688)
+      hmac_md5:  1 wallclock secs ( 1.10 usr +  0.00 sys =  1.10 CPU) @ 195490.00/s (n=215039)
+     hmac_sha1:  1 wallclock secs ( 1.03 usr +  0.00 sys =  1.03 CPU) @ 111346.60/s (n=114687)
+                  Rate     crypt hmac_sha1  hmac_md5
+    crypt     108196/s        --       -3%      -45%
+    hmac_sha1 111347/s        3%        --      -43%
+    hmac_md5  195490/s       81%       76%        --
+    
+    Perl    5.012002
+    Benchmarks      0.05
+    Carp    1.17
+    Digest::base    1.16
+    Digest::HMAC    1.03
+    Digest::HMAC_MD5        1.01
+    Digest::HMAC_SHA1       1.03
+    Digest::MD5     2.39
+    Digest::SHA     5.47
+    Exporter        5.64_01
+    Exporter::Heavy 5.64_01
+    MIME::Base64    3.08
+    Time::HiRes     1.9719
+
+All you need to do is add C<-d:ModuleDumper>.
+
+
+=head1 ENVIRONMENT VARIABLE
+
+=over
+
+=item MODINFO_SHOW_ALL
+
+By default, some modules are filtered. If you set C<MODULEDUMPER_SHOW_ALL=1>, all module information will output.
+
+=back
+
+
+=head1 METHOD
+
+=over
+
+=item show
+
+To build an information of modules. This method returns the string;
+
+=back
 
 
 =head1 REPOSITORY
@@ -43,11 +230,6 @@ Welcome your patches and issues :D
 Dai Okabayashi E<lt>bayashi@cpan.orgE<gt>
 
 
-=head1 SEE ALSO
-
-L<Other::Module>
-
-
 =head1 LICENSE
 
 This module is free software; you can redistribute it and/or

t/01_basic.t

@@ -1,11 +1,17 @@
 use strict;
 use warnings;
+use Devel::ModuleDumper;
 use Test::More;
+use Capture::Tiny qw/capture_stdout/;
 
-use Devel::ModuleDumper;
+my $stdout = capture_stdout { print Devel::ModuleDumper::show(); };
 
-can_ok 'Devel::ModuleDumper', qw/new/;
+like $stdout, qr/^Perl\t\d+/;
+like $stdout, qr/Test::More\t\d+/;
+like $stdout, qr/Capture::Tiny\t\d+/;
 
-# write more tests
+if ($ENV{AUTHOR_TEST}) {
+    note $stdout;
+}
 
 done_testing;

t/02_all_modules.t

@@ -0,0 +1,24 @@
+use strict;
+use warnings;
+
+BEGIN {
+    $ENV{MODULEDUMPER_SHOW_ALL} = 1;
+}
+
+use Devel::ModuleDumper;
+use Test::More;
+use Capture::Tiny qw/capture_stdout/;
+
+my $stdout = capture_stdout { print Devel::ModuleDumper::show(); };
+
+like $stdout, qr/^Perl\t\d+/;
+like $stdout, qr/Test::More\t\d+/;
+like $stdout, qr/Capture::Tiny\t\d+/;
+
+like $stdout, qr/strict\t\d+/;
+
+if ($ENV{AUTHOR_TEST}) {
+    note $stdout;
+}
+
+done_testing;

t/03_show_again.t

@@ -0,0 +1,38 @@
+use strict;
+use warnings;
+use Devel::ModuleDumper;
+use Test::More;
+use Capture::Tiny qw/capture_stdout/;
+
+{
+    my $stdout = capture_stdout { print Devel::ModuleDumper::show(); };
+
+    like $stdout, qr/^Perl\t\d+/;
+    like $stdout, qr/Test::More\t\d+/;
+    like $stdout, qr/Capture::Tiny\t\d+/;
+
+    if ($ENV{AUTHOR_TEST}) { note "1st:\n". $stdout; }
+}
+
+{
+    my $stdout = capture_stdout { print Devel::ModuleDumper::show(); };
+
+    is   $stdout, '';
+    isnt $stdout, undef;
+
+    if ($ENV{AUTHOR_TEST}) { note "2nd:\n". $stdout; }
+}
+
+{
+    $Devel::ModuleDumper::SHOWN = 0; # reset flag
+
+    my $stdout = capture_stdout { print Devel::ModuleDumper::show(); };
+
+    like $stdout, qr/^Perl\t\d+/;
+    like $stdout, qr/Test::More\t\d+/;
+    like $stdout, qr/Capture::Tiny\t\d+/;
+
+    if ($ENV{AUTHOR_TEST}) { note "3rd:\n". $stdout; }
+}
+
+done_testing;