Changeset 17795 for gsdl/trunk

Timestamp:

2008-11-07T21:40:31+13:00 (15 years ago)

Author:

ak19

Message:

Bugfix: On Linux, perl launches a subshell (the child process of the perl script) and THAT launches wget - so need to find the pid of wget in order to allow the user of GLI terminate it. This is because we absolutely have to use 2>&1 (otherwise wget blocks until it has finished). Also have tested that the cmdline version of downloadfrom.pl still terminates wget properly when fed Ctrl-C (SIGINT).

File:

• gsdl/trunk/perllib/downloaders/WgetDownload.pm (modified) (3 diffs)

gsdl/trunk/perllib/downloaders/WgetDownload.pm

@@ -199 +199 @@
 }
 
+sub get_childpid {
+    my ($self, $pid) = @_;
+    my $os = $^O;
+    # for windows, we do nothing special
+    if ($os =~ m/mswin/i) {
+    return $pid;
+    }
+    
+    # else $os is macos or linux
+    # This means the wget child process may have been spawned from a subshell
+    # (the real child) that was launched by this perl script. However, we want
+    # the pid of the wget process, since that is what we want to terminate.
+
+    sleep(2); # give it some time to start up, else we'd have finished searching beforehand
+
+    # Look through any processes spawned immediately/soon after the subshell.
+    # Look for any pid greater than the subshell's, but within a certain limit (10)
+    my $child = $pid;
+    for(my $i = 1; $i <= 10; $i++) {
+    $child = $child+$i;
+    if(kill(0, $child)) { # this process exists
+        return $child;
+    }
+    }
+    
+    return $pid; # could not find any process within limit, so return the original process id?
+}
+
 sub useWget
 {
@@ -241 +269 @@
     # print STDERR "Command is: $command\n";
     $childpid = open2($chld_out, $chld_in, $command) || die "wget request failed: $!\n";
+    
+    # for linux the wget process starts off as achild of a subshell launched as the child of 
+    # this perl script. We want the pid of the wget process, not that of the subshell. 
+    $childpid = $self->get_childpid($childpid);
 
     my $loop = 1;
@@ -371 +403 @@
     $childpid = open2($chld_out, $chld_in, $command) || die "wget request failed: $!\n";
 
+    # for linux the wget process starts off as achild of a subshell launched as the child of 
+    # this perl script. We want the pid of the wget process, not that of the subshell. 
+    $childpid = $self->get_childpid($childpid);
+
     my $full_text = "";
     my $error_text = "";