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

This is a segment of a much larger code line. This code segment controls the GPS device. The user clicks the "Start" button to start the device and clicks "Stop" to stop the device. The problem I am having with is when the GPS device is not responding and the user tries to close the program. When the user clicks "Start" then "Stop" and tries to close the program, the program hangs and stops responding. I can't seem to see the problem in the code and some new eyes may help. 
#!/usr/bin/perl -w
use strict;
use Gtk2 '-init';
use Glib qw/TRUE FALSE/;
use GPS::NMEA;
use threads;
use threads::shared;

my $notebook;
my $gps_entry;
my $gps_start:shared = 0;
my $die:shared = 0;
my($ns,$lat,$ew,$lon):shared;
my $gps_current;

######################################################################
+#############################
#start threads
my $thread_gps = threads->new( \&gps);

######################################################################
+#############################
#timeouts
my $timer_gps = Glib::Timeout->add(100, \&gps_position);

######################################################################
+#############################

#create window
my $window = Gtk2::Window->new('toplevel');
$window->signal_connect(delete_event=> sub {$die = 1; $thread_gps->joi
+n; Gtk2->main_quit});
$window->set_title("GPS Test");
  
#create notebook
$notebook = Gtk2::Notebook->new;
$notebook->set_tab_pos('top');

my $gps_table = Gtk2::Table->new(3, 2, FALSE);

#GPS Group (for all users)
my $gps_instruction = Gtk2::Label->new();
$gps_instruction->set_markup( '<span size="small">Enter the location o
+f the GPS device (i.e. "COM4" or "/dev/lao")</span>');
my $gps_label = Gtk2::Label->new( 'Location');
$gps_current = Gtk2::Label->new;
$gps_entry = Gtk2::Entry->new();
$gps_entry->set_text("COM4");
my $start_stop = Gtk2::Button->new("Start");
$gps_table->attach_defaults($gps_instruction, 0, 2, 0, 1);
$gps_table->attach_defaults($gps_label, 0, 1, 1, 2);
$gps_table->attach_defaults($gps_entry, 1, 2, 1, 2);
$gps_table->attach_defaults($start_stop, 0, 1, 2, 3);
$gps_table->attach_defaults($gps_current, 1, 2, 2, 3);
#start and stop GPS device
$start_stop->signal_connect('clicked' => sub {if ( $start_stop->get_la
+bel eq "Start") {$start_stop->set_label("Stop"); $gps_start = 1;  pri
+nt "$gps_start\n";} else {$start_stop->set_label("Start"); $gps_start
+ = 0; print "$gps_start\n";}});

$notebook->append_page($gps_table, "GPS");

#add widgets
$window->add($notebook);
 
$window->show_all;
  
Gtk2->main;

######################################################################
+##############################
#GPS Thread
sub gps{
  while (1) {
    #If program ends stop the loop
    goto END if $die == 1;
    
    if ($gps_start == 1) {
      
      #start the GPS Device
      my $gps_device = GPS::NMEA->new(Port => 'COM4', Baud => 4800);
      
      print "$gps_device\n";
      
      #start the loop  
      for (;;) {
        #stops the warnings in the GPS device module
        local $^W = 0;
        
        ($ns,$lat,$ew,$lon) = $gps_device->get_position;
        print "$gps_device\n";
        goto END if $die == 1;
        last if $gps_start == 0;
        sleep 3;
      }
      print "$gps_device\n";
      #undef $gps_device;
    } else {sleep 4}
  }
  END:
}

######################################################################
+##############################

#GPS position timeout
sub gps_position{
  #set the current GPS position
  $gps_current->set_label("$ns $lat, $ew $lon") if $gps_start == 1 and
+ defined($ns);
  $gps_current->set_label("N/A") if $gps_start == 0;
  return 1;
}

[download]

Replies are listed 'Best First'.
Re: GPS Widget
by BrowserUk (Patriarch) on Jan 12, 2008 at 07:44 UTC

    Does the device ever time out when you call ($ns,$lat,$ew,$lon) = $gps_device->get_position;?

    Because if it does not, then the thread will never notice that $die has been set, which means when you call $thread_gps->join;, it will wait forever.

    Since there is no return value from the thread, there is no point in waiting for it. So, just detach the thread and if the GPS device hangs, when you end the main thread, the gps thread will end too. (With a warning, which is okay since there was an error condition.)

    Ie:

    1. Change my $thread_gps = threads->new( \&gps);

      to threads->new( \&gps)->detach;

    2. and 
      $window->signal_connect(
    delete_event=> sub {
        $die = 1; 
        $thread_gps->join; 
        Gtk2->main_quit
    }
);

      [download]

      To 

      $window->signal_connect(
    delete_event=> sub {
    $die = 1; 
    sleep 4; ## Give the thread a chance to end properly 
    Gtk2->main_quit
    }
);

      [download]

    That should ensure timely program termination even if the GPS device hangs and never times out.

    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]
[select]
Re: GPS Widget
by zentara (Cardinal) on Jan 12, 2008 at 14:14 UTC
[reply]
      I emailed the author of the GPS-Perl module and he suggested to use the alarm function. so I tried it out with the code below but, it still hung on the get_position so maybe perlmonks has a suggestion. 
      sub gps {
    my $gps_device;
    while (1) {
        goto END if $die == 1;
        if ($gps_start == 1) {
            $gps_device = GPS::NMEA->new(Port => $gps, Baud => 4800) o
+r die;
            my $timeout = 5;
            while (1){
                #stops the warnings in the GPS device module
                local $^W = 0;
                print "before\n";
                eval {
                    local $SIG{ALRM} = sub {die "GPS Device has timed 
+out\n"};
                    alarm $timeout;
                    ($ns,$lat,$ew,$lon) = $gps_device->get_position;
                    #warn $@ if $@;
                    alarm 0;
                };
                die if $@ && $@ ne "GPS Device has timed out\n";
                if ($@){
                    print "WARNING\n";
                }
                else{
                    print "nope\n";
                }
                
                #($ns,$lat,$ew,$lon) = $gps_device->get_position;
                print "after\n";
                print "$die\n";
                goto END if $die == 1;
                last if $gps_start == 0;
                sleep 3;
            }
            undef $gps_device;
        } else {sleep 4}
    }
    END:
}

      [download]
[reply]
[d/l]

        You could try setting the environment var set PERL_SIGNALS=unsafe prior to running your script and see if that will allow alarm to interupt the underlying IO call. I think this has to be set prior to perl being run, but I wouldn't swear to it.

        See Safe signals for (a little) explanation of what this does.

        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]
[select]
        From my recollection, alarm won't work correctly in a thread on linux, the parent thread gets all the alarms. So you might be able to collect the SIG{ALRM} in the parent thread, and then send the signal to the thread. Or you may be able to find another workaround, like a separate timer thread, which times the gps sub.

        Another workaround I've seen, is to eval a fork-&-exec in the thread, and you can get the alarm to work in the child pid. If I recall correctly...... :-)

        Personnally I would use a separate timer thread, and use shared variables to somehow communicate and handle the timeout.

        I'm not really a human, but I play one on earth. Cogito ergo sum a bum
[reply]

Back to Seekers of Perl Wisdom