#!
package PFTPC;
use strict;
use warnings;
use Net::FTP;
use File::Copy;
use Date::Parse;
use Date::Format;
use Tk::DialogBox;
use Tk::ResizeButton;
use Tk::BrowseEntry;
use Tk::ProgressBar;
use Tk::LabEntry;
use Tk::LabFrame;
use Tk::ROText;
use Tk::HList;
use Cwd;
use Tk;

#Declarations#
my $VERSION = 2.3;
my $loadhistory = 0; my $sort_cnt = 3;
my ($ftp, $ip, $port, $after_id,); my $cwd = cwd;

my $mw = MainWindow->new(-relief => 'raised', -bd => 2,);
$mw->geometry("785x530+4+25"); &pftpc_gui(); &Tk::MainLoop();

#Subroutines#
sub pftpc_gui #---------------------------------------------------------
{
    our $hlst1     = $mw->Scrolled('HList',
                                   -bg => '#ffffff', -fg => '#000000',
                                   -selectbackground => '#000000',
                                   -selectforeground => '#fff000',
                                   -scrollbars => 'osoe',
                                   -width => '110',
                                   -columns => '4',
                                   -header => '1',
                                   -selectmode => 'extended',
                                   -takefocus => 1,);
    my $h1         = $hlst1->ResizeButton(-text => 'Name',
                                          -relief => 'flat', -bd => 0,
                                          -command => sub {&sort1();},
                                          -widget => \$hlst1,
                                          -column => 0,
                                          -anchor => 'w',
                                          -takefocus => 0,);
    my $h2         = $hlst1->ResizeButton(-text => 'Size (bytes)',
                                          -relief => 'flat', -bd => 0,
                                          -command => sub {&sort2();},
                                          -widget => \$hlst1,
                                          -column => 1,
                                          -anchor => 'w',
                                          -takefocus => 0,);
    my $h3         = $hlst1->ResizeButton(-text => "Time/Date",
                                          -relief => 'flat', -bd => 0,
                                          -command => sub {&sort3();},
                                          -widget => \$hlst1,
                                          -column => 2,
                                          -anchor => 'w',
                                          -takefocus => 0,);
    my $f1         = $mw->Frame(-relief => 'sunken', -bd => 2,);
    my $lab1       = $mw->Label(-font => 'Verdana 16',
                                -relief => 'raised',
                                -borderwidth => '2.5',
                                -text => 'Perl FTP Client',);
    my $lab2       = $mw->Label(-text => 'Username:  ',);
    my $lab3       = $mw->Label(-text => '  Password:  ',);
    my $lab4       = $mw->Label(-text => 'Location:  ',);
    our $lf1       = $mw->LabFrame(-borderwidth => 2,
                                   -relief => 'groove',
                                   -label => "Connection Status",
                                   -labelside => 'acrosstop',);
    our $ent1_host = $mw->Entry(-width => '80',
                                -textvariable => \our $host,
                                -bg => '#ffffff', -fg => '#000000',
                                -selectbackground => 'black',
                                -selectforeground => 'yellow',);
    my $ent2_user  = $mw->Entry(-textvariable => \our $user,
                                -bg => '#ffffff', -fg => '#000000',
                                -selectbackground => 'black',
                                -selectforeground => 'yellow',);
    my $ent3_pass  = $mw->Entry(-show => '*',
                                -textvariable => \our $pass,
                                -bg => '#ffffff', -fg => '#000000',
                                -selectbackground => 'black',
                                -selectforeground => 'yellow',);
    my $b1_logi    = $mw->Button(-text => 'Login',
                                 -activeforeground => '#fff000',);
    my $b2_logo    = $mw->Button(-text => 'Logout',
                                 -activeforeground => '#fff000',);
    my $b3_get     = $mw->Button(-text => 'Get',
                                 -activeforeground => '#fff000',);
    my $b4_put     = $mw->Button(-text => 'Put',
                                 -activeforeground => '#fff000',);
    my $b5_mkdir   = $mw->Button(-text => 'MkDir',
                                 -activeforeground => '#fff000',);
    my $b6_ren     = $mw->Button(-text => 'Rename',
                                 -activeforeground => '#fff000',);
    my $b7_del     = $mw->Button(-text => 'Delete',
                                 -activeforeground => '#fff000',);
    my $b8_help    = $mw->Button(-text => 'Help',
                                 -activeforeground => '#fff000',);
    my $b9_exit    = $mw->Button(-text => 'Exit',
                                 -activeforeground => '#fff000',);
    my $b10_bmark  = $mw->Button(-text => 'Bookmarks',
                                 -activeforeground => '#fff000',
                                 -relief => 'flat',);
    our $b11_hist  = $mw->Button(-activeforeground => '#fff000',
                                 -bitmap => '@' .
                                    Tk->findINC('cbxarrow.xbm'),);

    our $tl1      = $mw->Toplevel(-takefocus   => 1,
                                  -relief      => 'raised',
                                  -borderwidth => 2.5);
                                  $tl1->overrideredirect(1);
                                  $tl1->resizable(0, 0);
                                  $tl1->transient($mw);
                                  $tl1->withdraw;
                                  $tl1->geometry("300x60+225+260");
    my $lab1_Pbar = $tl1->Label(-text => 'Working...',);
    my $f1_Pbar   = $tl1->Frame(-borderwidth => 2, -relief => 'sunken',);
    my $pb1_Pbar  = $f1_Pbar->ProgressBar(-width => 25,
                                          -length => 270,
                                          -relief => 'raised', -bd => 4,
                                          -from => 0,
                                          -to => 100,
                                          -blocks => 50,
                                          -colors => [0, 'green'],
                                          -variable => \our $pb,);

    our $tl2      = $mw->Toplevel(-bg => '#000000');
                                  $tl2->title('Bookmarks');
                                  $tl2->geometry("+130+80");
                                  $tl2->resizable(0, 0);
                                  $tl2->transient($mw);
                                  $tl2->withdraw;
    our $lb_bmark = $tl2->Scrolled('Listbox', -scrollbars => 'osoe',
                                   -bg => '#000000', -fg  => '#ffffff',
                                   -selectforeground      => '#000000',
                                   -selectbackground      => '#fff000',
                                   -highlightbackground   => 'grey64',
                                   -highlightcolor        => 'grey64',
                                   -selectmode => 'single',
                                   -cursor => 'arrow', -width => 80,);
    my $e1_bmark  = $tl2->Entry(-width => 60,
                                -bg => '#ffffff', -fg => '#000000',
                                -selectforeground => '#fff000',
                                -selectbackground => '#000000',
                                -textvariable => \our $add,);
    my $b1_bmark  = $tl2->Button(-text => 'Add Bookmark',
                                 -bg => '#000000', -fg => '#ffffff',
                                 -activeforeground => '#fff000',
                                 -activebackground => '#000000',
                                 -relief => 'flat',);
    my $b2_bmark  = $tl2->Button(-text => 'Close', -relief => 'flat',
                                 -bg => '#000000', -fg => '#ffffff',
                                 -activeforeground => '#fff000',
                                 -activebackground => '#000000',);

    our $tl3      = $mw->Toplevel(-relief => 'flat',);
                    $tl3->overrideredirect(1);
                    $tl3->resizable(0, 0);
                    $tl3->transient($mw);
                    $tl3->withdraw;
    our $f1_hist  = $tl3->Frame(-relief => 'groove', -bd => 2,
                                -takefocus => '1',);
    our $lb_hist  = $tl3->Scrolled('Listbox', -scrollbars => 'ose',
                                   -selectmode => 'single',
                                   -width => 80, -height => 8,
                                   -bg => '#000000', -fg => '#ffffff',
                                   -selectforeground => '#000000',
                                   -selectbackground => '#fff000',);

    our $tl4      = $mw->Toplevel(-relief => 'raised', -bd => 2,
                                  -takefocus => '1',);
                    $tl4->overrideredirect(1);
                    $tl4->resizable(0, 0);
                    $tl4->transient($mw);
                    $tl4->withdraw;
    my $f1_men    = $tl4->Frame(-relief => 'ridge', -bd => 2,);
    my $f2_men    = $tl4->Frame(-relief => 'ridge', -bd => 2,);
    my $f3_men    = $tl4->Frame(-relief => 'ridge', -bd => 2,);
    my $f4_men    = $tl4->Frame(-relief => 'ridge', -bd => 2,);
    my $b1_men    = $tl4->Button(-text => 'Get',
                                 -width => 10,
                                 -relief => 'groove', -bd => 2,
                                 -activeforeground => "#fff000",);
    my $b2_men    = $tl4->Button(-text => 'Get & Open',
                                 -width => 10,
                                 -relief => 'groove', -bd => 2,
                                 -activeforeground => "#fff000",);
    my $b3_men    = $tl4->Button(-text => 'Rename',
                                 -width => 10,
                                 -relief => 'groove', -bd => 2,
                                 -activeforeground => "#fff000",);
    my $b4_men    = $tl4->Button(-text => 'Delete',
                                 -width => 10,
                                 -relief => 'groove', -bd => 2,
                                 -activeforeground => "#fff000",);
    my $b5_men    = $tl4->Button(-text => 'Put',
                                 -width => 10,
                                 -relief => 'groove', -bd => 2,
                                 -activeforeground => "#fff000",);
    my $b6_men    = $tl4->Button(-text => 'MakeDir',
                                 -width => 10,
                                 -relief => 'groove', -bd => 2,
                                 -activeforeground => "#fff000",);
    my $b7_men    = $tl4->Button(-text => " Add to\nBookmarks",
                                 -width => 10,
                                 -relief => 'groove', -bd => 2,
                                 -activeforeground => "#fff000",);

    #Bindings#
    $tl1->protocol(WM_DELETE_WINDOW => sub {$tl1->withdraw;});
    $tl2->protocol(WM_DELETE_WINDOW => sub {$tl2->withdraw;});
    $tl3->protocol(WM_DELETE_WINDOW => sub {$tl3->withdraw;});
    $tl4        ->bind('<FocusOut>' => sub {$tl4->withdraw;});
    $f1_hist    ->bind('<FocusOut>' => sub {
        $lb_hist->selectionClear(0, "end");
        $tl3    ->withdraw;
    });
    $lab1->bind('<ButtonPress-1>' => sub {
        $lab1->configure(-text    => ''); $mw->update; $mw->after(250);
        $lab1->configure(-anchor  => 'w');
        my $save;
        foreach my $l ('-', '=', 'P', 'F', 'T', 'P', 'C', '=', '-',) {
            my $c = 40;
            while ($c >=0)  {
                unless ($save)  {$save = ' ';}
                $lab1->configure(-text => ' 'x44 ."$save".' 'x$c."$l");
                $mw->update; $c--;
            }$save .= $l;
        }$mw->after(1000);
        $lab1->configure(-anchor => 'center');
        $lab1->configure(-text   => ''); $mw->update; $mw->after(250);
        $lab1->configure(-text   => 'Perl FTP Client');
    });
    $ent1_host->bind("<Return>"          => \&b1_login_cmd);
    $hlst1    ->bind("<Double-Button-1>" => \&b3_get_cmd);
    $b10_bmark->bind('<ButtonPress-1>'   => sub {
        $b10_bmark->configure(-relief    => 'flat',);
        $b10_bmark->configure(-fg        => 'green');
        $b10_bmark->flash; $b10_bmark->flash;
        $b10_bmark->configure(-fg        => '#000000');
    });
    $b1_bmark->bind('<ButtonPress-1>' => sub {
        $b1_bmark->configure(-relief  => 'flat',);
        $b1_bmark->configure(-fg      => 'cyan');
        $b1_bmark->flash; $b1_bmark->flash;
        $b1_bmark->configure(-fg      => '#ffffff');
    });
    $b2_bmark->bind('<ButtonPress-1>' => sub {
        $b2_bmark->configure(-relief  => 'flat',);
        $b2_bmark->configure(-fg      => 'red');
        $b2_bmark->flash; $b2_bmark->flash;
        $b2_bmark->configure(-fg      => '#ffffff');
    });
    $lb_bmark->bind('<Double-Button-1>' => sub {
        my @sel = $lb_bmark->curselection;
        my $val = $lb_bmark->get("$sel[0]");
        undef $host; $host = $val; $tl2->withdraw;
    });
    $lb_bmark->bind('<Delete>'          => \&bmark_del_cmd);
    $lb_bmark->bind('<ButtonPress-1>'   => sub {$lb_bmark->focus;});
    $lb_hist ->bind('<ButtonPress-1>'   => \&hist_sel);
    $hlst1   ->bind('<ButtonPress-3>'   => \&Tk::HList::Button1);
    $hlst1   ->bind('<ButtonRelease-3>' => \&menu1);
    &BindMouseWheel($hlst1); &BindMouseWheel($lb_bmark);

    #Widget Configuration
    our $sys_bg = $ent2_user->cget(-background);
    our $sys_fg = $ent2_user->cget(-foreground);
    $hlst1    ->columnWidth(0, -char => '68');
    $hlst1    ->columnWidth(1, -char => '20');
    $hlst1    ->columnWidth(2, -char => '25');
    $hlst1    ->columnWidth(3, -char => '');
    $hlst1    ->header('create', 0, -borderwidth => 1,
                       -itemtype => 'window',
                       -widget   => $h1,);
    $hlst1    ->header('create', 1, -borderwidth => 1,
                       -itemtype => 'window',
                       -widget   => $h2,);
    $hlst1    ->header('create', 2, -borderwidth => 1,
                       -itemtype => 'window',
                       -widget   => $h3,);
    $hlst1    ->header('create', 3, -borderwidth => 1,);
    $b1_logi  ->configure(-command => \&b1_login_cmd);
    $b2_logo  ->configure(-command => \&b2_logout_cmd);
    $b3_get   ->configure(-command => \&b3_get_cmd);
    $b4_put   ->configure(-command => \&b4_put_cmd);
    $b5_mkdir ->configure(-command => \&b5_mkdir_cmd);
    $b6_ren   ->configure(-command => \&b6_ren_cmd);
    $b7_del   ->configure(-command => \&b7_del_cmd);
    $b8_help  ->configure(-command => \&b8_help_cmd);
    $b9_exit  ->configure(-command => \&b9_exit_cmd);
    $b10_bmark->configure(-command => \&b10_bmark_cmd);
    $b11_hist ->configure(-command => \&b11_hist_cmd);

    $b1_bmark ->configure(-command => \&b1_bmark_cmd);
    $b2_bmark ->configure(-command => sub {$tl2->withdraw;});

    $b1_men->configure(-command => \&b3_get_cmd);
    $b2_men->configure(-command => sub {&b3_get_cmd('O');});
    $b3_men->configure(-command => \&b6_ren_cmd);
    $b4_men->configure(-command => \&b7_del_cmd);
    $b5_men->configure(-command => \&b4_put_cmd);
    $b6_men->configure(-command => \&b5_mkdir_cmd);
    $b7_men->configure(-command => \&add_to_bmark);

    #Widget Geometry
    $hlst1    ->grid(-in     => $mw,          -columnspan => '8',
                     -column => '2',          -rowspan    => '8',
                     -row    => '6',          -sticky     => 'news');
    $f1       ->grid(-in     => $mw,          -columnspan => '12',
                     -column => '1',          -rowspan    => '1',
                     -row    => '1',          -sticky     => 'nsew');
    $lab1     ->grid(-in     => $f1,          -columnspan => '1',
                     -column => '1',          -rowspan    => '1',
                     -row    => '1',          -sticky     => 'wsne');
    $lab2     ->grid(-in     => $mw,          -columnspan => '1',
                     -column => '2',          -rowspan    => '1',
                     -row    => '4',          -sticky     => 'nsw');
    $lab3     ->grid(-in     => $mw,          -columnspan => '1',
                     -column => '4',          -rowspan    => '1',
                     -row    => '4',          -sticky     => 'nse');
    $lab4     ->grid(-in     => $mw,          -columnspan => '1',
                     -column => '2',          -rowspan    => '1',
                     -row    => '3',          -sticky     => 'nsw');
    $ent1_host->grid(-in     => $mw,          -columnspan => '3',
                     -column => '3',          -rowspan    => '1',
                     -row    => '3',          -sticky     => 'w');
    $ent2_user->grid(-in     => $mw,          -columnspan => '1',
                     -column => '3',          -rowspan    => '1',
                     -row    => '4',          -sticky     => 'w');
    $ent3_pass->grid(-in     => $mw,          -columnspan => '1',
                     -column => '5',          -rowspan    => '1',
                     -row    => '4',          -sticky     => 'w');
    $b1_logi  ->grid(-in     => $mw,          -columnspan => '1',
                     -column => '11',         -rowspan    => '1',
                     -row    => '3',          -sticky     => 'new');
    $b2_logo  ->grid(-in     => $mw,          -columnspan => '1',
                     -column => '11',         -rowspan    => '1',
                     -row    => '4',          -sticky     => 'new');
    $b3_get   ->grid(-in     => $mw,          -columnspan => '1',
                     -column => '11',         -rowspan    => '1',
                     -row    => '6',          -sticky     => 'new');
    $b4_put   ->grid(-in     => $mw,          -columnspan => '1',
                     -column => '11',         -rowspan    => '1',
                     -row    => '7',          -sticky     => 'new');
    $b5_mkdir ->grid(-in     => $mw,          -columnspan => '1',
                     -column => '11',         -rowspan    => '1',
                     -row    => '8',          -sticky     => 'new');
    $b6_ren   ->grid(-in     => $mw,          -columnspan => '1',
                     -column => '11',         -rowspan    => '1',
                     -row    => '9',          -sticky     => 'new');
    $b7_del   ->grid(-in     => $mw,          -columnspan => '1',
                     -column => '11',         -rowspan    => '1',
                     -row    => '10',         -sticky     => 'new');
    $b8_help  ->grid(-in     => $mw,          -columnspan => '1',
                     -column => '11',         -rowspan    => '1',
                     -row    => '11',         -sticky     => 'new');
    $b9_exit  ->grid(-in     => $mw,          -columnspan => '1',
                     -column => '11',         -rowspan    => '1',
                     -row    => '12',         -sticky     => 'new');
    $b10_bmark->grid(-in     => $mw,          -columnspan => '3',
                     -column => '6',          -rowspan    => '1',
                     -row    => '4',          -sticky     => 'n');
    $b11_hist ->grid(-in     => $mw,          -columnspan => '1',
                     -column => '6',          -rowspan    => '1',
                     -row    => '3',          -sticky     => 'w');
    $lf1      ->grid(-in     => $mw,          -columnspan => '12',
                     -column => '1',          -rowspan    => '1',
                     -row    => '15',         -sticky     => 'nesw');

    $lab1_Pbar->grid(-in     => $tl1,         -columnspan => '1',
                     -column => '1',          -rowspan    => '1',
                     -row    => '1',          -sticky     => 'sw');
    $f1_Pbar  ->grid(-in     => $tl1,         -columnspan => '1',
                     -column => '1',          -rowspan    => '1',
                     -row    => '2',          -sticky     => 'new');
    $pb1_Pbar ->grid(-in     => $f1_Pbar,     -columnspan => '1',
                     -column => '1',          -rowspan    => '1',
                     -row    => '1',          -sticky     => 'news');

    $lb_bmark ->grid(-in     => $tl2,         -columnspan => '2',
                     -column => '2',          -rowspan    => '1',
                     -row    => '2',          -sticky     => 'news');
    $e1_bmark ->grid(-in     => $tl2,         -columnspan => '1',
                     -column => '2',          -rowspan    => '1',
                     -row    => '4',          -sticky     => 'ew');
    $b1_bmark ->grid(-in     => $tl2,         -columnspan => '1',
                     -column => '3',          -rowspan    => '1',
                     -row    => '4',          -sticky     => '');
    $b2_bmark ->grid(-in     => $tl2,         -columnspan => '1',
                     -column => '3',          -rowspan    => '1',
                     -row    => '6',          -sticky     => '');

    $f1_hist  ->grid(-in     => $tl3,         -columnspan => '1',
                     -column => '1',          -rowspan    => '1',
                     -row    => '1',          -sticky     => 'news');
    $lb_hist  ->grid(-in     => $f1_hist,     -columnspan => '1',
                     -column => '1',          -rowspan    => '1',
                     -row    => '1',          -sticky     => 'news');

    $f1_men   ->grid(-in     => $tl4,         -columnspan => '1',
                     -column => '1',          -rowspan    => '1',
                     -row    => '1',          -sticky     => 'news');
    $f2_men   ->grid(-in     => $tl4,         -columnspan => '1',
                     -column => '1',          -rowspan    => '1',
                     -row    => '2',          -sticky     => 'news');
    $f3_men   ->grid(-in     => $tl4,         -columnspan => '1',
                     -column => '1',          -rowspan    => '1',
                     -row    => '3',          -sticky     => 'news');
    $f4_men   ->grid(-in     => $tl4,         -columnspan => '1',
                     -column => '1',          -rowspan    => '1',
                     -row    => '4',          -sticky     => 'news');
    $b1_men   ->grid(-in     => $f1_men,      -columnspan => '1',
                     -column => '1',          -rowspan    => '1',
                     -row    => '1',          -sticky     => 'news');
    $b2_men   ->grid(-in     => $f1_men,      -columnspan => '1',
                     -column => '1',          -rowspan    => '1',
                     -row    => '2',          -sticky     => 'news');
    $b3_men   ->grid(-in     => $f2_men,      -columnspan => '1',
                     -column => '1',          -rowspan    => '1',
                     -row    => '1',          -sticky     => 'news');
    $b4_men   ->grid(-in     => $f2_men,      -columnspan => '1',
                     -column => '1',          -rowspan    => '1',
                     -row    => '2',          -sticky     => 'news');
    $b5_men   ->grid(-in     => $f3_men,      -columnspan => '1',
                     -column => '1',          -rowspan    => '1',
                     -row    => '1',          -sticky     => 'news');
    $b6_men   ->grid(-in     => $f3_men,      -columnspan => '1',
                     -column => '1',          -rowspan    => '1',
                     -row    => '2',          -sticky     => 'news');
    $b7_men   ->grid(-in     => $f4_men,      -columnspan => '1',
                     -column => '1',          -rowspan    => '1',
                     -row    => '1',          -sticky     => 'news');

    #Grid Configuration
    $mw->gridRowconfigure(1,         -minsize => 2,);
    $mw->gridRowconfigure(2,         -minsize => 8,);
    $mw->gridRowconfigure(3,         -minsize => 2,);
    $mw->gridRowconfigure(4,         -minsize => 2,);
    $mw->gridRowconfigure(5,         -minsize => 8,);
    $mw->gridRowconfigure(6,         -minsize => 2,);
    $mw->gridRowconfigure(7,         -minsize => 2,);
    $mw->gridRowconfigure(8,         -minsize => 2,);
    $mw->gridRowconfigure(9,         -minsize => 2,);
    $mw->gridRowconfigure(10,        -minsize => 2,);
    $mw->gridRowconfigure(11,        -minsize => 2,);
    $mw->gridRowconfigure(12,        -minsize => 2,);
    $mw->gridRowconfigure(13,        -minsize => 180, -weight => 1,);
    $mw->gridRowconfigure(14,        -minsize => 2,);
    $mw->gridRowconfigure(15,        -minsize => 2,);
    $mw->gridColumnconfigure(1,      -minsize => 8,);
    $mw->gridColumnconfigure(2,      -minsize => 8,);
    $mw->gridColumnconfigure(3,      -minsize => 8,);
    $mw->gridColumnconfigure(4,      -minsize => 8,);
    $mw->gridColumnconfigure(5,      -minsize => 8,);
    $mw->gridColumnconfigure(6,      -minsize => 8, -weight => 1,);
    $mw->gridColumnconfigure(7,      -minsize => 8,);
    $mw->gridColumnconfigure(8,      -minsize => 8,);
    $mw->gridColumnconfigure(9,      -minsize => 8,);
    $mw->gridColumnconfigure(10,     -minsize => 8,);
    $mw->gridColumnconfigure(11,     -minsize => 8,);
    $mw->gridColumnconfigure(12,     -minsize => 8,);

    $f1->gridRowconfigure(1,         -minsize => 8, -weight => 1,);
    $f1->gridColumnconfigure(1,      -minsize => 8, -weight => 1,);

    $tl1->gridRowconfigure(1,        -minsize => 8,);
    $tl1->gridRowconfigure(2,        -minsize => 40,);
    $tl1->gridColumnconfigure(1,     -minsize => 8,);
    $f1_Pbar->gridRowconfigure(1,    -minsize => 8,);
    $f1_Pbar->gridColumnconfigure(1, -minsize => 8,);

    $tl2->gridRowconfigure(1,        -minsize => 8,);
    $tl2->gridRowconfigure(2,        -minsize => 250,);
    $tl2->gridRowconfigure(3,        -minsize => 8,);
    $tl2->gridRowconfigure(4,        -minsize => 8,);
    $tl2->gridRowconfigure(5,        -minsize => 8,);
    $tl2->gridRowconfigure(6,        -minsize => 8,);
    $tl2->gridColumnconfigure(1,     -minsize => 8,);
    $tl2->gridColumnconfigure(2,     -minsize => 40,);
    $tl2->gridColumnconfigure(3,     -minsize => 40,);
    $tl2->gridColumnconfigure(4,     -minsize => 8,);

    $tl3->gridRowconfigure(1,        -minsize => 8,);
    $tl3->gridColumnconfigure(1,     -minsize => 8,);
    $f1_hist->gridRowconfigure(1,    -minsize => 8,);
    $f1_hist->gridColumnconfigure(1, -minsize => 8,);

    $tl4->gridRowconfigure(1,        -minsize => 8,);
    $tl4->gridRowconfigure(2,        -minsize => 8,);
    $tl4->gridRowconfigure(3,        -minsize => 8,);
    $tl4->gridRowconfigure(4,        -minsize => 8,);
    $tl4->gridColumnconfigure(1,     -minsize => 8,);
    $f1_men->gridRowconfigure(1,     -minsize => 8,);
    $f1_men->gridRowconfigure(2,     -minsize => 8,);
    $f1_men->gridColumnconfigure(1,  -minsize => 8,);
    $f2_men->gridRowconfigure(1,     -minsize => 8,);
    $f2_men->gridRowconfigure(2,     -minsize => 8,);
    $f2_men->gridColumnconfigure(1,  -minsize => 8,);
    $f3_men->gridRowconfigure(1,     -minsize => 8,);
    $f3_men->gridRowconfigure(2,     -minsize => 8,);
    $f3_men->gridColumnconfigure(1,  -minsize => 8,);
    $f4_men->gridRowconfigure(1,     -minsize => 8,);
    $f4_men->gridColumnconfigure(1,  -minsize => 8,);

    #Defaults
    $ent1_host->focus;
    our $lf1_txt = $lf1->Label(-text => 'Not Connected')->pack;

    #Callbacks
    sub b1_login_cmd #--------------------------------------------------
    {
        $mw->Busy(-recurse => 1); $hlst1->focus; $lf1_txt->destroy;
        $lf1_txt = $lf1->Label(-text => 'Not Connected')->pack;

        my $dir; $port = 21;
        unless ($host) {$host = 'localhost'}
        unless ($user) {$user = 'anonymous';
                        $pass = 'anonymous@domain.invalid'}
        $host =~ s#ftp://##;                            #remove 'ftp://'
        @_ = split(':', $host);                         #determine port
        if ($_[1]) {$port = pop @_; $host = join(':', @_);}
        @_    = split('/', $host);                      #determine dir
        $host = shift @_; $dir = join('/', @_);

        &loadhistory() unless ($loadhistory == 1); &history();

        if ($ftp = Net::FTP->new("$host", Port => "$port",)) {  #connect
            $after_id    = $mw->repeat(90000, sub
                {my $stat = $ftp->quot('stat');});
            if  ($pass) {my $a = $ftp->login("$user", "$pass");
                         unless ($a) {&error(2); goto b1_end;}}
            else        {my $a = $ftp->login("$user");}

            $ftp->cwd("$dir") || $ftp->cwd();                       #cwd
            &ftp_session();
        }else{ &error(1) } b1_end: $mw->Unbusy;
    }
    sub b2_logout_cmd #-------------------------------------------------
    {
        if ($ftp) {
            $after_id->cancel;
            $ftp->quit; $lf1_txt->destroy;
            $lf1_txt = $lf1->Label(-text => 'Not Connected')->pack;
        }$hlst1->delete('all'); undef $ftp;
    }
    sub b3_get_cmd #----------------------------------------------------
    {
        if ($ftp) {
          my $open_var = $_[0]; unless ($open_var) {$open_var = 'X';}
          $mw->Busy(-recurse => 1,); $pb = 0;
          my @selected = $hlst1->selectionGet;
          foreach (@selected) {
              my $sel   = $hlst1->itemCget($_, 0, -text);
              my $isdir = $hlst1->itemCget($_, 1, -text);
              if ($_ eq 'up1') {$ftp->cdup; goto b3_end;}
              if ($isdir eq '<DIR>')
                 {$ftp->cwd($sel) || &error(3); goto b3_end;}
              if ($isdir eq '<LINK>') {
                  my $fs  = 0; linkstart: my $tst = $ftp->cwd($sel);
                  if ($tst == 0) {
                      $fs++;
                      my  @a = split('/', $sel);
                      pop @a;  $sel = join('/', @a);
                      unless($fs > 10) {goto linkstart;}
                  }else{ goto b3_end; }
                  $ftp->cwd($sel) || &error(3); goto b3_end;
              }
              $tl1->deiconify(); $tl1->raise(); $tl1->focus; $tl1->Busy;
              $pb++; $tl1->update; $pb++; $tl1->update;
              $pb++; $tl1->update; $pb++; $tl1->update;
              $ftp->pasv; $ftp->binary;
              $pb += 5; $tl1->update; $pb += 5; $tl1->update;
              $pb += 5; $tl1->update; $pb += 5; $tl1->update;
              if ($ftp->get($sel, '~pftpc.tmp')) { $tl1->focus;
                  while ($pb < 100) {$pb += 2; $tl1->update;}
                  $tl1->Unbusy; my $sfile = &save_file("$sel");
                  if ($open_var eq 'O') {
                      #$sfile =~ m#(\b.+)\/(.+\..{3,4})#;
                      $sfile =~ m#(\b.+)\/(.+)#;
                      $sfile =~ m#(.+)\/(.+)#  unless ($2);
                      if ($^O eq 'MSWin32')
                          { chdir "$1"; `"start $2"`; chdir "$cwd"; }
                      else{ chdir "$1";       `"$2"`; chdir "$cwd"; } #nfi
              }   }
          }b3_end: undef $open_var;
          $mw->Unbusy; $tl1->withdraw; $mw->update; &ftp_session();
        }
    }
    sub b4_put_cmd #----------------------------------------------------
    {
        if ($ftp) {
          if (my $current_dir = $ftp->pwd()){}
          else {&error('put1');}
          my $ofile = $mw->getOpenFile(-title=>'Select File for Upload',);
          if (defined ($ofile)) {
              $mw->Busy(-recurse => 1,); $mw->update;
              $ftp->put($ofile) or &error(4);
          }$mw->Unbusy; $mw->update; &ftp_session();
        }
    }
    sub b5_mkdir_cmd #--------------------------------------------------
    {
        if ($ftp) {
          my $db = $mw->DialogBox(-title => 'Create New Directory',
                                  -buttons => ['MkDir', 'Cancel'],
                                  -default_button => 'MkDir');
          $db->add('LabEntry',
                   -textvariable => \my $mdir,
                   -width        => 20,
                   -background   => "$sys_bg",
                   -foreground   => "$sys_fg",
                   -label => 'New Dir:',
                   -labelPack    => [-side => 'left'])->pack;
          my $answer = $db->Show();
          if ($answer eq "MkDir") {$ftp->mkdir($mdir, 1) or &error(5);}
          &ftp_session();
        }
    }
    sub b6_ren_cmd #----------------------------------------------------
    {
        my @selected = $hlst1->selectionGet;
        foreach(@selected) {
            my $sel = $hlst1->itemCget($_, 0, -text);
            if ($_ eq 'up1') {goto b6_end;}

            my $db = $mw->DialogBox(-title => 'Rename File or Directory',
                                    -buttons => ['Rename', 'Cancel'],
                                    -default_button => 'Rename');
            $db->add('LabEntry',
                     -textvariable => \my $from,
                     -width        => 20,
                     -label        => 'From:',
                     -state        => 'disabled',
                     -labelPack    => [-side => 'left'])->pack;
            $db->add('LabEntry',
                     -textvariable => \my $to,
                     -width => 20,
                     -background   => "$sys_bg",
                     -foreground   => "$sys_fg",
                     -label => '   To:',
                     -labelPack    => [-side => 'left'])->pack;
            $from = $sel;
            my $answer = $db->Show();
            if ($answer eq "Rename") {$ftp->rename($sel, $to)
                                      or &error(6);}
        }b6_end: &ftp_session();
    }
    sub b7_del_cmd #----------------------------------------------------
    {
        my @selected = $hlst1->selectionGet;
        foreach(@selected) {
            my $sel   = $hlst1->itemCget($_, 0, -text);
            my $isdir = $hlst1->itemCget($_, 1, -text);
            if ($_ eq 'up1')       {goto b7_end;}
            my $db = $mw->DialogBox(-title => 'Confirm Delete',
                                    -buttons => ['Delete', 'Cancel'],
                                    -default_button => 'Cancel');
            $db->add('Label',
                     -text => "Delete $sel ?",)->pack;
            my $answer = $db->Show();
            if ($answer eq "Delete") {
                if   ($isdir eq '<DIR>') {$ftp->rmdir($sel, '1')
                                          or &error(7);}
                else {$ftp->delete($sel)  or &error(7);}
            }
        }b7_end: &ftp_session();
    }
    sub b8_help_cmd #---------------------------------------------------
    {
        my $email = 'QoS@cpan.org'; my $clptk = '$_@_.%_';
        my $db = $mw->DialogBox(-title => 'PFTPC Help',
                                -buttons => ['Close'],
                                -default_button => 'Close');
        my $t = $db->add('Scrolled', 'ROText',
                         -background => 'black', -foreground => 'white',
                         -scrollbars => 'oe',
                         -width      => 80,
                         -height     => 20,)->pack;
        $t ->insert('end', <<ENDTEXT
Examples of FTP sites:  ftp.cpan.org
                        ftp://ftp.cpan.org
                        ftp://ftp.cpan.org:21
                        192.168.0.1:55555
                        127.0.0.1

Use the User and Password fields if the FTP site requires it.

If no Port information is entered then the default port 21 will be used.
Unless a Username is entered the default anonymous login will be used.

Please note:  Please send comments/bugs/suggestions to:
              $email or $clptk on the c.l.p.tk newsgroup.
              Thank you.
ENDTEXT
    );$db->Show();}
    sub b9_exit_cmd #---------------------------------------------------
        {exit;}
    sub b10_bmark_cmd #-------------------------------------------------
    {
        $tl2->deiconify; $tl2->raise;
        $lb_bmark->delete(0, 'end');
        if (-e 'bookmark.txt') {
            open (FH, '< bookmark.txt'); my @b = (<FH>); close FH;
            foreach (@b) {chomp $_; $lb_bmark->insert('end', "$_");}
        }else{
            open (FH, '> bookmark.txt') or &error('bmark1');
            if ('FH') {close FH;}
        }
    }
    sub b1_bmark_cmd #--------------------------------------------------
    {
        if (-e 'bookmark.txt' and $add) {
            $lb_bmark->insert('end', "$add");
            open (FH, '>> bookmark.txt');
            print FH "$add\n";
            close FH; undef $add;
        }
    }
    sub bmark_del_cmd #-------------------------------------------------
    {
        my @sel = $lb_bmark->curselection;
        if (@sel) {
            my $val = $lb_bmark->get("$sel[0]");
            open (FH, '< bookmark.txt'); my @b = (<FH>); close FH;
            open (FH, '> bookmark.txt');
            $lb_bmark->delete(0, 'end');
            foreach my $i (@b) {
                chomp $i; #print "i is: $i\n"; debugging
                unless ($i eq "$val") {
                    print FH "$i\n";
                    $lb_bmark->insert('end', $i);
            }}close FH;
        }
    }
    sub add_to_bmark #--------------------------------------------------
    {
        if ($ftp) {
          $hlst1->focus;
          my $cwd = $ftp->pwd(); unless ($cwd) {$cwd = '/';}
          my $bmark = "$host" . "$cwd";
          if (-e 'bookmark.txt' and $bmark) {
              $lb_bmark->insert('end', "$bmark");
              open (FH, '>> bookmark.txt');
              print FH "$bmark\n";
              close FH; undef $bmark;
              &b10_bmark_cmd();
        } }
    }
    sub ftp_session #---------------------------------------------------
    {
        unless ($ftp) {goto ftp_session_end;}
        my $cwd = $ftp->pwd(); unless ($cwd) {$cwd = 'PWD Not Supported'};
        $lf1_txt->destroy; $lf1_txt = $lf1->Label(-text => "$user is ".
                                        "logged into $host:$port".
                                        "\t\tThe Current Working".
                                        " Directory is: $cwd",)->pack;
        my $counter = 0;
        my ($filename, $filesize, $timedate, $perms, %HoH,);
        my $dir_raw = $ftp->dir; unless ($dir_raw) {&b2_logout_cmd();}

        $hlst1->delete('all');
        $hlst1->add('up1');
        $hlst1->itemCreate('up1', 0, -text => '...Up one level');
        $hlst1->itemCreate('up1', 1, -text => '');
        $hlst1->itemCreate('up1', 2, -text => '');

        foreach my $line(@{$dir_raw}) {
            $line =~ m{([a-zA-Z-]*)\s*                      #perms
                       ([0-9]*)\s*                          #inode
                       ([0-9a-zA-Z]*)\s*                    #owner
                       ([0-9a-zA-Z]*)\s*                    #group
                       ([0-9]*)\s*                          #size
                       ([A-Za-z]*)\s*                       #month
                       ([0-9]*)\s*                          #day
                       ([0-9A-Za-z:]*)\s*                   #YearOrTime
                       ([\w*\W*\s*\S*]*)                    #name
                       }x;
            my $perm = $1;  my $inode = $2; my $owner = $3;
            my $group = $4; my $size = $5;  my $month = $6;
            my $day = $7;   my $YearOrTime = $8;
            my $name = $9;  my ($lTarget, $lName,);

            if ($line =~ m#\s*->\s*([A-Za-z0-9.-/]*)#) {$lTarget = $1;
                $name =~ m#(.*)->.*#;                   $lName   = $1;
                                                        $name = $lTarget;}

            $HoH{$name}{perm}       = $perm;
            $HoH{$name}{inode}      = $inode;
            $HoH{$name}{owner}      = $owner;
            $HoH{$name}{group}      = $group;
            $HoH{$name}{size}       = $size;
            $HoH{$name}{month}      = $month;
            $HoH{$name}{day}        = $day;
            $HoH{$name}{YearOrTime} = $YearOrTime;
            $HoH{$name}{lTarget}    = $lTarget;
        }
        for my $keys1 (sort keys %HoH) {
            $filename .= $keys1;
            $perms     = $HoH{$keys1} {perm};
            $filesize .= $HoH{$keys1} {size} . ' ';
            $timedate .= $HoH{$keys1} {month} . ' ';
            $timedate .= $HoH{$keys1} {day} . ' ';
            $timedate .= $HoH{$keys1} {YearOrTime};

            if ($filename eq '.'or $filename eq '..'or $filename eq '')
                {delete $HoH{$keys1}; goto populate_end;}

            my $epoch       = str2time($timedate);
            chomp($timedate = ctime($epoch)); undef $epoch;

            if ($perms =~ m/^d+?/i) {$filesize  = '<DIR>';}
            if ($perms =~ m/^l+?/i) {$filesize  = '<LINK>';}

            $hlst1->add($counter);
            $hlst1->itemCreate($counter, 0, -text => "$filename");
            $hlst1->itemCreate($counter, 1, -text => "$filesize");
            $hlst1->itemCreate($counter, 2, -text => "$timedate");
            $counter ++;
            populate_end: undef $filename; undef $perms;
                          undef $filesize; undef $timedate;
        }ftp_session_end:
    }
    sub save_file #-----------------------------------------------------
    {
        my $ifile  = $_[0];
        my $sfile  = $mw->getSaveFile(-title => 'Save File',
                                      -initialfile => $ifile,);
        if  (defined ($sfile)) {
            copy('~pftpc.tmp', $sfile);
            unlink '~pftpc.tmp'; return "$sfile";
        }
    }
    sub b11_hist_cmd #--------------------------------------------------
    {
        $f1_hist->focus; $lb_hist->see('end');
        my ($x, $y) = $mw->pointerxy; $x -= 505; $y += 5;
        $tl3->geometry('+'."$x".'+'."$y");
        $tl3->deiconify(); $tl3->raise(); &loadhistory();
    }
    sub hist_sel #------------------------------------------------------
    {
        $mw->update; $mw->after(328);
        my @sels = $lb_hist->curselection();
        my $sel  = $lb_hist->get("$sels[0]");
        if ($sel) {undef $host; $host = $sel;}
        $mw->focus; $mw->update;
    }
    sub loadhistory #---------------------------------------------------
    {
        goto loadhistory_end if ($loadhistory == 1);
        if (-e 'pftpc.hst') {
            open(HIST_IN, '< pftpc.hst')  or &error('lhist1');
            my @hist = <HIST_IN>; close HIST_IN;
            CheckHistSize: my $histsize = $#hist;
            if ($histsize >= 9) {shift @hist; goto CheckHistSize;}
            open(HIST_OUT, '> pftpc.hst') or &error('lhist1');
            foreach (@hist) {
                chomp $_;
                print HIST_OUT "$_\n";
                $lb_hist->insert('end', $_);
            }close HIST_OUT;
        }else{
            open(HIST_OUT, '> pftpc.hst'); close HIST_OUT;
        }$loadhistory = 1; loadhistory_end:
    }
    sub history #-------------------------------------------------------
    {
        $lb_hist->insert('end', $host);
        open (HIST_OUT, '>> pftpc.hst') or &error('hist1');
        print HIST_OUT "$host\n"; close HIST_OUT;
    }
    sub menu1 #---------------------------------------------------------
    {
        if ($ftp) {
          $tl4->focus;
          my ($x, $y) = $mw->pointerxy;
          $tl4->geometry('+'."$x".'+'."$y");
          $tl4->deiconify(); $tl4->raise();
        }
    }
    sub sort1 #---------------------------------------------------------
    {
        no warnings;
        my %HoA; $mw->Busy(-recurse => 1); $sort_cnt++;
        my @paths = $hlst1->infoChildren;
        foreach my $k (@paths) {
            my $col1 = $hlst1->itemCget($k, 0, -text);
            my $col2 = $hlst1->itemCget($k, 1, -text);
            my $col3 = $hlst1->itemCget($k, 2, -text);
            $HoA{$k} = ["$col1", "$col2", "$col3"];
        }
        $hlst1->delete('all');
        if ($sort_cnt % 2) {
            foreach my $k (sort {lc($HoA{$b}[0]) cmp lc($HoA{$a}[0])}
                           keys %HoA) {
                #re-populate
                $hlst1->add($k);
                $hlst1->itemCreate($k, 0, -text => "$HoA{$k}[0]");
                $hlst1->itemCreate($k, 1, -text => "$HoA{$k}[1]");
                $hlst1->itemCreate($k, 2, -text => "$HoA{$k}[2]");
        }}else{
            foreach my $k (sort {lc($HoA{$a}[0]) cmp lc($HoA{$b}[0])}
                           keys %HoA) {
                #re-populate
                $hlst1->add($k);
                $hlst1->itemCreate($k, 0, -text => "$HoA{$k}[0]");
                $hlst1->itemCreate($k, 1, -text => "$HoA{$k}[1]");
                $hlst1->itemCreate($k, 2, -text => "$HoA{$k}[2]");
        }}$mw->Unbusy; $mw->update;
    }
    sub sort2 #---------------------------------------------------------
    {
        no warnings;
        my %HoA; $mw->Busy(-recurse => 1); $sort_cnt++;
        my @paths = $hlst1->infoChildren;
        foreach my $k (@paths) {
            my $col1 = $hlst1->itemCget($k, 0, -text);
            my $col2 = $hlst1->itemCget($k, 1, -text);
            my $col3 = $hlst1->itemCget($k, 2, -text);
            unless ($col2)             {$col2 = 1;}
            if     ($col2 eq '<DIR>')  {$col2 = 1.1;}
            elsif  ($col2 eq '<LINK>') {$col2 = 1.2;}
            $HoA{$k} = ["$col1", "$col2", "$col3"];
        }
        $hlst1->delete('all');
        if ($sort_cnt % 2) {
            foreach my $k (sort {$HoA{$b}[1] <=> $HoA{$a}[1]}
                           keys %HoA) {
                #re-populate
                if    ($HoA{$k}[1] == 1)    {$HoA{$k}[1] = '';}
                elsif ($HoA{$k}[1] == 1.1)  {$HoA{$k}[1] = '<DIR>';}
                elsif ($HoA{$k}[1] == 1.2)  {$HoA{$k}[1] = '<LINK>';}
                $hlst1->add($k);
                $hlst1->itemCreate($k, 0, -text => "$HoA{$k}[0]");
                $hlst1->itemCreate($k, 1, -text => "$HoA{$k}[1]");
                $hlst1->itemCreate($k, 2, -text => "$HoA{$k}[2]");
        }}else{
            foreach my $k (sort {$HoA{$a}[1] <=> $HoA{$b}[1]}
                           keys %HoA) {
                #re-populate
                if    ($HoA{$k}[1] == 1)   {$HoA{$k}[1] = '';}
                elsif ($HoA{$k}[1] == 1.1) {$HoA{$k}[1] = '<DIR>';}
                elsif ($HoA{$k}[1] == 1.2) {$HoA{$k}[1] = '<LINK>';}
                $hlst1->add($k);
                $hlst1->itemCreate($k, 0, -text => "$HoA{$k}[0]");
                $hlst1->itemCreate($k, 1, -text => "$HoA{$k}[1]");
                $hlst1->itemCreate($k, 2, -text => "$HoA{$k}[2]");
        }}$mw->Unbusy; $mw->update;
    }
    sub sort3 #---------------------------------------------------------
    {
        no warnings;
        my %HoA; $mw->Busy(-recurse => 1); $sort_cnt++;
        my @paths = $hlst1->infoChildren;
        foreach my $k (@paths) {
            my $col1 = $hlst1->itemCget($k, 0, -text);
            my $col2 = $hlst1->itemCget($k, 1, -text);
            my $col3 = $hlst1->itemCget($k, 2, -text);
            $col3    = str2time($col3) if ($col3);
            $HoA{$k} = ["$col1", "$col2", "$col3"];
        }
        $hlst1->delete('all');
        if ($sort_cnt % 2) {
            foreach my $k (sort {$HoA{$b}[2] <=> $HoA{$a}[2]}
                           keys %HoA) {
                #re-populate
                if ($HoA{$k}[2])
                   {chomp ($HoA{$k}[2] = ctime ($HoA{$k}[2]));}
                $hlst1->add($k);
                $hlst1->itemCreate($k, 0, -text => "$HoA{$k}[0]");
                $hlst1->itemCreate($k, 1, -text => "$HoA{$k}[1]");
                $hlst1->itemCreate($k, 2, -text => "$HoA{$k}[2]");
        }}else{
            foreach my $k (sort {$HoA{$a}[2] <=> $HoA{$b}[2]}
                           keys %HoA) {
                #re-populate
                if ($HoA{$k}[2])
                   {chomp ($HoA{$k}[2] = ctime ($HoA{$k}[2]));}
                $hlst1->add($k);
                $hlst1->itemCreate($k, 0, -text => "$HoA{$k}[0]");
                $hlst1->itemCreate($k, 1, -text => "$HoA{$k}[1]");
                $hlst1->itemCreate($k, 2, -text => "$HoA{$k}[2]");
        }}$mw->Unbusy; $mw->update;
    }
    sub BindMouseWheel #------------------------------------------------
    {
        my($w) = @_;
        if ($^O eq 'MSWin32') {
            $w->bind('<MouseWheel>'=>[sub{
            $_[0]->yview('scroll', -($_[1]/120)*3,'units')} ,Ev('D')]);
            $w->bind('<ButtonPress-2>' => sub {$w->focus});
        }else{
            $w->bind('<4>' => sub {$_[0]->yview('scroll', -3, 'units')
                                   unless $Tk::strictMotif;});
            $w->bind('<5>' => sub {$_[0]->yview('scroll', +3, 'units')
                                   unless $Tk::strictMotif;});
        }
    }
    sub error #---------------------------------------------------------
    {
        my $err = shift @_; print "\a";
        if ($err == 1) {
            my $ec = "Cannot connect to $host: $@";
            $hlst1->delete('all'); $hlst1->add('err');
            $hlst1->itemCreate('err', 0, -text => "$ec");
            $hlst1->itemCreate('err', 1, -text => '');
            $hlst1->itemCreate('err', 2, -text => '');
        }if ($err == 2) {
            my $ec = 'Cannot login ' . $ftp->message;
            $hlst1->delete('all'); $hlst1->add('err');
            $hlst1->itemCreate('err', 0, -text => "$ec");
            $hlst1->itemCreate('err', 1, -text => '');
            $hlst1->itemCreate('err', 2, -text => '');
        }if ($err == 3) {
            my $ec = 'Cannot change directory ' . $ftp->message;
            $hlst1->delete('all'); $hlst1->add('err');
            $hlst1->itemCreate('err', 0, -text => "$ec");
            $hlst1->itemCreate('err', 1, -text => '');
            $hlst1->itemCreate('err', 2, -text => '');
            $mw->update; sleep 3;
        }if ($err == 4) {
            my $ec = "Cannot upload file $@ " . $ftp->message;
            $hlst1->delete('all'); $hlst1->add('err');
            $hlst1->itemCreate('err', 0, -text => "$ec");
            $hlst1->itemCreate('err', 1, -text => '');
            $hlst1->itemCreate('err', 2, -text => '');
            $mw->update; sleep 3;
        }if ($err == 5) {
            my $ec = 'Cannot create new directory ' . $ftp->message;
            $hlst1->delete('all'); $hlst1->add('err');
            $hlst1->itemCreate('err', 0, -text => "$ec");
            $hlst1->itemCreate('err', 1, -text => '');
            $hlst1->itemCreate('err', 2, -text => '');
            $mw->update; sleep 3;
        }if ($err == 6) {
            my $ec = 'Cannot rename file or directory ' . $ftp->message;
            $hlst1->delete('all'); $hlst1->add('err');
            $hlst1->itemCreate('err', 0, -text => "$ec");
            $hlst1->itemCreate('err', 1, -text => '');
            $hlst1->itemCreate('err', 2, -text => '');
            $mw->update; sleep 3;
        }if ($err == 7) {
            my $ec = 'Cannot delete ' . $ftp->message;
            $hlst1->delete('all'); $hlst1->add('err');
            $hlst1->itemCreate('err', 0, -text => "$ec");
            $hlst1->itemCreate('err', 1, -text => '');
            $hlst1->itemCreate('err', 2, -text => '');
            $mw->update; sleep 3;
        }if ($err eq 'put1') {
            my $ec = "Unable to determine the current working directory. $@";
            $hlst1->delete('all'); $hlst1->add('err');
            $hlst1->itemCreate('err', 0, -text => "$ec");
            $hlst1->itemCreate('err', 1, -text => '');
            $hlst1->itemCreate('err', 2, -text => '');
            $mw->update; sleep 3;
        }if ($err eq 'bmark1') {
            my $ec = "Cannot create bookmark file. $!";
            $hlst1->delete('all'); $hlst1->add('err');
            $hlst1->itemCreate('err', 0, -text => "$ec");
            $hlst1->itemCreate('err', 1, -text => '');
            $hlst1->itemCreate('err', 2, -text => '');
            $mw->update; sleep 3;
        }if ($err eq 'lhist1') {
            my $ec = "Cannot open history $!";
            $hlst1->delete('all'); $hlst1->add('err');
            $hlst1->itemCreate('err', 0, -text => "$ec");
            $hlst1->itemCreate('err', 1, -text => '');
            $hlst1->itemCreate('err', 2, -text => '');
            $mw->update; sleep 3;
        }if ($err eq 'hist1') {
            my $ec = "Cannot append history $!";
            $hlst1->delete('all'); $hlst1->add('err');
            $hlst1->itemCreate('err', 0, -text => "$ec");
            $hlst1->itemCreate('err', 1, -text => '');
            $hlst1->itemCreate('err', 2, -text => '');
            $mw->update; sleep 3;
        }
    }
}

#POD Section#
=head1 NAME

-=PFTPC=- Perl FTP Client

=head1 DESCRIPTION

Navigate and interact with FTP sites.

=head1 README

-=PFTPC=- Perl FTP Client - GUI based FTP site browser.

=head1 PREREQUISITES

Net-FTP
Date-Parse
Tk-ResizeButton
Tk

=head1 COREQUISITES

n/a

=head1 History

v1_0 - Initial release.

v1_5 - Added symlink support.

v2_0 - Added bookmarks, minor gui enhancements.

v2_1 - Added sorting, more gui enhancements.

v2_2 - Redesigned bookmark and history functions.

       Improved callback structure.  Minor gui updates.

       Implemented Date::Parse to normalize the time/date column.

       Improved sorting functions.

       Added right-click menu to navigation screen.

       Added a keep-alive system.

v2_3 - Various bug fixes, gui improvements.

=head1 ToDo

Add drag and drop support?

Add support for the abort () command.

Directory mirroring.

=head Wishlist

Threads...

=head1 Copyright

-=PFTPC=- Perl FTP Client
Copyright © 2004 Jason David McManus

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

=pod OSNAMES

any?

=pod SCRIPT CATEGORIES

Networking
Web

=cut