This program is a Tk script that allows the user to manipulate coordinates taht are entered into the list box. The problem is that the script keeps entering the same numbers even after new numbers are added. Heres an example: Add 1 2 then 3 4 and hit connect. the file waytemp generates the time then 1 2 <return> 3 4. if we then add 5 6 to the listbox the waytemp file generates; time then the preivious entries but instead of 5 6 it print 1 2. I have been trying to find the error using prints but I cant see where it is, thought maybe it needs a new set of eyes looking at it. Anty help would be greatly appreciated. 
#!/usr/bin/perl -w
#
#
#
#
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 $remote:shared = '/home/jlahowet/UAV/WP';
my $lat = 0.0;
my $long = 0.0;
my $local:shared = 'C:\Documents and Settings\deadpickle\Desktop\GRRUV
+I';
my $go:shared = 0;
my $die:shared = 0;
my $progress:shared = 0;
my $all:shared = 0;
my @latlong;
share(@latlong);
my $thr = threads->new(\&sftp);
#Widget options simplified
my %basic1 = (-relief => 'groove', -borderwidth => 3, -bg => 'blue');
my %basic2 = (-borderwidth => 3, -bg => 'blue');
my %basic3 = (-bg => 'blue', -fg => 'white');
my %basic4 = (-side => 'left', -pady => 3);

#now setup Tk
my $mw = MainWindow->new();
$mw->protocol('WM_DELETE_WINDOW' => sub { &clean_exit }); 
$mw->configure(-title => 'Temp Waypoint Generator', -bg =>'blue');
$mw->geometry('+300+300');
#User entry
my $logon = $mw->Frame(%basic1)->pack(-side => 'top', -fill => 'x');
my $usrlbl = $logon->Label(-text => 'Username', %basic3)->pack(-side =
+> 'left');
my $usreny = $logon->Entry(-width=> 10, -textvariable => \$user)->pack
+(%basic4);
#Server entry
my $svrlbl = $logon->Label(-text => 'Server', %basic3)->pack(-side => 
+'left');
my $svreny = $logon->Entry(-width=> 15, -textvariable => \$server)->pa
+ck(%basic4);
#File location
my $loc1 = $mw->Frame(%basic1)->pack(-side => 'top', -fill => 'x');
my $lcllbl = $loc1->Label(-text => 'Local', %basic3)->pack(-side => 'l
+eft', -anchor => 'e');
my $lcleny = $loc1->Entry(-width=> 25, -textvariable => \$local)->pack
+(%basic4 , -anchor => 'e');
my $rmtlbl = $loc1->Label(-text => 'Remote', %basic3)->pack(-side => '
+left', -anchor => 'e');
my $rmteny = $loc1->Entry(-width=> 25, -textvariable => \$remote)->pac
+k(%basic4, -anchor => 'e');
#waypoint geometry
my $loc2 = $mw->Frame(%basic1)->pack(-side => 'top', -fill => 'x');
my $loc3 = $loc2->Frame(%basic2)->pack(-side => 'left', -fill => 'y');
my $loc4 = $loc2->Frame(%basic2)->pack(-side => 'right', -fill => 'y')
+;
my $loc5 = $loc3->Frame(%basic2)->pack(-side => 'left', -fill => 'y');
my $loc6 = $loc3->Frame(%basic2)->pack(-side => 'right', -fill => 'y')
+;
#lat/long entry
my $latlbl = $loc5->Label(-text => 'Lat', %basic3)->pack(-side => 'lef
+t', -anchor => 'w');
my $lateny = $loc5->Entry(-width=> 6, -textvariable => \$lat)->pack(%b
+asic4 , -anchor=> 'w');
my $longlbl = $loc5->Label(-text => 'Long', %basic3)->pack(-side => 'l
+eft', -anchor => 'w');
my $longeny = $loc5->Entry(-width=> 6, -textvariable => \$long)->pack(
+%basic4 , -anchor=> 'w');
#waypoint manipulation buttons
my $btn1 = $loc6->Button(-text => 'add', -bg => 'gray', -command => \&
+add)->pack(-side => 'top', -padx => 3, -pady => 3, -anchor => 's');
my $btn2 = $loc6->Button(-text => 'remove', -bg => 'gray', -command =>
+ \&remove)->pack(-side => 'top', -padx => 3, -pady => 3, -anchor => '
+s');
my $btn3 = $loc6->Button(-text => 'move up', -bg => 'gray', -command =
+> \&moveup)->pack(-side => 'top', -pady => 3, -padx => 3, -anchor => 
+'s');
my $btn4 = $loc6->Button(-text => 'move down', -bg => 'gray', -command
+ => \&movedown)->pack(%basic4 , -padx => 3, -anchor => 's');
#Waypoint Listbox
my $waybox = $loc4->Scrolled('Listbox', -scrollbars=> 'osoe', -width=>
+20, -height=>5, -relief=>'groove',  -selectmode=>'single')->pack(-pad
+y=> 3, -side=> 'right', -anchor=>'ne');
#connect Button
my $btn5 = $mw->Button(-text => 'Connect', -bg => 'gray', -command => 
+\&go)->pack(-side => 'bottom', -padx => 3, -pady => 3, -anchor => 'e'
+);
#Listbox
my $box = $mw->Scrolled('Listbox', -scrollbars=> 'osoe', -width=>50, -
+height=>8, -relief=>'groove',  -selectmode=>'single')->pack(%basic4 ,
+ -anchor=>'w');
my $val = 0;
my $timer = $mw->repeat(1000,\&msg);
#shortcuts
$mw->bind('<Control-Key-c>', sub{&go});
$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;

sub msg{
    $val = $progress;
    if($val == 1){
        $box->insert('end', "Connected: $user @ $server");
        $box->see('end');
        $progress = 0;
    }
    if($val == 2){
        $box->insert('end', "Creating File: waytemp...");
        $box->see('end');
        $progress = 0;
    }
    if( $val == 3){
        $box->insert('end', "File Created: $local");
        $box->see('end');
        $progress = 0;
    }
    if( $val == 4){
        $box->insert('end', "Uploading: waytemp to $remote");
        $box->see('end');
        $progress = 0;
    }
    if( $val == 5){
        $box->insert('end', "Transfer Complete");
        $box->see('end');
        $progress = 0;
    }
}


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);
}

sub go{
    if($btn5->cget(-text) eq 'Connect'){
        compile();
        $box->insert('end', "Connecting... Asking for Password...");
        $box->see('end');
    }
}

sub compile{
    $all = $waybox->index('end');
    print "$all\n";
    for(my $num = 1;$num <= $all;$num++){
        my $new = $num-1;
        my $sel = $waybox->get($new);
        chomp ($sel);
        push(@latlong, $sel);
    }
    $go = 1;
}

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 ){
            #Create waypoint file
            $progress = 2;
            if( $progress == 2){
                for(;;){
                    if( $progress == 0){last}
                }
            }
            open TEMP, '>', "$local\\waytemp" or die "cannot open 'way
+temp' $!";
            my @time = gmtime();
            my $day = $time[3];
            my $hour = $time[2];
            my $min = $time[1];
            my $sec = $time[0];
            if ($sec <= 9){
                my $sec = "0$sec";
            }
            if ($day <= 9){
                my $sec = "0$day";
            }
            if ($min <= 9){
                my $min = "0$min";
            }
            if ($hour <= 9){
                my $hour = "0$hour";
            }
            print TEMP "$day$hour$min$sec\n";
            #get lat and long and put in file
            print "$all\n";
            for( my $num = 1; $num <= $all; $num++){
                open TEMP, '>>', "$local\\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";
                    }
                }
            }
            $all = 0;
            close TEMP;
            $progress = 3;
            if( $progress == 3){
                for(;;){
                    if( $progress == 0){last}
                }
            }
            # setup your sftp connection 
            my $seconds = 120;
#            my %args = (host=>$server, user=>$user, timeout=>$seconds
+);
#            my $sftp = Net::SFTP::Foreign->new(%args);
            $progress = 1;
            if( $progress == 1){
                for(;;){
                    if( $progress == 0){last}
                }
            }
#            $sftp->put("$local\\waytemp", "$remote/waytemp");
            $progress = 4;
            if( $progress == 4){
                for(;;){
                    if( $progress == 0){last}
                }
            }
            if($go == 0){last}
            if($die == 1){ goto END }; 
#            undef $sftp; #close current sftp  
            $go = 0; #turn off self before returning
            $progress = 5;
            if( $progress == 5){
                for(;;){
                    if( $progress == 0){last}
                }
            }
            $go = 0;
        }else { sleep 1 } # sleep if $go == 0
    }
    END:
}

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;
    }
}

[download]

In reply to generate file from a listbox by deadpickle

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.