Have you ever wanted to use a cross-platform pure-perl ftp client just to say that you do? What if it was primitive,slow,and buggy? Well here's your chance. I'm open to suggestions.
#!/usr/bin/perl -w
#ftp-Tk.pl - a very simple gui ftp browser/ftp client
#version 0.01 - more to come!
#only gets files right now next release will have a local file browser
use Tk;
use Net::FTP;
use strict;
my $top = new MainWindow(-width => 30);
my %boxes;
my $side_frame = $top->Frame( );
for my $box(qw/site username password/) {
$side_frame->Label(-text => $box)->pack();
$boxes{$box} = $side_frame->Entry(-width=>'30')->pack();
}
my $ftp_frame = $top->Frame( );
my $ftp_button = $side_frame->Button( -text => "Connect",
-width => 10,
-command => sub{
&ftp_it(\%boxes,\$top,\$ft
+p_frame)}
)->pack();
$side_frame->pack(-side => 'left');
MainLoop;
sub ftp_it{
my $site = $boxes{"site"}->get();
my $user = $boxes{"username"}->get();
my $pass = $boxes{"password"}->get();
my $ftp = Net::FTP->new($site, Debug => 0);
$ftp->login($user,$pass);
my $pwd = $ftp->pwd();
for ($ftp_frame->packSlaves()){
$_->destroy() if Tk::Exists($_);
}
my $f_label = $ftp_frame->Label(-textvariable =>\$pwd)->pack();
my $T_frame = $ftp_frame->Frame( );
my $f_listbox = $T_frame->Listbox(-width => 20, -height => 20);
my $f_scroll = $T_frame->Scrollbar(-command => [$f_listbox => 'yvi
+ew']);
$f_listbox->configure(-yscrollcommand => [$f_scroll => 'set']);
$f_listbox->pack(-side => 'left',-fill => 'y', -expand => 1);
$f_scroll->pack(-side => 'left',-fill => 'y', -expand => 1);
my @files = dirlist(\$ftp);
$f_listbox->insert(0, @files);
$f_listbox->bind('<Double-1>' => [\&repopulate_lbox, \$ftp, \$pwd]
+);
$T_frame->pack;
$ftp_frame->pack(-side => 'left');
}
sub display_dir{
#convert information from the $ftp->dir command into file/director
+y list
my $dirlist = $_[0];
$dirlist =~ s/[<>]//g;
my ($permission,$filename) = (split(/\s+/,$dirlist))[0,8];
#show directories as: <directory>
if ($permission =~ /^[d]/i) {
return '<'.$filename.'>';
}else{
return $filename;
}
}
sub repopulate_lbox{
#fill up the listbox with files from current directory
my $listbox = $_[0];
my $ftp_REF = $_[1];
my $pwd_REF = $_[2];
my $e = $listbox->XEvent;
my($x, $y) = ($e->x, $e->y);
my $file = $listbox->get("\@$x,$y");
if ($file =~ /[<>]/) {
$file =~ s/[<>]//g;
${$ftp_REF}->cwd("$file");
${$pwd_REF} = ${$ftp_REF}->pwd();
$listbox->delete(0,'end');
my @files = dirlist($ftp_REF);
$listbox->insert(0, @files);
}else{
#going for binary download for all files.
#eventually i will filter out obvious ascii files.
${$ftp_REF}->binary();
${$ftp_REF}->get("$file");
${$ftp_REF}->ascii();
}
}
sub dirlist{
my $ftp_REF = $_[0];
my @files = ${$ftp_REF}->dir();
@files = map{ &display_dir($_)}@files;
push @files, "<..>"; #make sure we can go up a directory
return sort {$a cmp $b} @files;
}