#!/usr/bin/perl
# $File: //member/autrijus/PAR/script/tkpp $ $Author: autrijus $
# $Revision: #8 $ $Change: 8575 $ $DateTime: 2003/10/27 06:31:16 $ vim: expandtab shiftwidth=4

# tkpp translated into Japanese
#       by まかまか般若波羅蜜 (makamaka[at]donzoko.net) 2003-11-01
# このファイルは、Doug Gruber <doug(a)dougthug.com>氏のつくった
# tkpp 0.1を日本語訳し、それに対応して若干の修正を加えたたものです。
# Windows用にShift_JISになっていますのでお使いの環境に合わせて
# コンバートしてください。
# copyrightはオリジナルのCOPYRIGHTの項に基づいています。
# オリジナルはhttp://search.cpan.org/~autrijus/PAR-0.76/
# から入手することができます。

our $VERSION = '0.1';

=head1 名前

tkpp - Perl/Tkで書かれたppのフロントエンド

=head1 概要

B<tkpp>

=head1 説明

TkppはL<pp>へのGUIフロントエンドであり、perlスクリプトをスタンドアロンな
PARファイル、perlスクリプト、あるいは実行ファイルに変換することができます。

以下は、利用可能な全画面要素の手短な説明です；C<Help>
（C<Helpの内容>）からも表示されます。

=head2 入力ファイル

パックするファイル。

=head2 出力ファイル (--output, --par, --perlscript)

パック後に生成されるファイル。このオプションは".par"、".pl"及び実行
ファイルの拡張子を認識し、対応する作成オプションを自動的に選択しま
す。

=head2 アイコンの利用 (--icon)

出力ファイルに使用したいアイコンファイル。このオプションはWindowsの
exeファイルに対してのみ機能し、parファイルでは無視されます。このオ
プションは.icoファイルのみ受け付けます。

=head2 追加モジュール/ファイル (--add)

指定したアイテムを、その依存物と共にパッケージに追加します。複数の
アイテムはカンマ(,)かセミコロン(;)で区切ります。

=head2 除外モジュール (--exclude)

指定したモジュールを依存関係サーチパス及びそのパッケージから除外し
ます。複数のアイテムはカンマ(,)かセミコロン(;)で区切ります。

=head2 GUI (--gui)

コンソールウィンドウを表示しない実行ファイルを作成します。このオプ
ションは、出力ファイルがpar形式のファイルの場合無視されます。

=head2 Log (--log)

パッケージ時のログを標準出力はなくファイルに出力します。ログファイ
ル(tkpp.log)はユーザーホームディレクトリに書き出されます。

=head2 Verbose (--verbose)

出力の詳細；0から5段階あり、5が最も詳細。このオプションはログが有効
になってない場合無視されます。

=head2 作成

パッケージの作成を開始します。

=head2 ファイル -> 設定

perlとppの位置を指定します。Tkppを利用する前に、perlとppのパスを設
定しなければなりません。Tkppの設定ファイル(.tkpprc)はユーザーホーム
ディレクトリに保存されます。

=head1 注意

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 $gpgpath;
my $iconfile;
my $logfile = File::Spec->catfile($homedir, "tkpp.log");
my $outputfile;
my $perlpath;
my $pppath;
my $sourcefile;
my $statusbar;
my $verboselevel;
my $verboselevelbox;
my $version    = "0.1";
my $pp_bat     = ($^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);

# added by Makamaka
$main->fontCreate('MS', -family => 'ＭＳ ゴシック' );
$main->optionAdd( '*font' => 'MS 10' );

$main->title("Tkpp");

# make the menu bar
#
$main->configure(-menu => my $menu_bar = $main->Menu);
my $file_mb = $menu_bar->cascade(
    -label   => "ファイル(~F)",
    -tearoff => 0
);
my $help_mb = $menu_bar->cascade(
    -label   => "ヘルプ(~H)",
    -tearoff => 0,
);
$file_mb->command(
    -label   => "設定(~P)",
    -command => \&editpreferences
);
$file_mb->command(
    -label   => "終了(~X)",
    -command => sub { $main->destroy }
);
$help_mb->command(
    -label   => "ヘルプの内容(~H)",
    -command => \&help
);
$help_mb->command(
    -label   => "Tkppについて(~A)",
    -command => [
        sub { &showdialog },
        "Tkppについて", << ".",
Tkppは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->LabEntry(
    -textvariable => \$sourcefile,
    -label        => "入力ファイル  ",
    -background   => "white",
    -width        => 30,
    -labelPack    => [ -side => "left" ]
  )->grid(
    (   $frame->Button(
            -image   => $main->Getimage("srcfile"),
            -command => [
                sub { &openfile },
                [                 [ "Perl Files", [ ".par", ".pl", ".pm" ] ],
                    [ "All Files", ["*"] ]
                ],
                \$sourcefile
            ]
        )
    ),
    -pady => 2
  );
$frame->LabEntry(
    -textvariable => \$outputfile,
    -label        => "出力ファイル  ",
    -background   => "white",
    -width        => 30,
    -labelPack    => [ -side => "left" ]
  )->grid(
    (   $frame->Button(
            -image   => $main->Getimage("textfile"),
            -command => [
                sub { &savefile },
                [                 [ "Binary Files", ["*$Config{_exe}"] ],
                    [ "PAR Files",    [".par"] ],
                    [ "All Files",    ["*"] ]
                ],
                \$outputfile
            ]
        )
    ),
    -pady => 2
  );
$frame->LabEntry(
    -textvariable => \$iconfile,
    -label        => "アイコンの利用 ",
    -background   => "white",
    -width        => 28,
    -labelPack    => [ -side => "left" ],
  )->grid(
    (   $frame->Button(
            -image   => $main->Getimage("file"),
            -command => [
                sub { &openfile }, [ [ "ICO Files", [".ico"] ] ], \$iconfile
            ]
        )
    ),
    -pady => 2
  )
  if ($^O eq 'MSWin32');

# make the middle frame with the module lists
#
my $frame2         = $bigframe->Frame(-borderwidth => 1);
my $frame2balloon  = $frame2->Balloon();
my $addmoduleframe = $frame2->LabEntry(
    -textvariable => \$addmodules,
    -label        => "追加モジュール",
    -background   => "white",
    -width        => 30,
    -labelPack    => [ -side => "left" ]
)->grid(-pady => 2);
my $excludemoduleframe = $frame2->LabEntry(
    -textvariable => \$excludemodules,
    -label        => "除外モジュール",
    -background   => "white",
    -width        => 30,
    -labelPack    => [ -side => "left" ]
)->grid(-pady => 2);
$frame2balloon->attach(
    $addmoduleframe,
    -balloonposition => "mouse",
    -balloonmsg      =>
"指定のモジュールを、その依存物と共にパッケージに加える。個々のモジュールは,か;で区切る。"
);
$frame2balloon->attach(
    $excludemoduleframe,
    -balloonposition => "mouse",
    -balloonmsg      =>
"サーチパスから指定のモジュールを除外する。個々のモジュールは,か;で区切る。"
);

# 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 => [ 5, 4, 3, 2, 1 ],
        )
    )
  );

$frame3balloon->attach(
    $guicheck,
    -balloonposition => "mouse",
    -balloonmsg => 'コンソール画面を伴わない実行ファイルの作成。'
);
$frame3balloon->attach(
    $logcheck,
    -balloonposition => "mouse",
    -balloonmsg      =>
      'パッケージ時のログをファイルに出力。'
);
$frame3balloon->attach(
    $verbosecheck,
    -balloonposition => "mouse",
    -balloonmsg      =>
    '出力メッセージのレベルを変更。logオプションが有効でないときは無視される。'
);
$frame3balloon->attach(
    $verboselevelbox,
    -balloonposition => "mouse",
    -balloonmsg => '0〜5段階のメッセージレベル。5が最も詳細。'
);

# make the bottom frame
#
my $frame4 = $bigframe->Frame(-borderwidth => 5);
$frame4->Button(
    -text      => "作成",
    -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 = "準備完了";
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("設定が済んでいません", << ".", "error");
設定が済んでいないか設定ファイルがありません。
設定が完了するまでファイルの作成を行うことはできません。
メニューの ファイル -> 設定 を選んで作業を続けてください。
.
    }
    elsif (!$pppath) {
        showdialog("パスが設定されていません", << ".", "error");
$pp_batへのパスが設定されていません。
続けるにはメニューの ファイル -> 設定 へ進んでください。
.
    }
    elsif ($perlpath eq "") {
        showdialog("パスが設定されていません", << ".", "error");
perl$Config{_exe}へのパスが設定されていません。
続けるにはメニューの ファイル -> 設定 へ進んでください。
.
    }
    elsif (!(-e $pppath)) {
        showdialog("パスの間違い", << ".", "error");
$pp_batへのパスが間違っています。
ファイルの存在とパスが正しいかどうかを確認する必要があります。
メニューの ファイル -> 設定 を選んで設定を変更してください。
.
    }
    elsif (!(-e $perlpath)) {
        showdialog("パスの間違い", << ".", "error");
perl$Config{_exe}へのパスが間違っています。
ファイルの存在とパスが正しいかどうかを確認する必要があります。
メニューの ファイル -> 設定 を選んで設定を変更してください。
.
    }
    elsif ($sourcefile eq "") {
        showdialog("パラメータが足りません",
            "入力ファイルを指定する必要があります。", "error");
    }
    elsif ($outputfile eq "") {
        showdialog("パラメータが足りません",
            "出力ファイルを指定する必要があります。", "error");
    }
    else {
        $statusbar = "作成中...";
        $main->Busy();
        my @args = ("$pppath", "--output=$outputfile");

        if ($outputfile =~ /\Q$Config{_exe}\E$/i) {
        }
        elsif ($outputfile =~ /\.par$/i) {
            push(@args, "--par");
        }
        elsif ($outputfile =~ /\.pl$/i) {
            push(@args, "--perlscript");
        }
        else {
            showdialog("不正なファイル形式", << ".", "error");
不正なファイル形式で出力ファイルを書こうとしています。
拡張子を$Config{_exe}か.parにしなければなりません。
.
            $main->Unbusy();
            $statusbar = "準備完了";
            return ();
        }

        push(@args, $sourcefile);

        if ($iconfile) {
            push(@args, "--icon=$iconfile");
        }
        if ($dogui) {
            push(@args, $dogui);
        }
        if ($dolog) {
            push(@args, $dolog);
        }
        if ($doverbose) {
            # modified by Makamaka
            $verboselevel = ${$verboselevelbox->{Configure}->{-textvariable}};
          # $verboselevel = $verboselevelbox->getSelectedValue();
            push(@args, "$doverbose$verboselevel");
        }
        if ($addmodules) {
            foreach (split(/,|;/, $addmodules)) {
                $_ =~ s/^\s//;
                push(@args, "--add=$_");
            }
        }
        if ($excludemodules) {
            foreach (split(/,|;/, $excludemodules)) {
                $_ =~ s/^\s//;
                push(@args, "--exclude=$_");
            }
        }

        unlink($logfile);
        system($^X, @args);
        if ($dolog) {
            open LOGFILE, ">>$logfile";
            print LOGFILE "Executed Command: @args\n";
            close LOGFILE;
        }
        $main->Unbusy();
        $statusbar = "準備完了";
        # $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, $pp_bat);
        $pppath = File::Spec->catfile(dirname($perlpath), $pp_bat)
	    unless -e $pppath;
        $perlpath = '' unless -e $perlpath;
        $pppath = '' unless -e $pppath;
        open CONFIGFILE, ">>$configfile";
    }
    my $preferences = $main->DialogBox(-title => "設定");
    my $perllabentry = $preferences->add(
        "LabEntry",
        -textvariable => \$perlpath,
        -label        => "perlへのパス  ",
        -background   => "white",
        -width        => 30,
        -labelPack    => [ -side => "left" ]
      )->grid(
        (          $preferences->Button(
                -image   => $main->Getimage("openfold"),
                -command => [     sub { &openfile },
                    [                 [ "Perl",      ["perl$Config{_exe}"] ],
                        [ "All Files", ["*"] ]
                    ],
                    \$perlpath
                ]
            )
        ),
        -padx => 1,
        -pady => 10
      );
    my $pplabentry = $preferences->add(
        "LabEntry",
        -textvariable => \$pppath,
        -label        => "ppへのパス    ",
        -background   => "white",
        -width        => 30,
        -labelPack    => [ -side => "left" ]
      )->grid(
        (          $preferences->Button(
                -image   => $main->Getimage("openfold"),
                -command => [     sub { &openfile },
                    [                 [   "pp Batch File",
                            [ $pp_bat ]
                        ],
                        [ "All Files", ["*"] ]
                    ],
                    \$pppath
                ]
            )
        ),
        -padx => 1,
        -pady => 10
      );
    my $gpglabentry = $preferences->add(
        "LabEntry",
        -textvariable => \$gpgpath,
        -label        => "Path to gpg ",
        -background   => "white",
        -width        => 30,
        -labelPack    => [ -side => "left" ]
      )->grid(
        (          $preferences->Button(
                -image   => $main->Getimage("openfold"),
                -command => [     sub { &openfile },
                    [                 [ "GPG",       ["gpg$Config{_exe}"] ],
                        [ "All Files", ["*"] ]
                    ],
                    \$gpgpath
                ]
            )
        ),
        -padx => 1,
        -pady => 10
      ) if 0;
    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ヘルプ");
    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->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 参考

L<pp>, L<PAR>

=head1 作者

Tkpp was written by Doug Gruber.
In the event this application breaks, you get both pieces ;)

=head1 著作権

Copyright 2003 by Doug Gruber E<lt>doug(a)dougthug.comE<gt>,
                  Autrijus Tang E<lt>autrijus@autrijus.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>


=head1 TRANSLATION

このドキュメントはまかまか般若波羅蜜（makamaka[at]donzoko.net）によって
日本語訳されました。また、コード内のメッセージ部分も日本語化し、若干の
修正を加えています。
オリジナルのtkppはL<http://search.cpan.org/~autrijus/PAR-0.76/>から入手
できます。
この日本語化されたtkppもまた、Artistic Licenseに基づきます。

参考：L<http://www.perl.com/perl/misc/Artistic.html>

=cut