generate file from a listbox

deadpickle has asked for the wisdom of the Perl Monks concerning the following question:

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]

Comment on generate file from a listbox Download Code

Replies are listed 'Best First'.
Re: Waypoint file generator wont post right points by liverpole (Monsignor) on Apr 22, 2007 at 16:54 UTC
Hi deadpickle, The reason you're getting `1 2` again, instead of `5 6`, can be quickly visualized with the following 2 modifications: First, add Data::Dumper to the top of the program: `use strict; use warnings; use Data::Dumper; # Add this line` [download] And then display what's happening in the subroutine `compile` by adding a `printf` near the 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); print "TFD> sel <$sel>\n"; chomp ($sel); push(@latlong, $sel); } # liverpole -- Add a "Temporary for debug" print statement printf "TFD> latlong => %s\n", Dumper(\@latlong); $go = 1; }` [download] What you'll then see, following your instructions above, is that when you connect the first time (with points "`1 2`" and "`3 4`"), you get the expected: `TFD> latlong => $VAR1 = [ '1 2', '3 4' ];` [download] But the second time you connect, after adding "`5 6`", you get: `TFD> latlong => $VAR1 = [ '1 2', '3 4', '1 2', '3 4', '5 6' ];` [download] So you probably just need to clear the points from the `@latlong`, perhaps at the end of the block in `sub sftp`: `if ( $go == 1 ){ # ... @latlong = ( ); }` [download] Note, however, that you may need to lock the shared data structure `@latlong`, both in the parent thread and the child, wherever it is being changed (unless your flag `$go` is correctly handling any race conditions). Update: Looking at some of your code more in-depth, you may want to put a delay everywhere you have a tight loop, so that it doesn't hog cpu time. For example: `for(;;){ if( $progress == 0){last} # Pause for 1/10th of a second to be a good citizen select(undef, undef, undef, 0.1) }` [download] s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/	[reply] [d/l] [select]

Replies are listed 'Best First'.

Re: Waypoint file generator wont post right points
by liverpole (Monsignor) on Apr 22, 2007 at 16:54 UTC

deadpickle

The reason you're getting 1 2 again, instead of 5 6, can be quickly visualized with the following 2 modifications:

First, add Data::Dumper to the top of the program:

use strict;
use warnings;
use Data::Dumper;        # Add this line
[download]

And then display what's happening in the subroutine compile by adding a printf near the 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);
        print "TFD> sel <$sel>\n";
        chomp ($sel);
        push(@latlong, $sel);
    }
    # liverpole -- Add a "Temporary for debug" print statement
    printf "TFD> latlong => %s\n", Dumper(\@latlong);
    $go = 1;
}
[download]

What you'll then see, following your instructions above, is that when you connect the first time (with points "1 2" and "3 4"), you get the expected:

TFD> latlong => $VAR1 = [
          '1 2',
          '3 4'
        ];
[download]

But the second time you connect, after adding "5 6", you get:

TFD> latlong => $VAR1 = [
          '1 2',
          '3 4',
          '1 2',
          '3 4',
          '5 6'
        ];
[download]

So you probably just need to clear the points from the @latlong, perhaps at the end of the block in sub sftp:

    if ( $go == 1 ){
        # ...
        @latlong = ( );
    }
[download]

Note, however, that you may need to lock the shared data structure @latlong, both in the parent thread and the child, wherever it is being changed (unless your flag $go is correctly handling any race conditions).

Update: Looking at some of your code more in-depth, you may want to put a delay everywhere you have a tight loop, so that it doesn't hog cpu time. For example:

    for(;;){
        if( $progress == 0){last}
        # Pause for 1/10th of a second to be a good citizen
        select(undef, undef, undef, 0.1)
    }
[download]

s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/

[reply]
[d/l]
[select]