Module info viewer

[TheoPetersen]

Category:

GUI Programming

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);
$mb->pack(
          -fill => 'x',
          -expand => 'false',
         );
my $helpB = $mb->Menubutton(
                            -text => 'Help',
                            -underline => 0,
                           );
$helpB->menu(-tearoff => 0);
$helpB->pack(-side => 'right');
$helpB->command(
                -label => 'About...',
                -underline => 0,
                -command => \&aboutViewer,
               );
MainLoop;

# Show module information.
sub aboutViewer {
    require Tk::Animation;
    require Tk::ROText;
    if ($aboutWindow) {
        $aboutWindow->deiconify;
        $aboutWindow->focus;
        $camelanim->start_animation(200);
    }
    $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');
    $left->Message(
                  -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;
    $camelanim->start_animation(200);
    my $aboutText = $aboutWindow->Scrolled(
                                           'ROText',
                                           -scrollbars => 'oe',
                                           -wrap => 'word',
                                           -width => 40,
                                           -height => 20,
                                          )->pack(
                                                  -fill => 'x',
                                                  -expand => 'true',
                                                 );
    $aboutText->insert('end',"$0 $::VERSION\n") if defined($::VERSION)
+;
    foreach (&moduleDump) {
        $aboutText->insert('end',$_);
    }
    $aboutWindow->Button(Name => 'okayButton',
                         -text => 'Okay',
                         -command => sub { $aboutWindow->withdraw; },
                        )->pack(-side => 'bottom');

    $aboutWindow->bind(
                       '<Destroy>',
                       sub {
                           undef($aboutWindow);
                           $camelanim->stop_animation;
                       }
                      );
    $aboutWindow->bind(
                       '<Unmap>',
                       sub {
                           $camelanim->stop_animation;
                       }
                      );
}

# 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;
}