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

Hi all, I am having trouble with a perl open pipe where it seems to exiting from the called script early for some users. I have a script that talks to an SQL database, but before it even tries to communicate with the SQL database I have it printing a message stating that the script has started running: 

# Subscript
PrintLog("My sub-script is running...","i");
PrintLog("Yes, just to confirm I am running...","i");
...etc...onto the SQL stuff

[download]

My main script then calls this as follows: 

  my $run_pid = open(RUN, "sub_script.pl $options 2>&1 |") or $sub_fai
+led = 1;
  
  if (!$sub_failed) {
    $text .= "Entered if (!\$sub_failed) {\n";
    while (<RUN>) { 
      $text .= "Entered while (<RUN>)\n";
      chomp;
      $_ =~ s/^\s*//;  
      $text .= "$_\n";
    }
    close(RUN);
    if ($? != 0) { $sub_failed = 1; } 
  }
  else { $text .= "Failed to open sub_script.pl\n";}

  print "$text";

[download]
The problem I am seeing is that the print of text at the end can sometimes return any of the following: 
Entered if (!\$sub_failed) {

or

Entered if (!\sub_failed) {
Entered while (<RUN>)

or

Entered if (!\$sub_failed) {
Entered while (<RUN>)
My sub-script is running...

or

Entered if (!\$sub_failed) {
Entered while (<RUN>)
My sub-script is running...
Yes, just to confirm I am running.. 

and so on...

[download]

I am struggling to figure out what my be the cause of thinking the pipe is finished early. I have use piped opens in several places without issue so originally though that the issue was a due to a delay in connecting to the SQL server but the prints show that things can fall over even before I get to the SQL part of things.

Any advice/direction would be appreciated.

Thanks

Albob

Replies are listed 'Best First'.
Re: Perl open pipe exiting early
by RichardK (Parson) on Apr 03, 2015 at 11:39 UTC

    Why not print out the error string $! to see what's failing?

[reply]
      Yes, I missed that one. I should be doing that. Hopefully that will give me a pointer. Thanks
[reply]
        No luck with this, ubless I messed up the way I added it: 
         my $run_pid = open(RUN, "sub_script.pl $options 2>&1 |") or $sub_fai
+led = 1;
  
  if (!$sub_failed) {
    $text .= "Entered if (!\$sub_failed) {\n";
    while (<RUN>) { 
      $text .= "Entered while (<RUN>)\n";
      chomp;
      $_ =~ s/^\s*//;  
      $text .= "$_\n";
    }
    close(RUN);
    if ($? != 0) { $sub_failed = 1; $text = "Open error: $!\n";} 
  }
  else { $text .= "Failed to open sub_script.pl\n";}

  print "$text";

        [download]
        $! returned empty. I could well be using it incorrectly though.
[reply]
[d/l]
Re: Perl open pipe exiting early
by Anonymous Monk on Apr 03, 2015 at 10:47 UTC
[reply]
[d/l]
      Hi,

      Thanks for the response. Will the use of fudge only work though if I know the failure point? My script "fails" when the the script thinks that my file handle's reference count has reached zero before it should have done. I am not sure how I can catch this issue using fudge. Or should i just run the fudge procedure every time and it will eventually catch the information I need?

      if (my $pid = open(...) {
  while(<FH>) {
  }
  fudge():
} else{ 
}

      [download]

      Thanks

      (The issue is made difficult by the fact that I can't reproduce the issue locally....but multiple users are seeing it. Makes debugging difficult!)

[reply]
[d/l]

        Thanks for the response. Will the use of fudge only work though if I know the failure point?

        Use it in every place there can be a failure ... open or Fudge() ... close or Fudge() ... even readline or Fudge(); 

             while ( ! eof($fh) ) {
    defined( $_ = <$fh> ) or die Fudge("readline \$fh");
    ...
    }

        [download]

        Heck, even enhance it to sparkle some $? extras 

        sub Fudge {
    my $pipe = $?;
    use Errno();
    my $msg = join qq/\n/,
      "Error @_",
      map { "  $_" } int( $! ) . q/ / . $!,
      int( $^E ) . q/ / . $^E,
      grep( { $!{$_} } keys %! )
    ;
    
    $^E = $! = $pipe;
    $msg .= join qq/\n/,
            map { "  $_" }
            "\n  #",
#~                 int( $! ) . q/ / . $!,
#~                 int( $^E ) . q/ / . $^E,
                'status($?) '.( $pipe ),
                'subexit($? >>8) '.( $pipe >> 8),
                'signal($? & 127) '.( $pipe & 127 ),
                'coredump($? & 128) '.( $pipe & 128 ),
                grep( { $!{$_} } keys %! ),
                q/ /;
    return $msg;
}

        [download]
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom