deadpickle has asked for the wisdom of the Perl Monks concerning the following question:
#!/usr/bin/perl -w use strict; use warnings; use Tk; use Net::SFTP::Foreign; use threads; use threads::shared; my $user = 'jlahowet'; my $server = 'mistral.unl.edu'; my $lcl = '/home/deadpickle/Desktop/Virtual Cockpit/'; my $rmt = '/home/jlahowet/UAV/COORDS/'; my$uav = 'uavposition'; my $mw = MainWindow->new(); my $go = 0; my $monitor: shared; $mw->configure(-title => 'VIRTUAL COCKPIT:SFTP', -background => 'blue' +); $mw->geometry('+400+300'); #User entry my $usr = $mw->Frame(-relief => 'groove', -borderwidth => 3, -backgrou +nd => 'blue')->pack(-side => 'top', -fill => 'x'); my $usrlbl = $usr->Label(-text => 'Username', -background => 'blue', - +foreground => 'white')->pack(-side => 'left'); my $usreny = $usr->Entry(-width=> 10, -textvariable => \$user)->pack(- +side => 'left', -pady => 3); #Server entry #my $svr = $mw->Frame(-relief => 'groove', -borderwidth => 3, -backgro +und => 'blue')->pack(-side => 'top', -fill => 'x'); my $svrlbl = $usr->Label(-text => 'Server', -background => 'blue', -fo +reground => 'white')->pack(-side => 'left'); my $svreny = $usr->Entry(-width=> 15, -textvariable => \$server)->pack +(-side => 'left', -pady => 3); #File locations my $loc = $mw->Frame(-relief => 'groove', -borderwidth => 3, -backgrou +nd => 'blue')->pack(-side => 'top', -fill => 'x'); my $uavlbl = $loc->Label(-text => 'UAV: ', -background => 'blue', -fo +reground => 'white')->pack(-side => 'left'); my $filelbl = $loc->Label(-text => 'File', -background => 'blue', -for +eground => 'white')->pack(-side => 'left'); my $fileeny = $loc->Entry(-width=> 8, -textvariable => \$uav)->pack(-s +ide => 'left', -pady => 3); my $lcllbl = $loc->Label(-text => 'Local', -background => 'blue', -for +eground => 'white')->pack(-side => 'left'); my $lcleny = $loc->Entry(-width=> 25, -textvariable => \$lcl)->pack(-s +ide => 'left', -pady => 3); my $rmtlbl = $loc->Label(-text => 'Remote', -background => 'blue', -fo +reground => 'white')->pack(-side => 'left'); my $rmteny = $loc->Entry(-width=> 25, -textvariable => \$rmt)->pack(-s +ide => 'left', -pady => 3); #Connect button my @setup = ($user, $server, $lcl, $rmt, $uav); my $btn = $mw->Button(-text => 'Connect', -background => 'gray', -comm +and => \&sub1)->pack(-side => 'bottom', -padx => 3, -pady => 3, -anch +or => 'e'); MainLoop; sub sub1 { if($btn->cget(-text) eq 'Connect'){ $go = 1; $btn->configure(-text=> 'Stop'); my $thr = threads->new(\&sftp, @setup); $monitor = 0; } else{ $go = 0; $btn->configure(-text=> 'Connect'); $monitor = 1; } print "$go\n"; } sub sftp { my $host = $_[1]; my $usrname = $_[0]; my $port = 22; my $seconds = 20; my %args = (user=>$usrname, port=>$port, timeout=>$seconds); my $local = $_[2]; my $remote = $_[3]; my $uavfile = $_[4]; my $sftp = Net::SFTP::Foreign->new($host, %args); print $monitor; eval { $sftp->put("$local$uavfile", "$remote$uavfile", callback => sub { die "aborted" if $monitor; # $monitor +has to be set from the other thread }) }; if ($@ and $@ =~ /^aborted/) { undef $sftp; print "Stopped"; $monitor = 0; } sleep (2); exit(1); }
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: Looping File transfer using SFTP in TK
by zentara (Cardinal) on Apr 10, 2007 at 18:21 UTC | |
by deadpickle (Pilgrim) on Apr 10, 2007 at 20:12 UTC | |
by zentara (Cardinal) on Apr 11, 2007 at 11:59 UTC | |
by deadpickle (Pilgrim) on Apr 11, 2007 at 17:29 UTC | |
by zentara (Cardinal) on Apr 12, 2007 at 12:35 UTC | |
by zentara (Cardinal) on Apr 11, 2007 at 11:24 UTC | |
|
Re: Looping File transfer using SFTP in TK
by dana (Monk) on Apr 10, 2007 at 17:43 UTC | |
|
Re: Looping File transfer using SFTP in TK
by MonkE (Hermit) on Apr 10, 2007 at 17:35 UTC |