Changeset 17537 for gsdl/trunk/perllib
- Timestamp:
- 2008-10-15T12:41:28+13:00 (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
gsdl/trunk/perllib/downloaders/WgetDownload.pm
r17531 r17537 304 304 sub useWgetMonitored 305 305 { 306 #local $| = 1; # autoflush stdout buffer 307 #print STDOUT "*** Start of subroutine useWgetMonitored in $0\n"; 308 306 309 my ($self, $cmdWget,$blnShow, $working_dir) = @_; 307 310 … … 313 316 $changed_dir = 1; 314 317 } 318 319 # When we are running this script through GLI, the SIGTERM signal handler 320 # won't get called on Windows when wget is to be prematurely terminated. 321 # Instead, when wget has to be terminated in the middle of execution, GLI will 322 # connect to a serverSocket here to communicate when it's time to stop wget. 323 if(defined $self->{'gli'} && $self->{'gli'} && !defined $port) { 324 325 $port = <STDIN>; # gets a port on localhost that's not yet in use 326 chomp($port); 327 328 $serverSocket = IO::Socket::INET->new( Proto => 'tcp', 329 LocalPort => $port, 330 Listen => 1, 331 Reuse => 1); 332 333 die "can't setup server" unless $serverSocket; 334 #print STDOUT "[Serversocket $0 accepting clients at port $port]\n"; 335 336 $read_set = new IO::Select(); # create handle set for reading 337 $read_set->add($serverSocket); # add the main socket to the set 338 } 339 315 340 my $wget_file_path = &util::filename_cat($ENV{'GSDLHOME'}, "bin", $ENV{'GSDLOS'}, "wget"); 316 341 #my $command = "\"$wget_file_path\" $cmdWget 2>&1 |"; #open(*WIN,$command) || die "wget request failed: $!\n"; 317 ### print STDERR "**** wget cmd = $command\n"; 318 #open(*WIN,$command) || die "wget request failed: $!\n"; 319 320 my $command = "\"$wget_file_path\" $cmdWget"; 342 my $command = "\"$wget_file_path\" $cmdWget 2>&1"; 343 # print STDERR "Command is: $command\n"; 321 344 $childpid = open2($chld_out, $chld_in, $command) || die "wget request failed: $!\n"; 322 345 … … 326 349 my $line; 327 350 328 while (defined($line=<$chld_out>)) # we're reading in from child process' stdout 329 { 330 if((defined $blnShow) && $blnShow) 331 { 332 print STDERR "$line"; 333 } 334 335 if ($line =~ m/^Location:\s*(.*?)\s*\[following\]\s*$/i) { 336 my $follow_url = $1; 337 push(@follow_list,$follow_url); 338 } 339 340 if ($line =~ m/ERROR\s+\d+/) { 341 $error_text .= $line; 342 } 343 344 $full_text .= $line; 345 } 346 347 close($chld_in); 348 close($chld_out); 349 350 # Program terminates only when the following line is included 351 # http://perldoc.perl.org/IPC/Open2.html explains why this is necessary 352 # it prevents the child from turning into a "zombie process". 353 # While the wget process terminates without it, this perl script does not: 354 # the DOS prompt is not returned without it. 355 waitpid $childpid, 0; 351 my $loop = 1; 352 while($loop) 353 { 354 if (defined($line=<$chld_out>)) { # we're reading in from child process' stdout 355 if((defined $blnShow) && $blnShow) 356 { 357 print STDERR "$line"; 358 } 359 360 if ($line =~ m/^Location:\s*(.*?)\s*\[following\]\s*$/i) { 361 my $follow_url = $1; 362 push(@follow_list,$follow_url); 363 } 364 365 if ($line =~ m/ERROR\s+\d+/) { 366 $error_text .= $line; 367 } 368 369 $full_text .= $line; 370 } 371 else { # wget finished, terminate naturally 372 #print STDERR "\nPerl: open2 command, input stream closed. Wget terminated naturally.\n"; 373 close($chld_in); 374 close($chld_out); 375 # Program terminates only when the following line is included 376 # http://perldoc.perl.org/IPC/Open2.html explains why this is necessary 377 # it prevents the child from turning into a "zombie process". 378 # While the wget process terminates without it, this perl script does not: 379 # the DOS prompt is not returned without it. 380 waitpid $childpid, 0; 381 $loop = 0; 382 383 $childpid = undef; 384 if(defined $port) { 385 $read_set->remove($serverSocket); 386 close($serverSocket); 387 } 388 } 389 390 # if we run this script from the command-line (as opposed to from GLI), 391 # then we're not working with sockets and can therefore can skip the next bits 392 next unless(defined $port); 393 394 # http://www.perlfect.com/articles/select.shtml 395 # "multiplex between several filehandles within a single thread of control, 396 # thus creating the effect of parallelism in the handling of I/O." 397 my @rh_set = $read_set->can_read(0.002); # every 2 ms check if there's a client socket connecting 398 399 # take all readable handles in turn 400 foreach my $rh (@rh_set) { 401 if($rh == $serverSocket) { 402 my $client = $rh->accept(); 403 #$client->autoflush(1); # autoflush output buffer - don't put this back in: splits output irregularly over multilines 404 print $client "Talked to ServerSocket (port $port). Connection accepted\n"; 405 406 # Read from the client (getting rid of trailing newline) 407 # Has the client sent the <<STOP>> signal? 408 my $signal = <$client>; 409 chomp($signal); 410 if($signal eq "<<STOP>>") { 411 print $client "Perl received STOP signal (on port $port): stopping wget\n"; 412 413 $loop = 0; 414 close($chld_in); 415 close($chld_out); 416 kill("TERM", $childpid); 417 418 $childpid = undef; 419 420 # Stop monitoring the read_handle 421 # close the serverSocket (the Java end will close the client socket that Java opened) 422 $read_set->remove($rh); #$read_set->remove($serverSocket); 423 close($rh); #close($serverSocket); 424 #print $client "Perl is about to exit\n"; 425 last; 426 } 427 } 428 } 429 } 356 430 357 431 my $command_status = $?;
Note:
See TracChangeset
for help on using the changeset viewer.