Re: sftp on windows

#!/usr/bin/perl
####################################################
# This program is a GUI for the SFTP file transfer
# and waypoint generator. 
# The program is to be run on the GRRUVI computer.
#
####################################################
use strict;
use warnings;
use Tk;
use Net::SFTP::Foreign;
use threads;
use threads::shared;
use Tk::Dialog;
use Tk::LabFrame;

my $user:shared = 'uas';
my $server:shared = 'updraft.unl.edu';
my $wayrmt:shared = '/home/uas/Scripts/WP';
my $waylcl:shared = 'C:\Documents and Settings\deadpickle\Desktop\GRRUVI';
#my $waylcl:shared = '/home/deadpickle/Desktop/GRRUVI';
my $lat = 0.0;
my $long = 0.0;
my $val = 0;
my $progress: shared = 0;
my $go:shared = 0;
my $die:shared = 0;
my $all:shared = 0;
my $curtime:shared = 0;
my @latlong;
share(@latlong);
my $gone:shared = 0;
my $thr1 = threads->new(\&create);
my $thr2 = threads->new(\&sftp);
#now setup Tk
#Mainwindow
my $mw = MainWindow->new();
$mw->protocol('WM_DELETE_WINDOW' => sub { &default_save }); 
$mw->configure(-title => 'GWC: GRRUVI Waypoint Creator');
$mw->geometry('+400+300');
#Menubar
my $mbar = $mw -> Menu();
$mw -> configure(-menu => $mbar);
my $file = $mbar -> cascade(-label=>"File", -underline=>0, -tearoff => 0);
my $ctrl = $mbar -> cascade(-label=>"Control", -underline=>0, -tearoff => 0);
$file -> command(-label =>"Save Config", -underline => 0,	-command => [\&save, "Save"], -accelerator => 'Ctrl-S');
$file -> command(-label =>"Load Config", -underline => 0, -command => [\&load, "Load"], -accelerator => 'Ctrl-L');
$file -> separator;
$file -> command(-label =>"Quit", -underline => 0, -command => [\&default_save, "Quit"], -accelerator => 'Ctrl-Q');
$ctrl -> command(-label =>"Add Point", -underline => 0, -command => [\&add, "Add Point"], -accelerator => 'Ctrl-A');
$ctrl -> command(-label =>"Remove Point", -underline => 0, -command => [\&remove, "Remove Point"], -accelerator => 'Ctrl-R');
$ctrl -> separator;
$ctrl -> command(-label =>"Move Point Up", -underline => 0, -command => [\&moveup, "Move Point Up"], -accelerator => 'Ctrl-U');
$ctrl -> command(-label =>"Move Point Down", -underline => 0, -command => [\&movedown, "Move Point Down"], -accelerator => 'Ctrl-D');
$ctrl -> separator;
$ctrl -> command(-label =>"Compile", -underline => 0, -command => [\&compile, "Compile"], -accelerator => 'Ctrl-C');
$mbar -> command(-label =>"About", -underline => 0, -command => [\&about, "About"]);
#Login
my $login = $mw->LabFrame(-label => "Login", -labelside => 'acrosstop', -width => 110, -height => 50, -fg => 'blue')->pack(-side => 'top', -fill => 'x', -pady => 3);
my $usrlbl = $login->Label(-text => 'Username')->pack(-side => 'left');
my $usreny = $login->Entry(-width=> 10, -textvariable => \$user)->pack(-side => 'left', -pady => 3);
my $svrlbl = $login->Label(-text => 'Server')->pack(-side => 'left');
my $svreny = $login->Entry(-width=> 15, -textvariable => \$server)->pack(-side => 'left', -pady => 3);
#Waypoint Geometry
my $wayfile = $mw->LabFrame(-label => "Waypoint Generator", -labelside => 'acrosstop', -width => 110, -height => 50, -fg => 'blue')->pack(-side => 'top', -fill => 'x', -pady => 3);
my $way1 = $wayfile->Frame(-relief => 'groove')->pack(-side => 'top', -fill => 'x');
my $way2 = $wayfile->Frame(-relief => 'groove')->pack(-side => 'top', -fill => 'x');
my $way3 = $wayfile->Frame(-relief => 'groove')->pack(-side => 'top', -fill => 'x');
my $way4 = $wayfile->Frame(-relief => 'groove')->pack(-side => 'top', -fill => 'x');
my $way5 = $way4->Frame(-relief => 'groove')->pack(-side => 'top', -fill => 'x');
my $way6 = $way4->Frame(-relief => 'groove')->pack(-side => 'top', -fill => 'x');
my $way7 = $wayfile->Frame(-relief => 'groove')->pack(-side => 'top', -fill => 'x');
#Waypoint Data
my $latlbl = $way3->Label(-text => 'Lat')->pack(-side => 'left', -anchor => 'w');
my $lateny = $way3->Entry(-width=> 6, -textvariable => \$lat)->pack(-side => 'left', -pady => 3 , -anchor=> 'w');
my $longlbl = $way3->Label(-text => 'Long')->pack(-side => 'left', -anchor => 'w');
my $longeny = $way3->Entry(-width=> 6, -textvariable => \$long)->pack(-side => 'left', -pady => 3 , -anchor=> 'w');
my $waylcllbl = $way1->Label(-text => 'Local')->pack(-side => 'left', -anchor => 'e');
my $waylcleny = $way1->Entry(-width=> 37, -textvariable => \$waylcl)->pack(-side => 'left', -pady => 3, -anchor => 'e');
my $wayrmtlbl = $way2->Label(-text => 'Remote')->pack(-side => 'left', -anchor => 'e');
my $wayrmteny = $way2->Entry(-width=> 35, -textvariable => \$wayrmt)->pack(-side => 'left', -pady => 3, -anchor => 'e');
#Waypoint Buttons
my $add = $way5->Button(-text => 'add', -bg => 'gray', -command => \&add)->pack(-side => 'left', -padx => 3, -pady => 3, -anchor => 's');
my $remove = $way5->Button(-text => 'remove', -bg => 'gray', -command => \&remove)->pack(-side => 'left', -padx => 3, -pady => 3, -anchor => 's');
my $up = $way6->Button(-text => 'move up', -bg => 'gray', -command => \&moveup)->pack(-side => 'left', -pady => 3, -padx => 3, -anchor => 's');
my $down = $way6->Button(-text => 'move down', -bg => 'gray', -command => \&movedown)->pack(-side => 'left', -pady => 3 , -padx => 3, -anchor => 's');
#waypoint listbox
my $waybox = $way7->Scrolled('Listbox', -scrollbars=> 'osoe', -width=>20, -bg=>'white', -height=>3, -relief=>'groove',  -selectmode=>'single')->pack(-pady=> 3, -side=> 'left', -anchor=>'ne');
#Compile Button
my $compbtn = $way7->Button(-text => 'Compile', -command => \&compile)->pack(-side => 'bottom', -padx => 3, -pady => 3, -anchor => 'e');
#SFTP Geometry
my $sftpfile = $mw->LabFrame(-label => "Status", -labelside => 'acrosstop', -width => 110, -height => 50, -fg => 'blue')->pack(-side => 'top', -fill => 'x', -pady => 3);
my $sftp1 = $sftpfile->Frame(-relief => 'groove')->pack(-side => 'top', -fill => 'x');
my $sftp2 = $sftpfile->Frame(-relief => 'groove')->pack(-side => 'top', -fill => 'x');
my $sftp3 = $sftpfile->Frame(-relief => 'groove')->pack(-side => 'top', -fill => 'x');
#SFTP status
my $box = $sftp3->Listbox(-bg=>'white', -width => 42, -height => 1, -relief => 'groove')->pack(-side => "left", -fill=>'x');
#timer to display messages
my $load = 1;
my $timer = $mw->repeat(100,\&msg);
my $timer2 = $mw->repeat(100, \&default_load);
#my $timer2 = $mw->repeat(100,\&time);
#shortcuts
$mw->bind('<Control-Key-s>', sub{&save});
$mw->bind('<Control-Key-l>', sub{&load});
$mw->bind('<Control-Key-q>', sub{&default_save});
$mw->bind('<Control-Key-c>', sub{&compile});
$mw->bind('<Control-Key-a>', sub{&add});
$mw->bind('<Control-Key-r>', sub{&remove});
$mw->bind('<Control-Key-u>', sub{&moveup});
$mw->bind('<Control-Key-d>', sub{&movedown});
MainLoop;
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#Grab current time
sub time{
	my @time = gmtime();
	my $mon = $time[4];
	my $day = $time[3];
	my $hour = $time[2];
	my $min = $time[1];
	my $sec = $time[0];
	$mon = $mon + 1;
	$sec = $sec + 5;
	if ($sec > 59) {
		$sec = $sec - 60;
	}
	if ($sec < 10){
		$sec = "0$sec";
	}
	if ($min < 10){
		$min = "0$min";
	}
	if ($hour < 10){
		$hour = "0$hour";
	}
	if ($day < 10){
		$day = "0$day";
	}
	$curtime = "$mon$day$hour$min$sec";
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#save default message box
sub default_save {
         my $msg = $mw->messageBox( -title=> 'Save File?', -message=> "Save to default.gr?", -icon=> 'question', -type=> 'YesNoCancel', -default=> 'Yes');
        #my $ans = $msg->Show;
        if ($msg eq 'Yes') {
                open DEFAULT, '>', "default.gr" or die "Cannot open 'default.gr' $!";
                print DEFAULT "$user\n$server\n$wayrmt\n$waylcl";
                close DEFAULT;
                clean_exit();
        }
        if ($msg eq 'No') {
                clean_exit();
        }
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#default.gr load on startup
sub default_load {
        if ($load == 1) {
                $load = 0;
                my $file = "default.gr";
                if (defined $file) {
                        open LOAD , '<', "$file" or die "Cannot open 'default.gr $!";
                        my @default = <LOAD>;
                        chomp @default;
                        $user = $default[0];
                        $server = $default[1];
                        $wayrmt = $default[2];
                        $waylcl = $default[3];
                        close LOAD;
                }
        }
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub about{
	my $whatisthis = $mw->Dialog(-text  => "GRRUVI Waypoint Creator\nVersion 2.5\nAuthor: Jamie Lahowetz\n\nControl Panel used on GRRUVI machine. This program loads the file default.gr on startup.", -default_button => 'Close', -buttons => ['Close']);
	my $choice = $whatisthis->Show;
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#Save Config
sub save{
	my $types = [['GWC Config Files', ['.gr']], ['Text Files', ['.txt', '.text']], ['All Files', ['*']]];
	my $sfile = $mw->getSaveFile(-defaultextension=> '.gr', -title=> 'Save GWC Config File', -filetypes => $types);
        if ($sfile ne ""){
                open OUT, '>', "$sfile" or die "Cannot Save $sfile, $!";
		print OUT "$user\n";
		print OUT "$server\n";
		print OUT "$waylcl\n";
		print OUT "$wayrmt\n";
		close OUT;
	}
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#Load Config
sub load{
	my $types = [['GWC Config Files', ['.gr']], ['Text Files', ['.txt', '.text']], ['All Files', [ '*']]];
	my $lfile = $mw->getOpenFile(-title=>'Open GWC Config File', -filetypes =>$types);
	if(defined $lfile){
		open IN, '<', "$lfile" or die "Cannot Open $lfile, $!";;
		my @tfile = <IN>;
		chomp @tfile;
		$user = $tfile[0];
		$server = $tfile[1];
		$waylcl = $tfile[2];
		$wayrmt = $tfile[3];
		close IN;
	}
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#Waypoint button routines
sub add{
	$waybox->insert('end',"$lat $long");
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub remove{
	my $sel = $waybox->curselection();
	$waybox->delete($sel);
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub moveup{
	my $sel = $waybox->curselection();
	my $point = $waybox->get($sel);
	$waybox->delete($sel);
	my $num = $waybox->index($sel);
	my $new = $num-1;
	$waybox->insert($new,$point);
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub movedown{
	my $sel = $waybox->curselection();
	my $point = $waybox->get($sel);
	$waybox->delete($sel);
	my $num = $waybox->index($sel);
	my $new = $num+1;
	$waybox->insert($new,$point);
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#Messages
sub msg{
	$val = $progress;
	if($val == 1){
		$box->insert('end', "Connected: $user @ $server");
		$box->see('end');
		$progress = 0;
	}
        if( $val == 2){
		$box->insert('end', "Connecting: Asking for Password...");
		$box->see('end');
		$progress = 0;
	}
        if( $val == 3){
		$box->insert('end', "Transfer Done");
		$box->see('end');
		$progress = 0;
	}
        if( $val == 4){
		$box->insert('end', "Creating File: waytemp...");
		$box->see('end');
		$progress = 0;
	}
        if( $val == 5){
		$box->insert('end', "File Created");
		$box->see('end');
		$progress = 0;
	}
        if( $val == 6){
		$box->insert('end', "Uploading: waytemp");
		$box->see('end');
		$progress = 0;
	}
	if($val == 7){
		$box->insert('end', "Disconnected from Server!! $!");
		$box->see('end');
		$progress = 0;
        }
        if($val == 8){
		$box->insert('end', "Could Not Connect to Server!! $!");
		$box->see('end');
		$progress = 0;
	}
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#Run create waypoint
sub compile {
                $all = $waybox->index('end');
                for(my $num = 1;$num <= $all;$num++){
                        my $new = $num-1;
                        my $sel = $waybox->get($new);
                        chomp ($sel);
                        push(@latlong, $sel);
                        $go = 1;
                }
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#Create Waypoint file
sub create{
       	$|++; 
	while(1){
		if($die == 1){ goto END }; 
		if ( $gone == 1 ){
                print "$wayrmt\n";
                        $progress = 4;
                        if($progress == 4){
                                for(;;){ if( $progress == 0){last} }
                        }
                        open TEMP, '>', "waytemp" or die "cannot open 'waytemp' $!";
			#open TEMP, '>', "$waylcl/waytemp" or die "cannot open 'waytemp' $!";
                        #print TEMP "$curtime\n";
                        #get lat and long and put in file
                        for( my $num = 1; $num <= $all; $num++){
                                open TEMP, '>>', "waytemp" or die "cannot open 'waytemp' $!";
				#open TEMP, '>>', "$waylcl/waytemp" or die "cannot open 'waytemp' $!";
                                my $new = $num-1;
                                if( defined $latlong[$new]){
                                        my @points = split(" ", $latlong[$new]);
                                        my $lat = $points[0];
                                        my $long = $points[1];
                                        if( defined $lat){
                                                print TEMP "$lat $long\n";
                                        }
                                }
                        }
                        @latlong = ();
                        close TEMP;
                        $progress = 5;
                        if( $progress == 5){
                                for(;;){
                                        if( $progress == 0){last}
                                }
                        }
			if($die == 1){ goto DNE };
                        $gone = 0;
                }else{ sleep 1}
        }
        END:
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#SFTP Transfer
sub sftp{
	$|++;
	while(1){
		if($die == 1){ goto END }; 
		if ( $go == 1 ){
                        $progress = 2;
			if( $progress == 2){
				for(;;){
					if( $progress == 0){last}
				}
			}
			my $seconds = 120;
			my %args = (host=>$server, user=>$user, timeout=>$seconds);
			my $sftp = Net::SFTP::Foreign->new(%args);
                        if ($sftp->error){
				$progress =8;
				if( $progress == 8){
					for(;;){if($progress == 0){last}}
					goto line;
				}
			}
			$progress = 1;
			if( $progress == 1){
				for(;;){
					if( $progress == 0){last}
				}
			}
                        $gone = 1;
                        if( $gone == 1){
                                for(;;){
                                        if( $gone == 0){last}
                                }
                        } 
			$sftp->put("$waylcl\\waytemp", "$wayrmt/waytemp");
                        if ($sftp->error){
					$progress =7;
					if( $progress == 7){
						for(;;){if($progress == 0){last}}
						goto line;
					}
				}
			$progress = 6;
                        if( $progress == 6){
                                for(;;){
                                        if( $progress == 0){last}
                                }
                        } 
			$progress = 3;
                        if( $progress == 3){
				for(;;){
					if( $progress == 0){last}
				}
			}
                        line:
			#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:
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#Clean Exit
sub clean_exit{
        $timer->cancel;
	$timer2->cancel;
	my @running_threads = threads->list;
	if (scalar(@running_threads) < 1){exit}
	else{
		$die = 1;
		$thr1->join;
                $thr2->join;
		exit;
	}
}