Changeset 17529
- Timestamp:
- 2008-10-13T21:55:51+13:00 (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
gsdl/trunk/perllib/downloaders/WgetDownload.pm
r17354 r17529 34 34 use BaseDownload; 35 35 use strict; 36 use Cwd; 36 37 use IPC::Open2; 37 use Cwd; 38 use IO::Select; 39 use IO::Socket; 40 38 41 39 42 sub BEGIN { … … 75 78 76 79 77 # Declaring variables related to the wget child process so that the termination78 # signal handler for SIGTERM can close the streams and tidy up before ending79 # the child process.80 # Declaring file global variables related to the wget child process so that 81 # the termination signal handler for SIGTERM can close the streams and tidy 82 # up before ending the child process. 80 83 my $childpid; 81 84 my($chld_out, $chld_in); 82 83 # Handler called when this process is killed or abruptly ends due to receiving 84 # one of the terminating signals that this handler is registered to deal with. 85 my ($serverSocket, $read_set); 86 87 # When this script is called from the command line, this handler will be called 88 # if this process is killed or abruptly ends due to receiving one of the 89 # terminating signals that this handler is registered to deal with. 85 90 sub abrupt_end_handler { 86 91 my $termination_signal = shift (@_); 87 { 88 if(defined $childpid) { 89 close($chld_out); 90 close($chld_in); 92 if(defined $childpid) { 93 close($chld_out); 94 close($chld_in); 91 95 92 # Send TERM signal to child process to terminate it. Sending the INT signal didn't work 93 # See http://perldoc.perl.org/perlipc.html#Signals 94 # Warning on using kill at http://perldoc.perl.org/perlfork.html 95 kill("TERM", $childpid); 96 } 97 } 96 #print STDOUT "Received termination signal: $termination_signal\n"; 97 98 # Send TERM signal to child process to terminate it. Sending the INT signal doesn't work 99 # See http://perldoc.perl.org/perlipc.html#Signals 100 # Warning on using kill at http://perldoc.perl.org/perlfork.html 101 kill("TERM", $childpid); 102 103 # If the SIGTERM sent on Linux calls this handler, we want to make 104 # sure any socket connection is closed. 105 # Otherwise sockets are only used when this script is run from GLI 106 # in which case the handlers don't really get called. 107 if(defined $serverSocket) { 108 $read_set->remove($serverSocket) if defined $read_set; 109 close($serverSocket); 110 } 111 } 112 98 113 exit(0); 99 114 } … … 162 177 ($self->{'proxy_on'}) || &error("checkProxySetup","The proxy is not on? How could that be happening?"); 163 178 # Setup .wgetrc by using $self->{'proxy_host'} and $self->{'proxy_port'} 164 # Test if the connection is succe ful. If the connection wasn't succeful then ask user to supply username and password.179 # Test if the connection is successful. If the connection wasn't successful then ask user to supply username and password. 165 180 166 181 } … … 168 183 sub useWget 169 184 { 185 #local $| = 1; # autoflush stdout buffer 186 #print STDOUT "*** Start of subroutine useWget in $0\n"; 187 170 188 my ($self, $cmdWget,$blnShow, $working_dir) = @_; 171 189 … … 179 197 $changed_dir = 1; 180 198 } 199 200 # When we are running this script through GLI, the SIGTERM signal handler 201 # won't get called on Windows when wget is to be prematurely terminated. 202 # Instead, when wget has to be terminated in the middle of execution, GLI will 203 # connect to a serverSocket here to communicate when it's time to stop wget. 204 my $port; 205 if(defined $self->{'gli'} && $self->{'gli'}) { 206 207 $port = <STDIN>; # gets a port on localhost that's not yet in use 208 chomp($port); 209 210 $serverSocket = IO::Socket::INET->new( Proto => 'tcp', 211 LocalPort => $port, 212 Listen => 1, 213 Reuse => 1); 214 215 die "can't setup server" unless $serverSocket; 216 #print STDOUT "[Serversocket $0 accepting clients at port $port]\n"; 217 218 $read_set = new IO::Select(); # create handle set for reading 219 $read_set->add($serverSocket); # add the main socket to the set 220 } 221 181 222 my $wget_file_path = &util::filename_cat($ENV{'GSDLHOME'}, "bin", $ENV{'GSDLOS'}, "wget"); 182 #$command = "\"$wget_file_path\" $cmdWget |"; #open(*WIN,$command) || die "wget request failed: $!\n"; 183 #open(*WIN,$command) || die "wget request failed: $!\n"; 184 185 186 $command = "\"$wget_file_path\" $cmdWget"; 223 $command = "\"$wget_file_path\" $cmdWget 2>&1"; 224 # print STDERR "Command is: $command\n"; 187 225 $childpid = open2($chld_out, $chld_in, $command) || die "wget request failed: $!\n"; 188 226 189 while (defined($strLine=<$chld_out>)) # we're reading in from child process' stdout 190 { 191 if($blnShow) 227 my $loop = 1; 228 while($loop) 229 { 230 if (defined(my $strLine=<$chld_out>)) { # we're reading in from child process' stdout 231 if($blnShow) { 232 print STDERR "$strLine\n"; 233 } 234 $strReadIn .= $strLine; 235 } 236 else { # wget finished, terminate naturally 237 print STDERR "\nPerl: open2 command, input stream closed. Wget terminated naturally.\n"; 238 close($chld_in); 239 close($chld_out); 240 waitpid $childpid, 0; 241 $loop = 0; 242 243 $childpid = undef; 244 if(defined $port) { 245 $read_set->remove($serverSocket); 246 close($serverSocket); 247 } 248 } 249 250 # if we run this script from the command-line (as opposed to from GLI), 251 # then we're not working with sockets and can therefore can skip the next bits 252 next unless(defined $port); 253 254 # http://www.perlfect.com/articles/select.shtml 255 # "multiplex between several filehandles within a single thread of control, 256 # thus creating the effect of parallelism in the handling of I/O." 257 my @rh_set = $read_set->can_read(0.002); # every 2 ms check if there's a client socket connecting 258 259 # take all readable handles in turn 260 foreach my $rh (@rh_set) { 261 if($rh == $serverSocket) { 262 my $client = $rh->accept(); 263 #$client->autoflush(1); # autoflush output buffer - don't put this back in: output split irregularly over lines 264 print $client "Talked to ServerSocket (port $port). Connection accepted\n"; 265 266 # Read from the client (getting rid of trailing newline) 267 # Has the client sent the <<STOP>> signal? 268 my $signal = <$client>; 269 chomp($signal); 270 if($signal eq "<<STOP>>") { 271 print $client "Perl received STOP signal (on port $port): stopping wget\n"; 272 273 $loop = 0; 274 close($chld_in); 275 close($chld_out); 276 kill("TERM", $childpid); 277 278 $childpid = undef; 279 280 # Stop monitoring the read_handle 281 # close the serverSocket (the Java end will close the client socket that Java opened) 282 $read_set->remove($rh); #$read_set->remove($serverSocket); 283 close($rh); #close($serverSocket); 284 #print $client "Perl is about to exit\n"; 285 last; 286 } 287 } 288 } 289 } 290 291 if ($changed_dir) { 292 chdir $current_dir; 293 } 294 295 return $strReadIn; 296 } 297 298 299 sub useWgetMonitored 300 { 301 my ($self, $cmdWget,$blnShow, $working_dir) = @_; 302 303 304 my $current_dir = cwd(); 305 my $changed_dir = 0; 306 if (defined $working_dir && -e $working_dir) { 307 chdir "$working_dir"; 308 $changed_dir = 1; 309 } 310 my $wget_file_path = &util::filename_cat($ENV{'GSDLHOME'}, "bin", $ENV{'GSDLOS'}, "wget"); 311 #my $command = "\"$wget_file_path\" $cmdWget 2>&1 |"; #open(*WIN,$command) || die "wget request failed: $!\n"; 312 ### print STDERR "**** wget cmd = $command\n"; 313 #open(*WIN,$command) || die "wget request failed: $!\n"; 314 315 my $command = "\"$wget_file_path\" $cmdWget"; 316 $childpid = open2($chld_out, $chld_in, $command) || die "wget request failed: $!\n"; 317 318 my $full_text = ""; 319 my $error_text = ""; 320 my @follow_list = (); 321 my $line; 322 323 while (defined($line=<$chld_out>)) # we're reading in from child process' stdout 324 { 325 if((defined $blnShow) && $blnShow) 192 326 { 193 print STDERR "$strReadIn\n"; 194 } 195 196 $strReadIn .= $strLine; 197 } 198 327 print STDERR "$line"; 328 } 329 330 if ($line =~ m/^Location:\s*(.*?)\s*\[following\]\s*$/i) { 331 my $follow_url = $1; 332 push(@follow_list,$follow_url); 333 } 334 335 if ($line =~ m/ERROR\s+\d+/) { 336 $error_text .= $line; 337 } 338 339 $full_text .= $line; 340 } 341 199 342 close($chld_in); 200 343 close($chld_out); 201 344 202 345 # Program terminates only when the following line is included 203 346 # http://perldoc.perl.org/IPC/Open2.html explains why this is necessary … … 207 350 waitpid $childpid, 0; 208 351 209 if ($changed_dir) {210 chdir $current_dir;211 }212 213 return $strReadIn;214 }215 216 217 sub useWgetMonitored218 {219 my ($self, $cmdWget,$blnShow, $working_dir) = @_;220 221 222 my $current_dir = cwd();223 my $changed_dir = 0;224 if (defined $working_dir && -e $working_dir) {225 chdir "$working_dir";226 $changed_dir = 1;227 }228 my $wget_file_path = &util::filename_cat($ENV{'GSDLHOME'}, "bin", $ENV{'GSDLOS'}, "wget");229 #my $command = "\"$wget_file_path\" $cmdWget 2>&1 |"; #open(*WIN,$command) || die "wget request failed: $!\n";230 ### print STDERR "**** wget cmd = $command\n";231 #open(*WIN,$command) || die "wget request failed: $!\n";232 233 my $command = "\"$wget_file_path\" $cmdWget";234 $childpid = open2($chld_out, $chld_in, $command) || die "wget request failed: $!\n";235 236 my $full_text = "";237 my $error_text = "";238 my @follow_list = ();239 my $line;240 241 while (defined($line=<$chld_out>)) # we're reading in from child process' stdout242 {243 if((defined $blnShow) && $blnShow)244 {245 print STDERR "$line";246 }247 248 if ($line =~ m/^Location:\s*(.*?)\s*\[following\]\s*$/i) {249 my $follow_url = $1;250 push(@follow_list,$follow_url);251 }252 253 if ($line =~ m/ERROR\s+\d+/) {254 $error_text .= $line;255 }256 257 $full_text .= $line;258 }259 260 close($chld_in);261 close($chld_out);262 263 # Program terminates only when the following line is included264 # http://perldoc.perl.org/IPC/Open2.html explains why this is necessary265 # it prevents the child from turning into a "zombie process".266 # While the wget process terminates without it, this perl script does not:267 # the DOS prompt is not returned without it.268 waitpid $childpid, 0;269 270 352 my $command_status = $?; 271 353 if ($command_status != 0) {
Note:
See TracChangeset
for help on using the changeset viewer.