#!/usr/bin/perl use strict; use warnings; use Tk; use Net::SFTP::Foreign; use threads; use threads::shared; my $user:shared = 'jlahowet'; my $server:shared = 'mistral.unl.edu'; my $lcl:shared = '/home/deadpickle/Desktop/Virtual Cockpit/uavposition +'; my $rmt:shared = '/home/jlahowet/UAV/COORDS/uavposition'; my $go:shared = 0; my $die:shared = 0; my $progress:shared = 0; #start thread before any Tk code my $thr = threads->new(\&sftp); #now setup Tk my $mw = MainWindow->new(); $mw->protocol('WM_DELETE_WINDOW' => sub { &clean_exit }); $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, -backgrou +nd => 'blue')->pack(-side => 'top', -fill => 'x'); my $svrlbl = $svr->Label(-text => 'Server', -background => 'blue', -fo +reground => 'white')->pack(-side => 'left'); my $svreny = $svr->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 $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 $btn = $mw->Button(-text => 'Connect', -background => 'gray', -command => \&sub1) ->pack(-side => 'bottom', -padx => 3, -pady => 3, -anchor => ' +e'); # to monitor file count, needs a timer to update # from thread my $val = 0; my $label = $mw->Label( -width => 50, -textvariable => \$val )->pack(-side => 'bottom', -padx => 3, + -pady => 3, -anchor => 'w'); my $timer = $mw->repeat(10,sub{ $val = $progress; }); MainLoop; sub sub1 { if($btn->cget(-text) eq 'Connect'){ $go = 1; $btn->configure(-text=> 'Stop'); #$monitor = 0; } else{ $go = 0; $btn->configure(-text=> 'Connect'); #$monitor = 1; } print "go = $go\n"; } sub sftp{ $|++; #now go into a waiting loop, where you wait for #$go to be 1 #when $go = 1, the sftp will keep sending the file #the only way to break out is to set $die=1 while(1){ if($die == 1){ goto END }; # the go loop if ( $go == 1 ){ # setup your sftp connection my $host = $server; my $usrname = $user; my $port = 22; my $seconds = 20; my %args = (user=>$usrname, port=>$port, timeout=>$seconds); my $local = $lcl; my $remote = $rmt; # commented out to skip actual sftp use # my $sftp = Net::SFTP::Foreign->new($host, %args); my $sftp; print "sftp connected $host $user etc\n"; for(;;){ # $sftp->put("$local", "$remote"); print "fake file being sent\n"; $progress++; sleep 2; if($go == 0){last} if($die == 1){ goto END }; } undef $sftp; #close current sftp $go = 0; #turn off self before returning $progress = 0; }else { sleep 1 } # sleep if $go == 0 # end of go loop } #end of while loop END: print "sftp stopped thread ending\n"; } sub clean_exit{ $timer->cancel; my @running_threads = threads->list; if (scalar(@running_threads) < 1){print "\nFinished\n";exit} else{ $die = 1; $thr->join; exit; } }
In reply to Re^3: Looping File transfer using SFTP in TK
by zentara
in thread Looping File transfer using SFTP in TK
by deadpickle
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |