Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change

Module info viewer

by TheoPetersen (Priest)
on Feb 19, 2001 at 20:18 UTC ( #59392=sourcecode: print w/replies, xml ) Need Help??
Category: GUI Programming
Author/Contact Info Theo Petersen
Description: Show module versions for a running program.

I wrote this window to help with debugging mysterious failures at customer sites. We send scripts and modules to our users, who install them locally. They also install updates from CPAN as recommended, but we sometimes find we are out of sync. This code can be added to any Perl/Tk program to bring up a window which displays the versions of all modules loaded by the program to that point. The information is displayed in a Text widget, which allows the user to cut and paste it easily into a mail message.

The enclosed wrapper program is trivial but serves as an example framework. I cut and pasted it from one of our apps (and noticed the old-style Frame menu bar along the way, hmmm). On re-reading I think the code that gets the version data is rather clunky; any suggestions?

#!/usr/bin/perl -w

use strict;
use vars qw($VERSION $aboutWindow $mainWindow $camelanim);
use Tk;

$VERSION = "0.01";

# Make the main window, menu bar and Help menu.
$mainWindow = new MainWindow (-title => "A program",);
my $mb = $mainWindow->Frame(-relief => 'raised', -borderwidth => 2);
          -fill => 'x',
          -expand => 'false',
my $helpB = $mb->Menubutton(
                            -text => 'Help',
                            -underline => 0,
$helpB->menu(-tearoff => 0);
$helpB->pack(-side => 'right');
                -label => 'About...',
                -underline => 0,
                -command => \&aboutViewer,

# Show module information.
sub aboutViewer {
    require Tk::Animation;
    require Tk::ROText;
    if ($aboutWindow) {
    $aboutWindow = $mainWindow->Toplevel(-title => 'About Viewer');
    my $top = $aboutWindow->Frame->pack(-fill => 'x', -expand => 'true
    my $right = $top->Frame->pack(-side => 'right');
    my $left = $top->Frame->pack(-side => 'left');
                  -text => "Copyright (C) 2001 by Your Name Here",
                  -relief => 'flat',
                  -width => 400,
                 )->pack(-fill => 'x', -expand => 'true',);
    $camelanim = $right->Animation(
                                   '-format' => 'gif',
                                   -file => Tk->findINC('anim.gif')
                                  ) unless $camelanim;
    $right->Label(-image => $camelanim)->pack;
    my $aboutText = $aboutWindow->Scrolled(
                                           -scrollbars => 'oe',
                                           -wrap => 'word',
                                           -width => 40,
                                           -height => 20,
                                                  -fill => 'x',
                                                  -expand => 'true',
    $aboutText->insert('end',"$0 $::VERSION\n") if defined($::VERSION)
    foreach (&moduleDump) {
    $aboutWindow->Button(Name => 'okayButton',
                         -text => 'Okay',
                         -command => sub { $aboutWindow->withdraw; },
                        )->pack(-side => 'bottom');

                       sub {
                       sub {

# Roll credits.
sub moduleDump {
    my ($module, $line, @out, %package_stab, $package_version);
    foreach (sort(keys %INC)) {
    next unless /^[A-Z]/;
    $module = $_;
    $module =~ s/\.pm$//;
    $module =~ s/\//::/g;

    %package_stab = eval("%{*" . $module . "::}");
    if (exists $package_stab{'VERSION'}) {
        $package_version = $package_stab{'VERSION'};
        $package_version = $$package_version;
        if (defined($package_version)) {
        $line = $module . " version $package_version\n";
        else {
        $line = $module . ", no version\n";
    else {
        $line = $module . ", no version\n";
    push @out, $line;
    return @out;
Replies are listed 'Best First'.
(tye)Re: Module info viewer
by tye (Sage) on Feb 19, 2001 at 22:33 UTC

    As for the version extraction, I'd just go with:

    my $version= do { no strict 'refs'; ${$module."::VERSION"}; }; if( defined $version ) { push @out, "$module version $version\n"; } else { push @out, "$module, no version\n"; }

            - tye (but my friends call me "Tye")
Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://59392]
[stevieb]: I'm working on hiding the fact the software needs MetaCPAN::Client, as I often have a hell of a time installing it. I'm going to change it to let the user know if they do revdep that it needs to be installed, and remove that distribution ..
[stevieb]: ...from being a prereq

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (4)
As of 2017-06-25 23:38 GMT
Find Nodes?
    Voting Booth?
    How many monitors do you use while coding?

    Results (572 votes). Check out past polls.