Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Module info viewer

by TheoPetersen (Priest)
on Feb 19, 2001 at 20:18 UTC ( [id://59392]=sourcecode: print w/replies, xml ) Need Help??
Category: GUI Programming
Author/Contact Info Theo Petersen theopetersen@yahoo.com
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;
}
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?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://59392]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others taking refuge in the Monastery: (6)
As of 2024-03-29 11:43 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found