#!/usr/bin/perl
our $VERSION = '1.11';
=head1 NAME
tkpp - frontend to pp written in Perl/Tk
=head1 SYNOPSIS
B<tkpp>
=head1 DESCRIPTION
Tkpp is a GUI frontend to L<pp>, which can turn perl scripts into stand-alone
PAR files, perl scripts or executables.
Below is a short explanation of all available screen elements; it is also
displayed from the C<Help> - C<Help Contents> menu item.
=head2 Source file
The file you want to pack.
=head2 Output file (--output, --par, --perlscript)
The file you want the source file packed as. This option recognizes the
C<.par>, C<.pl> and executable extensions, and supplies the corresponding build
option automatically.
=head2 Use icon (--icon)
The icon file you want your output file to use. This option will only work
when building Microsoft Windows C<.exe> files. Currently, this option only
accepts C<.ico> files.
=head2 Add modules/files (--add)
Add the specified items into the package, along with their dependencies.
Multiple items should be seperated by a comma (C<,>) or semicolon (C<;>).
=head2 Exclude modules (--exclude)
Exclude the given module from the dependency search path and from
the package. Multiple modules should be seperated by a comma (C<,>) or
semicolon (C<;>).
=head2 Scan dependencies (--compile, --execute, --noscan)
Specify the dependency scanning method to use. See L<pp> for explanations
of the options.
=head2 GUI (--gui)
Build an executable that does not have a console window. This option is
only applicable on Microsoft Windows, and is ignored when the output file
is a C<.par> file.
=head2 Log (--log)
Log the output of packaging to a file. The log file, F<tkpp.log>, will
be written in the user's home directory.
=head2 Verbose (--verbose)
Increase verbosity of output; from 1 to 3, 3 being the most verbose.
This option is ignored if logging is not enabled.
=head2 Build
Starts building the package.
=head2 File Menu->Preferences
Specify the location to F<perl> and F<pp>. They must be set before Tkpp
will build anything. The Tkpp configuration file, F<.tkpprc>, is
stored in the user's home directory.
=head1 NOTES
I write code for a living not literature, so any misspelled words in any
comments or anything, whoops ;)
=cut
###################################################
# use modules
###################################################
use strict;
use warnings;
use Config;
use FindBin;
use File::Spec;
use File::Basename;
use Tk;
use Tk::Balloon;
use Tk::Dialog;
use Tk::LabEntry;
###################################################
# global variables
###################################################
my $homedir = $ENV{USERPROFILE} || $ENV{HOME};
my $addmodules;
my $configfile = File::Spec->catfile($homedir, ".tkpprc");
my $dogui;
my $dolog;
my $doverbose;
my $excludemodules;
my $scanmethod;
my $gpgpath;
my $iconfile;
my $logfile = File::Spec->catfile($homedir, "tkpp.log");
my $outputfile;
my $perlfile = $^X;
my $perlpath;
my $pppath;
my $sourcefile;
my $statusbar;
my $verboselevel;
my $verboselevelbox;
my $version = "1.1";
my $ppfile = ($^O eq 'MSWin32') ? "pp.bat" : "pp";
my @win32_only = ($^O eq 'MSWin32') ? () : (-state => 'disabled');
###################################################
# declare subroutines
###################################################
sub build;
sub checkconfig;
sub editpreferences;
sub help;
sub myicon;
sub openfile;
sub savefile;
sub showdialog;
sub splashimage;
$| = 1;
# begin building the gui
#
my $main = MainWindow->new();
my $iconimage = &myicon(1);
$main->title("Tkpp");
# make the menu bar
#
$main->configure(-menu => my $menu_bar = $main->Menu);
my $file_mb = $menu_bar->cascade(
-label => "~File",
-tearoff => 0
);
my $help_mb = $menu_bar->cascade(
-label => "~Help",
-tearoff => 0,
);
$file_mb->command(
-label => "~Preferences",
-command => \&editpreferences
);
$file_mb->command(
-label => "E~xit",
-command => sub { $main->destroy }
);
$help_mb->command(
-label => "~Help Contents",
-command => \&help
);
$help_mb->command(
-label => "~About Tkpp",
-command => [
sub { &showdialog },
"About Tkpp", << ".",
Tkpp was written by Doug Gruber <doug(a)dougthug.com>.
In the event this application breaks, you get both pieces ; )
Tkpp Version: $version
.
"info"
]
);
# the frame from which all frames will come
#
my $bigframe = $main->Frame(-borderwidth => 10);
# make the top frame
#
my $frame = $bigframe->Frame();
$frame->Label(-text => "Source file ")->grid(
( $frame->Entry(
-textvariable => \$sourcefile,
-background => "white",
-width => 30
)
),
( $frame->Button(
-image => $main->Getimage("srcfile"),
-command => [
sub { &openfile },
[ [ "Perl Files", [ ".par", ".pl", ".pm" ] ],
[ "All Files", ["*"] ]
],
\$sourcefile
]
)
),
-padx => 1,
-pady => 2
);
$frame->Label(-text => "Output file ")->grid(
( $frame->Entry(
-textvariable => \$outputfile,
-background => "white",
-width => 30
)
),
( $frame->Button(
-image => $main->Getimage("textfile"),
-command => [
sub { &savefile },
[ [ "Binary Files", ["*$Config{_exe}"] ],
[ "PAR Files", [".par"] ],
[ "All Files", ["*"] ]
],
\$outputfile
]
)
),
-padx => 1,
-pady => 2,
);
$frame->Label(-text => "Use icon ")->grid(
( $frame->Entry(
-textvariable => \$iconfile,
-background => "white",
-width => 30
)
),
( $frame->Button(
-image => $main->Getimage("file"),
-command => [
sub { &openfile }, [ [ "ICO Files", [".ico"] ] ], \$iconfile
]
)
),
-padx => 1,
-pady => 2,
)
if ($^O eq 'MSWin32');
# make the middle frame with the module lists
#
my $frame2 = $bigframe->Frame(-borderwidth => 1);
my $frame2balloon = $frame2->Balloon();
$frame2->Label(-text => "Add modules ")->grid(
my $addmoduleentry = $frame2->Entry(
-textvariable => \$addmodules,
-background => "white",
-width => 30
),
-padx => 1,
-pady => 2
);
$frame2->Label(-text => "Exclude modules ")->grid(
my $excludemoduleentry = $frame2->Entry(
-textvariable => \$excludemodules,
-background => "white",
-width => 30
),
-padx => 1,
-pady => 2
);
$frame2->Label(-text => "Scan dependencies ")->grid(
my $scanmethodbox = $frame2->Optionmenu(
-options => [
['static' => undef],
['compile + static' => ['--compile']],
['execute + static' => ['--execute']],
['compile only' => ['--compile', '--noscan']],
['execute only' => ['--execute', '--noscan']],
],
-variable => \$scanmethod,
),
-padx => 1,
-pady => 2
);
$frame2balloon->attach(
$addmoduleentry,
-balloonposition => "mouse",
-balloonmsg =>
"Adds the specified module(s) into the package, along with its dependencies, seperate each module with a comma or semicolon"
);
$frame2balloon->attach(
$excludemoduleentry,
-balloonposition => "mouse",
-balloonmsg =>
"Excludes the given module(s) from the dependency search path and from the package, seperate each module with a comma or semicolon"
);
# make the middle frame with the checkboxes
#
my $frame3 = $bigframe->Frame(-borderwidth => 5);
my $frame3balloon = $frame3->Balloon();
my $guicheck = $frame3->Checkbutton(
-text => "GUI",
-variable => \$dogui,
-onvalue => "--gui",
-offvalue => "",
@win32_only
)->grid(
( my $logcheck = $frame3->Checkbutton(
-text => "Log",
-variable => \$dolog,
-onvalue => "--log=$logfile",
-offvalue => ""
)
),
( my $verbosecheck = $frame3->Checkbutton(
-text => "Verbose",
-variable => \$doverbose,
-onvalue => "--verbose=",
-offvalue => ""
)
),
( $verboselevelbox = $frame3->Optionmenu(
-options => [ 3, 2, 1 ],
-variable => \$verboselevel,
)
)
);
my $guiballon =
(($^O eq "MSWin32")
? "Build an executable that does not have a console window"
: "This option is only available under Windows");
$frame3balloon->attach(
$guicheck,
-balloonposition => "mouse",
-balloonmsg => $guiballon
);
$frame3balloon->attach(
$logcheck,
-balloonposition => "mouse",
-balloonmsg => "Log the output of packaging to a file"
);
$frame3balloon->attach(
$verbosecheck,
-balloonposition => "mouse",
-balloonmsg =>
"Increase verbosity of output, this option is ignored if logging is not enabled"
);
$frame3balloon->attach(
$verboselevelbox,
-balloonposition => "mouse",
-balloonmsg => "The verbosity level from 1 to 3, 3 being the most verbose"
);
# make the bottom frame
#
my $frame4 = $bigframe->Frame(-borderwidth => 5);
$frame4->Button(
-text => "Build",
-width => 10,
-underline => 0,
-command => \&build
)->grid();
$main->bind("<Alt-b>" => \&build);
$main->bind("<Alt-B>" => \&build);
# make the status bar (for future use)
#
$statusbar = "Ready";
my $statusbottom = $main->Label(
-textvariable => \$statusbar,
-anchor => "w",
-relief => "sunken"
)->pack(
-side => "bottom",
-fill => "x"
);
$frame->pack();
$frame2->pack();
$frame3->pack();
$frame4->pack();
$bigframe->pack();
# create the splashscreen
#
my $splashimage = &splashimage(1);
$main->withdraw();
if (my $splash = eval { require Tk::Splashscreen; $main->Splashscreen }) {
$splash->Label(
-text => "Tkpp",
-font => [ -size => "10", -weight => "bold" ],
-background => "#746b6b"
)->pack(
-fill => "both",
-expand => 1
);
$splash->Label(
-image => $main->Photo("image", -data => $splashimage, -format => "gif"),
-background => "#746b6b"
)->pack();
$splash->Splash(1000);
$splash->Destroy();
}
checkconfig();
$main->iconify();
$main->deiconify();
#$main->raise();
my $icon = $main->Photo(
"image",
-data => $iconimage,
-format => "gif"
);
$main->idletasks;
$main->iconimage($icon);
# align the main window appx with the middle of the screen
#
my $centerwidth = int(($main->screenwidth / 2) - ($main->width / 2));
my $centerheight = int(($main->screenheight / 2) - ($main->height / 2));
$main->geometry("+$centerwidth+$centerheight");
MainLoop;
###################################################
# begin subroutines
###################################################
sub build {
if (!(-e $configfile)) {
showdialog("Preferences not set", << ".", "error");
Your preferences have not been set or your preferences file has been removed.
You will not be able to build your file untill this is complete.
Please go to File -> Preferences to continue.
.
}
elsif (!$pppath) {
showdialog("Path not set", << ".", "error");
The path to $ppfile has not been set.
Please go to File -> Preferences to continue.
.
}
elsif ($perlpath eq "") {
showdialog("Path not set", << ".", "error");
The path to perl$Config{_exe} has not been set.
Please go to File -> Preferences to continue.
.
}
elsif (!(-e $pppath)) {
showdialog("Invalid path", << ".", "error");
The path to $ppfile is invalid.
Check that the file exits and that your path is setup correctly.
Please go to File -> Preferences to change the setting.
.
}
elsif (!(-e $perlpath)) {
showdialog("Invalid path", << ".", "error");
The path to perl$Config{_exe} is invalid.
Check that the file exits and that your path is setup correctly.
Please go to File -> Preferences to change the setting.
.
}
elsif ($sourcefile eq "") {
showdialog("Missing parameter",
"You must specify a source file to build.", "error");
}
elsif ($outputfile eq "") {
showdialog("Missing parameter",
"You must specify an output file to write.", "error");
}
else {
$statusbar = "Building...";
$main->Busy();
my @args = ("$pppath", "--output=$outputfile");
if ($outputfile =~ /\.par$/i) {
push(@args, "--par");
}
elsif ($outputfile =~ /\.pl$/i) {
push(@args, "--perlscript");
}
elsif ($outputfile !~ /\Q$Config{_exe}\E$/i) {
showdialog("Invalid File Format", << ".", "error");
You are trying to write your output file as an invalid file format.
It must be either a $Config{_exe} or .par file.
.
$main->Unbusy();
$statusbar = "Ready";
return ();
}
if ($iconfile) {
push(@args, "--icon=$iconfile");
}
if ($dogui) {
push(@args, $dogui);
}
if ($dolog) {
push(@args, $dolog);
}
if ($doverbose) {
push(@args, "$doverbose$verboselevel");
}
if ($addmodules) {
foreach (split(/,|;/, $addmodules)) {
$_ =~ s/^\s//;
push(@args, "--add=$_");
}
}
if ($excludemodules) {
foreach (split(/,|;/, $excludemodules)) {
$_ =~ s/^\s//;
push(@args, "--exclude=$_");
}
}
if ($scanmethod) {
push @args, @$scanmethod;
}
unlink($logfile);
system($^X, @args, $sourcefile);
if ($dolog) {
open LOGFILE, ">>$logfile";
print LOGFILE "Executed Command: @args\n";
close LOGFILE;
}
$main->Unbusy();
$statusbar = "Ready";
# $statusbar .= "(Error $?: $!)" if $?;
}
}
sub checkconfig {
if (-e $configfile) {
open CONFIGFILE, "$configfile";
while (<CONFIGFILE>) {
if ($_ =~ m/perlpath = (.*)/) {
$perlpath = $1;
}
elsif ($_ =~ m/pppath = (.*)/) {
$pppath = $1;
}
elsif ($_ =~ m/gpgpath = (.*)/) {
$gpgpath = $1;
}
}
close CONFIGFILE;
}
else {
editpreferences();
}
}
sub editpreferences {
if (-e $configfile) {
open CONFIGFILE, "+<$configfile";
while (<CONFIGFILE>) {
if ($_ =~ m/perlpath = (.*)/) {
$perlpath = $1;
}
elsif ($_ =~ m/pppath = (.*)/) {
$pppath = $1;
}
elsif ($_ =~ m/gpgpath = (.*)/) {
$gpgpath = $1;
}
}
}
else {
$perlpath = can_run($^X);
$pppath = File::Spec->catfile($FindBin::Bin, $ppfile);
$pppath = File::Spec->catfile(dirname($perlpath), $ppfile)
unless -e $pppath;
$perlpath = '' unless -e $perlpath;
$pppath = '' unless -e $pppath;
open CONFIGFILE, ">>$configfile";
}
my $preferences = $main->DialogBox(-title => "Preferences");
my $prefframe = $preferences->Frame(-borderwidth => 5);
$prefframe->Label(-text => "Path to perl ")->grid(
( $prefframe->Entry(
-textvariable => \$perlpath,
-background => "white",
-width => 30
)
),
( $prefframe->Button(
-image => $main->Getimage("openfold"),
-command => [ sub { &openfile },
[ [ "Perl", ["$perlfile"] ], [ "All Files", ["*"] ] ],
\$perlpath
]
)
),
-padx => 1,
-pady => 2
);
$prefframe->Label(-text => "Path to pp ")->grid(
( $prefframe->Entry(
-textvariable => \$pppath,
-background => "white",
-width => 30
)
),
( $preferences->Button(
-image => $main->Getimage("openfold"),
-command => [ sub { &openfile },
[ [ "pp Batch File",
[ $ppfile ]
],
[ "All Files", ["*"] ]
],
\$pppath
]
)
),
-padx => 1,
-pady => 2,
);
$prefframe->pack();
my $answer = $preferences->Show();
if ($answer eq "OK") {
no warnings "uninitialized";
print CONFIGFILE "perlpath = $perlpath\n";
print CONFIGFILE "pppath = $pppath\n";
print CONFIGFILE "gpgpath = $gpgpath\n";
close CONFIGFILE;
sub { $preferences->destroy };
}
}
my $help_text;
sub help {
my $help = $main->DialogBox(-title => "Tkpp Help");
if (!$help_text) {
local $/;
seek DATA, 0, 0;
$help_text = <DATA>;
$help_text =~ s/.*?=head2/=head2/s;
$help_text =~ s/=head1 NOTES.*//s;
$help_text =~ s/=head2 (.*)\s+/* $1:\n/g;
$help_text =~ s/[LF]<(.*?)>/$1/g;
$help_text =~ s/C<(.*?)>/"$1"/g;
};
$help->Label(
-text => $help_text,
-justify => "left"
)->pack(-fill => "x");
$help->Show();
}
sub openfile {
my $types = shift();
my $file = shift();
$$file = $main->getOpenFile(
-filetypes => $types,
-initialdir => $$file
);
return ();
}
sub savefile {
my $types = shift();
my $file = shift();
$$file = $main->getSaveFile(
-filetypes => $types,
-initialdir => $$file
);
return ();
}
sub showdialog {
my $title = shift();
my $message = shift();
my $icon = shift();
if ($^O eq "MSWin32") {
my $messageBox = $main->messageBox(
-title => "$title",
-message => "$message",
-type => "OK",
-icon => "$icon"
);
}
else {
my $dialog = $main->DialogBox(-title => $title);
my $frame = $dialog->Frame(-borderwidth => 2);
$frame->Label(-width => 4)->grid($frame->Label());
$frame->Label(-bitmap => $icon)->grid(
$frame->Label(
-text => $message,
-justify => "left"
)
);
$frame->pack();
$dialog->bell();
$dialog->Show();
}
return 0;
}
sub splashimage {
my $splash_gif = << '.';
R0lGODlh8gB5AKUAAP///////vj4+Pb29vDw7+zr5Obl3d7e3NjX1Ojo58/OzNnXx8vIxMXDv767
t7m3tbWxsK+sqKimpKGdnZiSkpONjY+JiIyGhomEg4Z/f4F5eXtzc3dubnRra3FpaW9mZm1lZaaj
m2FgYGphYVtXVkdFRUI/PlBOTWtqant5eXBubWdmZnVzc4uJeJWThD06NC4sKSQiHwEBASAfGzMy
LBAQDG1kY2tjY3JwYXd3ZmdeXmVlUEVENikoJFRUPxgYEiH+FUNyZWF0ZWQgd2l0aCBUaGUgR0lN
UAAsAAAAAPIAeQAABv5AgHBILBqPyKRyyWw6n9CodEqtWq/YrHbL7Xq/4LB4TC6bz+i0es1uu9/w
uHxOr9vv+Lx+z+/7/4CBgnQBAQIDBAQFi4yNBQaPjwaTlJWWl5iZlosDAYOfZ4aIi5UHBgeoqQcI
q6sIr7CxsrO0tAsICwsMugsGAqDAYQGIigmptAoLCsvMCgzODNHS09TR0NXYDA3bDg8QDgwFweNb
AokFCacI19rb3A0O8Q/z9BD29/j53t759vz9ESJICEEwRIQF5BJWCaDo0QEFDbwJlEBxgsUJFDBS
oFChYwULIC+IHInhQsmRF0KaNFnypEgMMGFmgAnSQoubLg4o3PmEYf66VQ0gSNDIsaOFCxmSali6
YQOHpx06eJjq4YNVEFitUqVq9QNWEF2v2rhB9sYIGx86NMWRI0cLTzzjJhHwaJ2DCBY36jVqUmkG
DU2fcohKmGvWD1MJSw3r9epXG2PNjtCh46wNHSRI7GAgt7ORAasg4iW692NfpYCdQlUstWpXqoqn
hv1KG0TkEZMpUyZxogSPC56DCymgjAGEvHpLH8WQ9G9q1YIHt3aNmHVUrl3Bho0sWbeOEzxevDgh
PLgBXXdJlzbNHHXTwNGvy0bswXph6lpdc8ftnYQJGj28UJ5nD0UkQXLJebRcc0y9F510W9UX1WrW
MTYfCGTxpxtvJv7A0AMNA3amS1AHIriRUQui9hx0EMI2IYUvLqbdhRnmptsJL3gIYohxoQdBCCae
+FGKzq0Yn3yKHdmBYDIy5lVZGlKGIwwx7MjjTj4CGSSKpxW5InT2LfngkfhlV5ZZ3uHYw4dX8uSj
esoRuVSD77E4IWHR2XndbF+dGaWabLapkC7eaImggkch1VyRGxg55pjwteiabZBx152UL6xppaDj
vLkllzItOidTqXHA4oMeiDACVjfc51VklUJp4wkmaMppQlnCiehLoTI4ap1OqeYUCCSUYIIJJZRw
AgkjyMhdrJfulmmgtwaT5adDHvVXryrS6eAGvBmrbGYiZEaCbP623TBWrFFiamu11jLggFBBFjUk
CseegEJ7vo66ogjIKisCCilg8BEGKaAwaaXs2rhbrdTC+4mn9XZ0AcDJLqtBTAx6uVQHtAqsAgYT
fLPNAxFQwIJYDNfoHWbTbiqxIBTvlRJIK4R8wgospJACS/z+5WXIJKhgwQQPKIBAAkwngEADEnTw
qrq34eYwCTHPDErNHIWcLLLLslCBBMcBza1SHCRLAgsUJH1AAgQMIDciCTCwwdSyRgvzu1rTLO9x
elmg87KZoZDBBA2wogAEvMoUdG8kpCBBAwckMvflBBgAAQfp1ujyhhDL3LcfNbOALAkEJ3U0BApU
TkACCkzQOP7HGXBgwgksTMAA3Jf3jsgBFHSe4efS8j36HzVbQIIIKZT8QDyt825O3RSgxOsGvYlg
gQOV++57AhFYKpnV/YV+fCBcX9C8A0s3HTfmB0iQaEomjZCv5Aq87z3mCKRg9f/tgpmOzgcIriVH
AgnYn9wIEIGagCQDGNMXBRqQQAX2LgEPAMH/XlY+4xFwDwZMjgN45z0CTMCB2AMbCirwAAToz4IL
RAAGKsNB74wAawP8YB9CyBEKsK57vjOhRzRgrGWlgALsqyAML5eABnCghjb0jwd1iIcQVoACMwkB
AwywvxBYrDcnYN7kgLhE/k3gBlCkzA3NR0UQ/k0jV4yj8v5EcIEHkPFyEuiICpS1AgtEoHUvLOPc
6qaBGpJPihFr4x2suEcSYMCO3lNAUUSwswtAYGmBFOQC44fGl/0PkaJTJB0O8MYg7REFFNid9xyQ
kQqoAAWWXJomFUgABGTAkJMBpSjzwEMURA4Cd5RbAghynBb4UJZlFIAylem9BEygMg7DzQ10uctF
ltJEItAeBb13gIA4YCAtVOIAlnmIy5HznOVcoARq9D91+SeH1awDD0mwglSKU24CYMDz7hKBByTw
nAZwYTrNYQBjuOIAy7ycASggGc8Rq0OJjGccrnUoFaxgAgooQO+UiRcXZMCXvJEAOQkggeadM3ZY
ZEE2Kf6pAGYuUAEYGMGZ1PWBd0ZUom+gaA878lGMBlKZE1CBCEogHhhQqQHLVIAEUPCCczYgBSug
5LJqVYMEpJMAB4CACipFG5uGEqdtqJlHKtDT/G1UAILT4gJMIYIYWECZAZAABkggA4Qu8wEomABc
A3CAHsiAAgl9nSRtox2reBWsc6DoWMlaTwXcU5kZKIEEcqHRB8yABAIIgAEy8DMZYICcDxCBXg1h
iBR41qW/a0AFUIAWrzwUnojN6TVPxBEMiKACqjSnAFJAgwhAggACcIAMSmCIBqjAhzLA7DIjcAIK
FCKzAljBadM5gKQ5AANfMSxEvxrbNKAHL4eqHiy3qf7bFJjgAXMTAF1XkNkMkMABAaiBDKyqTAiQ
QAKkNaEMZMAA6g7gAhFAgFbVhZXDdjen8ABceI/iAC6mF7InyAAFLIABGuz3AXw9wQkyK13A1rdY
hCuBfEuAWtB4IAIHaMAGyAIZah44rPrESxz3whELAPOFylQBDPbL49MGYAImSEEhJJBc6EogBj2W
QQ0+W2IFeACjdjuTi1+8hgVERMYeoW1HMKrEZa43JhhAAHRPIN8kFyCzE5DBBTJ7gf3it8QT8AAS
HZCB20yZyt69sr3iOOMKBFh/yjyBDDCMzgIkmcdvroBnScsCJdN3bgS42wXIFjzJYG2KeDaDlSGA
l/6aLHasDX6fMkswaHQGgAJFJi0GZLACQ6z6s4ZIAJJFgNoDSO24Eqgzmu6caU0baMKetsCnWVjB
UZeamV7+qyGUeQAlZ/bV5CSyDMQ8NwRkhWQWqBGve02GTafMgcH+yEcmMEJ8kvoBqBVAAvZL32Va
WKTQXmYBLHwCyw2gAeliGwbGt21ui2HTBwK3wIUtbHBw0QQyCAFC04tqGqCz0eyNtzIVYAE3884B
H0DLvljAbzb629ecBnZN6HcUcHdEAgjINQUiIOoBIKCF1FX3A/r7cgTMrQAUcEEOACxLCNjGAytI
gQc+ud2PnwHgIp9fogR+xYzoxRT6Q0A7zuryuP6VUwFLyYALJLDFAUTgBh8QqgpkWpZ+G90LC5jX
gURS8pEo3dMdcUEPwQFECjCnAiTEJ0wPcLnNveeRfH/ACDyggrIwzMBnH0Paf2R367Hd7QNP1Ngc
O4AEKIUCrMh7CDSwO8tRoCpVUYEE8mcAsBeewF9BfOLDkHaBVAAmjkeJwHmVMAts8wCp8TP33mf5
DfzxbZEeC25uS0EDfECaqNcubFf/hcV7EcwxcbwDSYIBcF2g3LhvSgoOR/nqNsWHlEvAijXEgksm
gAPIt8FhVM98tM/LizOBfvRlPz+YpICO23TAe15pT7lNoCkWcEwHwAGXIlqOZQFWw2LawX7tx/4F
rQd/YDYT8Td/9PMSf4F/TFMB75FN/VcAtdMoGDB6CDB0DpMCdjQBZEd2lcKADagFD0hWEhg08ocS
MnF/F0BBD/AeLEBPFEB5DiAYLJA7StMBaKIbIzB6GZCCZOdORdeC7hcB8JcUMsgcM9grK5ABI0QB
7+FLeZU/DBAdKqACGAUBGWKEI7A9KKCES8iCTngFrXdCzUGFcTiB8qcUIpABLZQB77ECkRNguCcm
HLACF+UM46dGuCF6GwBAMtViTdiGW7AAKAOHiyKHUih//KIBzHNJpbI8FTBCE8AaOtCFCRBT/GE1
t0UBAGR4bOiIVPCGFrAoUgiLdAiLGqAC5f4HAQ5CT1xmAawhAvX0ABcgK/xBAhlQAZ6jio3IilgA
iZ0mNLIIi5QoNLXIAhKgf4EhAqLnQhJQH1ShAyuwWks4PjeUAtkWjixmdsoYBa44J874jLQ4JwPD
dc/BAdToQglQAa3xATuzYjMlGeXyM/14jsmYjlXAjCfkLxrQjs/oL77YNt/SAZgnWBlQFcWyAshH
NQ0VOSngWljBHV7FAyAZkiI5kj7gFpxBkERgkBcAGAipkNLoLxa1EU8RKRXgWEpFhCVAAg2Feh65
kYyRLjbgVTEQAz0wlEVJlEZJlD0AAzTAAz7QAr+AkgCgkizZKOyYkH6BkKlxWxvAAqbylf5PkQGs
4ACuRALQZHhggSFksTZO8ipBuV01EJdyOZdy+QM18AMzAANOGQJSOZWRuJJ1Mirv+CuAwQF3GBiR
MhgYoDSsxAIXSWBuSSwq0JZd4VWHdpn7FZcx8AI+oAF9qZKB2SgK6S+N8h6p8iVgORgXsAzX9Zjq
xxio8xp8YpmYeZk1MAOc6QKf+ZcrcpUvSSp1Ui7AkphRIYIPoAE7CZn0QQL5USY1tV21eZk/EANO
2QC7iRcYUJVWeZWECSyZ8S1jIhUspDgXkIBUkx/MuRVhMRU6AJ3R2WO3SQMl2Zd+2WlWWZpaWZrD
yQFhlJhMEhXYqDsBFQEapIKv6QEgcP4CICAfr1EV7akj78ljd6mXOyAO1yk73cmS2jmcGwACJSAC
YMkaFBlGGXABqOBE5nmgvLEC9+EiD/ohEapkP9ADTqkA9FmfGDon+smhwGIqvaEC/0kY7XksH5oB
ILA7MmSehfWhIgobHvCiFvaecYmbPiABN4qjFoCQPNqjK5aTXikdiqEDGSMCLGCkFcAKFbCErTUV
YeMUYQKlERqfT3mlU5keWdqdW2oqTlEsdwgj97EYXQEYakkWYFEfvHGHtQOmhQGn0XmXTYkDBECn
60iaXPotHaosPRMmrjIbLPaaiPEBt4NKFgCk9sGomHmXNLoDBkCnddppWlqpXwliRf6qqNYxHz95
GNUBMmJkAX46FbRpmzPKmdbJqpP6Kz36leASMGszARqwJGHinBbiIjOpJ3vyq0k2pfLJl6zaqgdJ
qeDJJJnBMxeghZoKqPQRIS7yIuFZGM+pKac6A00JldvKrXdqrHXyIIkJpIMRpHvSnBJiHY8SpK4B
SsCql5A6r/Sqo8CJmPgasPw6H4mhqQ4LpvNBsNc6ozywAwiBsA9Yr/eJmqk5sRQbIUkSpBO7qRYr
odPJmQ+AsEJQrNv5JQ7yKKfSov8KiEfyIPbBFW/prvAJrz6gmy6LpVpZlY4CKWSSrji7rkqyqV5x
aTAqofDKAzkwtC8bifVKmgsLH/5LCybTgSd58ihg26RhcUMvQJRRKqMUaqFDuwCMl7VFu6M0O5O0
qq6CAR/UOrK2enwnQANom5kY6wMba7VuCyRIkXVxO48B67Ule7d6+rj8Kh+2ehklUJRLKaOb6QMQ
YLVDsAAR4AKvh5UJmZ9HK7ITu5+qQbaMYbYzEANGpZm5yblDcAAh4FHOISqMIrOnYrqQcqx6OylY
MRmVOwNLOQPTKZ85MACyKwQE4AIagANLIpodY6++eyq727v3SiGg1xVjgRknAAOt+yHEy5k4sKrL
CwAB8AA4YC46SXhOwQJei67oUhu1ARn0mxVbkS4BtBsaVivhSwNGRb7me77DkOoDOCIeLxAwYARG
ydLADuzAAfPA4vLAEUzBxnIsGIzAABwDM9DBS0kDL+CULhCp5ysEhWAAPADAa7ImSTmULvzCMNy6
Q9nBHPzCMmzDNdy6OszBHdzDPlzDRMmUTpkDg1vC6FsILvACNADARrWUK/zEUPzESGm5UKyUUkzF
SpnFSLnFU/zBnLkD6GbERFAIhpABPqDES7zETGlUbNzGbvzGcBzHcjzHTMmZLdBSYlwEZFwIDNAC
OeADIxnIgjzIhFzIhgySO4ADLsAAypvHjvzIkBzJkjzJlFzJlnzJmJzJmrzJnNzJnkynQQAAOw==
.
my %send_back = (1 => $splash_gif);
return ($send_back{ $_[0] });
}
sub myicon {
my $icon_gif = << '.';
R0lGODlhIAAgAOcAAComItra1qKiok5OSoqKfnp6dl5eXrKyrmpqZuLi2sLCuk5KRkZGOp6enubm
4nZ2coaGfpqWlu7u6tbWzkI+Om5ubmZmZn5+fpKOilJSTs7Oyra2rjIyKvLy7q6qonZubnZyblZW
VmZeXr66ssbGvpaOjvr6+oKCgmZiYnZqavb28mpmZlpaUn52do6GhioqJpaSknJmZsrKwm5iYt7e
2pqaljYyKnpubnJqaoqCgqaenoJ+epKKiurq5sK+tn56eqqmopqSknpybjY2Lm5mYjIuKo6KhtLS
yq6uoi4uJk5GRoZ+flpSUmJaWkpGQmpiYmpeXsrKyr6+usK+voqGgp6alt7a2l5aVi4uKlZOTl5W
VoJ6dpKSjm5mZtrW0uLi3sbGwtLS0np2crKuqo6KimJiVqKemp6WlkZCPrayrubi4rq2trq6uoaG
hq6qpjY2NqainlZSTvby8lpWUoaCfoqGhlpaWlJOSpKOjm5qZnJubnp2dvLy8sbCvsrGxlpWVmJe
XtLOyrq2sjo2LtbS0r66uoaCgsrKxkpGRqaiot7e3urq6tra2ubm5srGvtbSys7Kyk5KSoJ+ftbW
0vb29npycoJ6ep6amlZSUu7u7nZycjYyLl5aWlJOTqKenqqmpm5qarKyssLCvpqamuLi4rKurq6q
qjY2MkZCQraysv//////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////yH+FUNyZWF0ZWQgd2l0aCBU
aGUgR0lNUAAh+QQBCgD/ACwAAAAAIAAgAAAI/gD/mTDRwUGCgzQCKPQyqaFDhg4bTnh0hAaNf//U
qPEz5pMnT1XOlCiBwYiLky6MkEHJkkpKI0gSsGFzKQgMMmSW/NCkKcUHHF26xMABNCiRoE+giJgz
h4WGRIlsljhJZ0ulqz+J+vT5MyhSEVmyFJGhQ4fUk0sstWhR6UMKPXq4pkgBdMaMFTNE3LmTxBEc
ODBK8MCZI63aFppu3NADSAsgQDG6rMD75EnYF46g2uTBk8meHIUt/QiaoUKDT58M3V3xRIQIJkyS
yPiIJ4SByQIK4aSTwxLTCDQyqVBhpYXdyiLixMH8sYQkKQr5qFizxgUVLXv2qKHEnZKKT5WT/r5m
ggVSWRhBdJAixX3KFCqYHmjQoKI79y9rlULBhOkFWR0l4LECGGBwt8EGmrRhBR982McdH4II0toT
sPX1EQx4FNBII5TwkUoqQFhhAoPcZbJhJpQsskglUDyhhRYvQPKXYGSoSIkDJ5wAQQWUjDLKGipE
0EADCBRIiRSSvYiFIxeWUIeNimCAASl/MFJFFRXwwYWKbYTCnQaXEPHHH0s2WUJDlAQwwAAWNIBH
BRW8kQkLoICCSIOU6GBKFxWSEEEEZOCBB1SNhCGJJCZQEkIUUexRyArcGRAFgz/AMANsL/QRRBA4
8eCpDoIYYkgmi4zCICOhJMLdJXWsd4Mm/iuMiYUCf55UB044SZmGBBgQyIcXfmzYwg4NiYEXpj5I
aQgVVNRxqwt00FGHIi3k2IgpMBxySGWhhGLJE10o6cNIhYGWA7NLLFGHKZVkdwRiH+YFWgtPzDBm
EVLglO6+ou4LAw5/JkLUJZd08cRke1QGGxY+eGqJJUuAltYPPzzgQiV/TiIEJ5PNEN4HK4j5RxJS
nNTCDxCntVYLH1RywwcfRICEZHgRgQIKkfFJ3gg47dHCw4ddhUIlmsCMQyimVLZCF1BAkUdQTTRR
xAgnqVXJWlcFJYJbrmUhhg8xxDBDF1FnJa6nK19VSRchhNATDnPhELZXXSCAgCU/ccJJhxEN82D1
VTd0UeceH+hBlOBDEQXz4jgwxTBOaRP9gWIv06XV4lvNlUIMmFLtwsNpL35DW4rDzNPiP4HSxWUe
7As61oqJ/nLLgGcV2RNDDAHAP044oUQnWUQi/PCIFF+8EsgLjwgqzKNCARYvvDDIPwYYwMAQHGyy
CQfcd++995vY4H0RGP0TEAA7
.
my %send_back = (1 => $icon_gif);
return ($send_back{ $_[0] });
}
sub can_run {
my $cmd = $_[0];
require Config;
require ExtUtils::MakeMaker;
my $_cmd = $cmd;
return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
my $abs = File::Spec->catfile($dir, $_[0]);
return $abs if (-x $abs or $abs = MM->maybe_command($abs));
}
return;
}
__DATA__
=head1 SEE ALSO
L<pp>, L<PAR>
=head1 AUTHORS
Tkpp was written by Doug Gruber.
In the event this application breaks, you get both pieces ;)
=head1 COPYRIGHT
Copyright 2003, 2004, 2005, 2006 by Doug Gruber E<lt>doug(a)dougthug.comE<gt>,
Audrey Tang E<lt>cpan@audreyt.orgE<gt>.
Neither this program nor the associated L<pp> program impose any
licensing restrictions on files generated by their execution, in
accordance with the 8th article of the Artistic License:
"Aggregation of this Package with a commercial distribution is
always permitted provided that the use of this Package is embedded;
that is, when no overt attempt is made to make this Package's
interfaces visible to the end user of the commercial distribution.
Such use shall not be construed as a distribution of this Package."
Therefore, you are absolutely free to place any license on the resulting
executable, as long as the packed 3rd-party libraries are also available
under the Artistic License.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
See L<http://www.perl.com/perl/misc/Artistic.html>
=cut
syntax highlighted by Code2HTML, v. 0.9.1