Build a Primary Menu to interface with 2

[ljsmith91]

I need to create a panel or menu interface for ftp for our systems. Any suggestions on whether there is a mod that could help with this ? The primary menu would have multiple options for the user to input or take the deafults on. This is a draft of a possible primary menu:

-------------- Primary Menu --------------------

FTP Command [Put/ Get]: ___

FTP Transfer [ASC/ Bin]: ___

Remote Systems: __ System A __System B __ SystemC
__ System D __ All Above Systems

Remote ID : __________

Remote PW : __________

File Name : ________________________________________

Remote Location: ___________________________________


----------------End Primary Menu ------------------------

This menu may have additional options. I need a means of pulling all of this information and was hoping I could do it on 1 menu rather than prompting the user for each option. Is there an easy means for doing this?

Thanks for any help.

 

[k1ng0fn3rd]

i don't think perl is the thing for you... try other languages such as javascript, etc.

--------------------------
The best answer to your question will definitely be RTFM.

 

[dmazzini]

You could use Perl Tk.

have a look at it

dmazzini
GSM System and Telecomm Consultant

 

[KevinADC]

why are you not using an existing FTP program?

 

[ljsmith91]

Thanks...I am attempting to do this with Perl Tk... just having a problem with how to place my widgets. A bit tricky to say the least.

 

[Kirsle]

For placing widgets, check out Tk::grid

http://search.cpan.org/~ni-s/Tk-804.027/pod/grid.pod

 

[dmazzini]

Hi ljsmith91

Something ripped from the net, a Perl Tk program. It works ok, may be more enhancements could be added. There are many programs for FTP created using perl/Tk. As well there are free programs that you could use.

Here we go

use Tk;
use Tk::DropSite;
use Net::FTP;
use File::Basename;
use strict;
use warnings;

require Tk::HList;
require Tk::Dialog;

my ($ftp, $start_dir, %files);
my ($login, $server, $username, $password, $anon, $anonymous);

my %connections =('rork' => 'rork', 'rork.nl'=> 'rork.nl');
		

my $top=MainWindow->new(-title=>'FTP');
my $menubar=$top->Frame()->grid(-row=> 1, -column=> 1, -columnspan=> 2, -sticky=> 'w');
my $mb_file=$menubar->Menubutton(-text=> 'File', -tearoff=> 0)->pack(-side=>'left');
   $mb_file->command(-label=> 'Log in', -command=> \&build_login);
   $mb_file->separator();
   $mb_file->command(-label=> 'Exit', -command=> \&leave);

my $toolbar=$top->Frame()->grid(-row=>2, -column=>1, -sticky=> 'w', -columnspan=> 2);
my $upload=$toolbar->Button(-text=> 'Upload', -command=> \&upload, -state=> 'disabled')->pack(-side=> 'left');
my $download=$toolbar->Button(-text=> 'Download', -command=> \&download, -state=> 'disabled')->pack(-side=> 'left');
my $mkdir=$toolbar->Button(-text=> 'MkDir', -command=> \&mkdir, -state=> 'disabled')->pack(-side=>'left');
my $rename=$toolbar->Button(-text=> 'Rename', -command=> \&rename, -state=> 'disabled')->pack(-side=>'left');
my $delete=$toolbar->Button(-text=> 'Delete', -command=> \&delete, -state=> 'disabled')->pack(-side=> 'left');
my $disconnect=$toolbar->Button(-text=> 'Disconnect', -command=> \&disconnect, -state=> 'disabled')->pack(-side=> 'left');

my $show_dir=$top->Label(-relief=> 'sunken', -anchor=> 'w')->grid(-row=>3,-column=>1,-columnspan=>2,-sticky=>'ew');

my $list=$top->Scrolled('HList', -scrollbars=> 'oe', -columns=> 3, -selectmode=> 'multiple', -separator=> '|', -header=>1, -background=>'white', -highlightthickness=> 0, -command=> \&dd)->grid(-row=>4, -column=>1, -columnspan=>2, -sticky=> 'nesw');
   $list->header('create', 0, -text=> 'File');
   $list->header('create', 1, -text=> 'Last modified');
   $list->header('create', 2, -text=> 'Size');
my $drop = $list->DropSite(-droptypes,'Win32', -dropcommand, [\&dropCmd, $list]);

my $status=$top->Label(-relief=> 'sunken', -anchor=> 'w', -text=> 'Ready')->grid(-row=> 5, -column=> 1, -columnsp=> 2, -sticky=> 'ew');


build_login();


$top->gridColumnconfigure(1, -weight=> 1);
$top->gridRowconfigure(4, -weight=> 1);

$top->protocol('WM_DELETE_WINDOW', \&leave);

$top->bind('Tk::HList', '<Down>', \&move_down);
$top->bind('Tk::HList', '<Delete>', \&delete);
$top->bind('Tk::HList', '<Return>', \&dd);
$top->bind('Tk::HList', '<F5>', \&fill_list);

MainLoop;

sub alert {
	my $alert=$top->messageBox(-type=>'OK', -title=>'Message', -message=> $_[0]);
}
	
sub mkdir {
	my $win=$top->Toplevel(-title=> 'MkDir');
	$win->Label(-text=> 'Dir name: ')->grid(-row=> 1, -column=> 1);
	my $Ewin = $win->Entry()->grid(-row=> 1, -column=> 2);
	$win->Button(-text=> 'OK', -command=> sub {$ftp->mkdir($Ewin->get); $win->destroy(); fill_list()})->grid(-row=> 2, -column=> 1);
	$win->Button(-text=> 'Cancel', -command=> sub {$win->destroy()})->grid(-row=> 2, -column=> 2);
}

sub rename {
	my @files = $list->selectionGet();
	my $win=$top->Toplevel(-title=> 'Rename');
	$win->Label(-text=> 'New name: ')->grid(-row=> 1, -column=> 1);
	my $Ewin = $win->Entry()->grid(-row=> 1, -column=> 2);
	$win->Button(-text=> 'OK', -command=> sub {$ftp->rename($files[0], $Ewin->get); $win->destroy(); fill_list()})->grid(-row=> 2, -column=> 1);
	$win->Button(-text=> 'Cancel', -command=> sub {$win->destroy()})->grid(-row=> 2, -column=> 2);
}

sub build_login {
	   $login=$top->Toplevel(-title=> 'Login');
	my $Ls=$login->Label(-text=>'Host:')->grid(-row=> 2, -column=> 1, -sticky=> 'w');
	   $server=$login->Entry()->grid(-row=>2, -column=> 2);
	my $Lu=$login->Label(-text=>'Username:')->grid(-row=> 3, -column=> 1, -sticky=> 'w');
           $username=$login->Entry()->grid(-row=>3, -column=> 2);
	my $Lp=$login->Label(-text=>'Password:')->grid(-row=> 4, -column=> 1, -sticky=> 'w');
	   $password=$login->Entry(-show=> '*')->grid(-row=>4, -column=> 2);
	   $anon=$login->Checkbutton(-text=> 'Anonymous Login', -variable=> \$anonymous)->grid(-row=> 5, -column=> 1, -columnspan=> 2, -sticky=> 'w');
	my $connect=$login->Button(-text=> 'Connect', -command=> \&connect)->grid(-row=>6, -column=> 1, -columnspan=> 2, -sticky=> 'ew');
	my $leave=$login->Button(-text=> 'Quit', -command=> \&leave)->grid(-row=> 7, -column=> 1, -columnspan=> 2, -sticky=> 'ew');
	   $server->focus;
	   $login->raise();
	   $login->bind('Tk::Label', '<Return>', \&connect);
}


sub connect {
	my ($user, $pass);
	my $host = $server->get;
	if ($anonymous) {
		$user= "anonymous";
		$pass = "";
	}
	else {
		$user = $username->get;
		$pass = $password->get;
	}
	$host =~ s/^ftp:\/\///i;

	$ftp=Net::FTP->new($host) or die "Can't connect to $host";
	if($ftp->login($user, $pass)) {
		$start_dir = $ftp->pwd();
		$upload->configure(-state=> 'normal');
		$download->configure(-state=> 'normal');
		$rename->configure(-state=> 'normal');
		$mkdir->configure(-state=> 'normal');
		$delete->configure(-state=> 'normal');
		$disconnect->configure(-state=> 'normal');
		fill_list();
		$login->destroy;
	}
	else {
		alert("Can't login to $host\nCheck your username and password");
	}
}

sub fill_list {
	$status->configure(-text=> 'Listing');
	undef %files;
	$list->delete('all');
	if ($ftp->pwd() ne $start_dir) {
		$list->add('..', -text=> '..');
		$files{'..'} = 'dir';
	}
	$list->add('dirs');
	$list->hide('entry', 'dirs');
	foreach my $file (sort {uc($a) cmp uc($b)} $ftp->ls()) {
		my $size = $ftp->size($file);
		if ($size) {
			$files{$file} = $size; 
			if ($size > 1000000) { $size = int($size/10000)/100 . 'MB'}
			elsif ($size > 1000) { $size = int($size/100)/10 . 'kB'}
			else {$size .= 'B'};				
			$list->add($file, -text=> lc($file));
			$list->itemCreate($file, 2, -text=> $size);
			my $lm = $ftp->mdtm($file);
			if ($lm) {
				$lm = localtime($lm);
				$list->itemCreate($file, 1, -text=> $lm);
			}
		}
		else {
			$list->add($file, -text=> uc($file), -before=> 'dirs');
			$files{$file} = 'dir';
		}
	}
	$show_dir->configure(-text=> $ftp->pwd);
	$status->configure(-text=> 'Ready');
}

sub upload {
	my ($answer, @filenames);
	if (@_) {
		@filenames = @_;
	}
	else {
		@filenames=$top->getOpenFile();
	}
	foreach my $filename(@filenames) {
		if ($filename) {
			my ($name, $dir, $ext) = fileparse($filename);
			if (exists($files{$name})) {
				my $dialog=$top->Dialog(-title=> 'Upload', -text=> 'Do you wish to overwrite ' . $name, -buttons=> ['Yes', 'No', 'Cancel']);
				   $answer=$dialog->Show();
			}
			if ((!exists($files{$name})) || ($answer eq 'Yes')) {
				$top->configure(-cursor=> 'watch');
				$status->configure(-text=> 'Uploading ' . $name);
				if ($filename =~ m/\.(gif|jpg|jpeg)/i) {
					$ftp->binary();
					$ftp->put($filename) or die "$@";
					$ftp->ascii();
				}
				else {
					$ftp->put($filename) or die "$@";
				}
				fill_list();
				$top->configure(-cursor=> 'arrow');
				$status->configure(-text=> 'Done');
			}
		}
	}
}

sub download {
	my @selected = $list->selectionGet;
	foreach my $get(@selected) {
		my $filename=$top->getSaveFile(-initialfile=> $get);
			if ($filename =~ m/\.(gif|jpg|jpeg)/i) {
				$ftp->binary();
				$ftp->get($get, $filename) or die "$@";
				$ftp->ascii();
			}
			else {
				$ftp->get($get, $filename) or die "$@";
			}
	}
}

sub delete {
	my @files = $list->selectionGet();
	foreach my $file(@files) {
		my $dialog=$top->Dialog(-title=> 'Delete', -text=> "Are you sure you want to delete " . $file , -buttons=> ['Yes', 'No', 'Cancel']);
		my $answer=$dialog->Show();
		if ($answer eq 'Yes') {
			if ($files {$file} eq 'dir') {
				$ftp->rmdir($file);
			}
			else {
				$ftp->delete($file);
			}
			fill_list();
		}
		elsif ($answer eq 'Cancel') {
			return;
		}
	}
}

sub dd {
	my @dirname = $list->selectionGet();
	if($files{$dirname[0]} eq 'dir') {
		$ftp->cwd("$dirname[0]");
		fill_list();
	}
}

sub move_up {
	my @files = $list->selectionGet();
	$list->selectionClear(0,'end');
	$list->selectionSet($list->info('prev', $files[0]));
}

sub move_down {
	my @files = $list->selectionGet();
	$list->selectionClear(0,'end');
	$list->selectionSet($list->info('next', $files[0]));
}

sub disconnect {
	$list->delete('all');
	undef %files;
	$ftp->quit;
	$upload->configure(-state=> 'disabled');
	$download->configure(-state=> 'disabled');
	$rename->configure(-state=> 'disabled');
	$mkdir->configure(-state=> 'disabled');
	$delete->configure(-state=> 'disabled');
	$disconnect->configure(-state=> 'disabled');
	build_login();
}

sub dropCmd {
    my ($widget, $selection) = @_;
    my $filename = $widget->SelectionGet(-selection => $selection, 'STRING');
    if (defined $filename) {
    	upload($filename);
    }
}

sub leave {
	if ($ftp) { $ftp->quit };
	$top->destroy;
}

dmazzini
GSM System and Telecomm Consultant

 

[ljsmith91]

dmazzi,

This looks good. Thanks so much. Where on the net did you get this ? I searched high and low and couldn't find. Anyway, I am taking advantage of this help. Much thanks.

 

[1DMF]

dmazzini, I copied the code into a script, uploaded it and tried to run it and the browser just hangs? should this code work on a webserver as is?



"In complete darkness we are all the same, only our knowledge and wisdom separates us, don't let your eyes deceive you.