File: Report.pm

package info (click to toggle)
libmodule-versions-report-perl 1.02-1
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 60 kB
  • ctags: 9
  • sloc: perl: 58; makefile: 44
file content (157 lines) | stat: -rw-r--r-- 4,528 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157

require 5;
package Module::Versions::Report;
$VERSION = '1.02';

=head1 NAME

Module::Versions::Report -- report versions of all modules in memory

=head1 SYNOPSIS

  use Module::Versions::Report;
  
  ...and any code you want...

This will run all your code normally, but then as the Perl
interpreter is about to exit, it will print something
like:

  Perl v5.6.1 under MSWin32.
   Modules in memory:
    attributes;
    AutoLoader v5.58;
    Carp;
    Config;
    DynaLoader v1.04;
    Exporter v5.562;
    Module::Versions::Report v1.01;
    HTML::Entities v1.22;
    HTML::HeadParser v2.15;
    HTML::Parser v3.25;
    [... and whatever other modules were loaded that session...]

Consider its use from the command line:

  % perl -MModule::Versions::Report -MLWP -e 1

  Perl v5.6.1 under MSWin32.
   Modules in memory:
    attributes;
    AutoLoader v5.58;
    [...]

=head1 DESCRIPTION

I often get email from someone reporting a bug in a module I've
written.  I email back, asking what version of the module it is,
what version of Perl on what OS, and sometimes what version of
some relevent third library (like XML::Parser).  They reply,
saying "Perl 5".  I say "I need the exact version, as reported
by C<perl -v>".  They tell me.  And I say "I, uh, also asked about
the version of my module and XML::Parser [or whatever]".  They say
"Oh yeah.  It's 2.27".  "Is that my module or XML::Parser?" 
"XML::Parser."  "OK, and what about my module's
version?"  "Ohyeah.  That's 3.11."  By this time, days have passed,
and what should have been a simple operation -- reporting the version
of Perl and relevent modules, has been needlessly complicated.

This module is for simplifying that task.  If you add "use
Module::Versions::Report;" to a program (especially handy if your
program is one that demonstrates a bug in some module), then when the
program has finished running, you well get a report detailing the all
modules in memory, and noting the version of each (for modules that
defined a C<$VERSION>, at least).

=head1 COPYRIGHT AND DISCLAIMER

Copyright 2001-2003 Sean M. Burke. This library is free software; you
can redistribute it and/or modify it under the same terms as Perl
itself.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=head1 AUTHOR

Sean M. Burke, E<lt>sburke@cpan.orgE<gt>

=cut

sub report {
  my @out;
  push @out,
    "\n\nPerl v",
    defined($^V) ? sprintf('%vd', $^V) : $],
    " under $^O ",
    (defined(&Win32::BuildNumber) and defined &Win32::BuildNumber())
      ? ("(Win32::BuildNumber ", &Win32::BuildNumber(), ")") : (),
    (defined $MacPerl::Version)
      ? ("(MacPerl version $MacPerl::Version)") : (),
    "\n"
  ;

  # Ugly code to walk the symbol tables:
  my %v;
  my @stack = ('');  # start out in %::
  my $this;
  my $count = 0;
  my $pref;
  while(@stack) {
    $this = shift @stack;
    die "Too many packages?" if ++$count > 1000;
    next if exists $v{$this};
    next if $this eq 'main'; # %main:: is %::

    #print "Peeking at $this => ${$this . '::VERSION'}\n";
    
    if(defined ${$this . '::VERSION'} ) {
      $v{$this} = ${$this . '::VERSION'}
    } elsif(
       defined *{$this . '::ISA'} or defined &{$this . '::import'}
       or ($this ne '' and grep defined *{$_}{'CODE'}, values %{$this . "::"})
       # If it has an ISA, an import, or any subs...
    ) {
      # It's a class/module with no version.
      $v{$this} = undef;
    } else {
      # It's probably an unpopulated package.
      ## $v{$this} = '...';
    }
    
    $pref = length($this) ? "$this\::" : '';
    push @stack, map m/^(.+)::$/ ? "$pref$1" : (), keys %{$this . '::'};
    #print "Stack: @stack\n";
  }
  push @out, " Modules in memory:\n";
  delete @v{'', '<none>'};
  foreach my $p (sort {lc($a) cmp lc($b)} keys %v) {
    #$indent = ' ' x (2 + ($p =~ tr/:/:/));
    push @out,  '  ',
      # $indent,
      $p, defined($v{$p}) ? " v$v{$p};\n" : ";\n";
  }
  push @out, sprintf "[at %s (local) / %s (GMT)]\n",
    scalar(localtime), scalar(gmtime);
  return join '', @out;
}

sub print_report { print '', report(); }

$Already = 0;

sub import {
  # so "use Module::Versions::Report;" sets up the END block, but
  # a mere "use Module::Versions::Report ();" doesn't.
  unless($Already) {
    eval 'END { print_report(); }';
    die "Extremely unexpected error in ", __PACKAGE__, ": $@" if $@;
    $Already = 1;
  }
  return;
}
1;

__END__