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

Hello Perl experts. Before I begin just want to point out that I am new to programming so keep that in mind before killing me :)

I am trying to figure out why the following code that I wrote is not working correctly. I am going through some examples in the book which don't seem to cover SIGNAL catching very well so any tips/help would be helpful.

With that being said not sure why what I am doing wrong. From what I can see the script recognizes the CTRL-C key combo but then skips right over test1 and test2 subroutines depending on when the CTRL-C is detected. My question is how/what is the best way with the code below to have it catch the ctrl-c key combo and have it wait until all processing has been completed then once it's done with all the code then exit.

So to recap trying to figure out how to catch ctrl-c no matter where the script is at once it sees that key combo then wait until all the code has run then exit. Thanks for all the help in advanced.
#!/usr/bin/perl use strict; use warnings; use Fcntl qw(:flock); my $testFile1 = "/tmp/test.txt"; my $lck = "/tmp/l.lck"; my $wantToQuit = 0; while (1) { while ( !$wantToQuit ) { $SIG{INT} = 'wait'; my $pid = fork(); if ( !defined( $pid ) ) { die("can't fork sub proc\n"); } if ( $pid == 0 ) { if ( ! -e $lck ) { print "\n\ntestFile1 does not exist, f +ile READY for reading\n"; open(LCK, ">$lck") || die "Could not o +pen $lck $!\n"; flock(LCK, LOCK_EX); open(FH, "+<$testFile1") || die "Could + not open $testFile1 $!\n"; close(FH); close(LCK); print "$testFile1 file CREATED\n"; &test1; &test2; } else { print "$testFile1 exits, must wait til + it's gone\n"; print "Sleeping for 10 seconds, then c +hecking for lock file\n"; countDown(10); } $SIG{INT} = 'DEFAULT'; } waitpid($pid,0); } exit if $wantToQuit; } sub wait { print "\n\n\n===============WAIT SUB=================\n"; print "CTRL-C signal was been detected please hold while we fi +nish running the script\n"; $wantToQuit = 1; print "\n\n\n===============END WAIT SUB=================\n"; } sub test1 { print "\n\n\n===============TEST1 SUB=================\n"; print "Sleeping for 3 seconds In sub test1\n"; countDown(3); print "===============END TEST1 SUB=================\n"; } sub test2 { print "\n\n\n===============TEST2 SUB=================\n"; print "Sleeping for 3 secs In sub Test2\n"; sleep 3; print "Not done yet gotta sleep for another 15 seconds then we + can quit\n"; countDown(15); print "DONE WITH ALL CODE PROGRAM SHOULD NOW EXIT\n"; print "===============END TEST2 SUB=================\n"; exit 0; } sub countDown { my $delay = shift; my $count = 0; while ( $count < $delay ) { print "$count\n"; sleep 1; $count++; } }

Replies are listed 'Best First'.
Re: Call Intercepts
by almut (Canon) on Nov 30, 2009 at 22:26 UTC

    One problem is that you don't call exit in your child process (i.e. at the end of if ( $pid == 0 ) { ... }).  Adding that, the program behaves for me like (I think) what you want to achieve — though I'm not entirely sure I've understood correctly... (i.e. it reports to have detected CTRL-C, finishes whatever countDown loop it was in, then quits)  With an existing /tmp/test.txt, that is — which you don't seem to create anywhere in the script itself.  open(FH, "+<$testFile1") ... does not create the file, rather, it dies with "No such file or directory" if the file doesn't already exist. In this case, test1()/test2() won't ever be called. Likewise, the message "$testFile1 file CREATED\n" is kinda bogus, as it'll only be printed if the file already did exist...

      Thanks for the replies. Sorry I didn't explain myself very well. What I am trying to accomplish is the program to run continuously and also only exit if all code has been run through its entirety, so in my example it should only exit once it has reached the end of &test2 sub since that's where the exit 0 is being called.

      The code below works but when I added the IF to check if a file exits it does not work as desired when it reaches the ELSE statement (else { print "$testFile1) when the lck file indeed exists. While that section of code loops until the lck file is removed if a ctrl-c is sent while that section of code is running then the script just gets stuck and does not continue to wait until the lck file is removed. So as long as the ctrl-c is hit outside that else statement section it works as desired.

      With the code below which I removed the check of file existence the code work as desired. If I launch the script and hit ctrl-c then it only exits once it has reached the end of the test2 subroutine.

      To answer you other questions: testFile1 will always exits in that location. lck file gets created by the script although right now I have no added code to have it removed as I am trying to get this one part working first. Thanks again for all the help.
      #!/usr/bin/perl use strict; use warnings; use Fcntl qw(:flock); my $testFile1 = "/tmp/test.txt"; my $lck = "/tmp/l.lck"; my $wantToQuit = 0; while (1) { while ( !$wantToQuit ) { $SIG{INT} = 'waitThenExit'; my $pid = fork(); if ( !defined( $pid ) ) { die("can't fork sub proc\n"); } if ( $pid == 0 ) { print "Currently in pid==0 section, sleeping for 5 seconds +\n"; countDown(5); &test1; &test2; $SIG{INT} = 'DEFAULT'; } waitpid($pid,0); } exit 0 if $wantToQuit; } sub waitThenExit { print "\n\n\n===============WAIT SUB=================\n"; print "One moment, I just gotta finish this bit...\n"; $wantToQuit = 1; print "\n\n\n===============END WAIT SUB=================\n"; } sub test1 { print "\n\n\n===============TEST1 SUB=================\n"; print "Sleeping for 3 seconds In sub test1\n"; countDown(3); print "===============END TEST1 SUB=================\n"; } sub test2 { print "\n\n\n===============TEST2 SUB=================\n"; print "Sleeping for 3 secs In sub Test2\n"; sleep 3; print "Not done yet gotta sleep for another 15 seconds then we can + quit\n"; countDown(15); print "DONE WITH ALL CODE PROGRAM SHOULD NOW EXIT\n"; print "===============END TEST2 SUB=================\n"; exit 0; } sub countDown { my $delay = shift; my $count = 0; while ( $count < $delay ) { print "$count\n"; sleep 1; $count++; } }
      Output when script is run with no interuption
      Currently in pid==0 section, sleeping for 5 seconds 0 1 2 3 4 ===============TEST1 SUB================= Sleeping for 3 seconds In sub test1 0 1 2 ===============END TEST1 SUB================= ===============TEST2 SUB================= Sleeping for 3 secs In sub Test2 Not done yet gotta sleep for another 15 seconds then we can quit 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 DONE WITH ALL CODE PROGRAM SHOULD NOW EXIT

      OUTPUT WHEN CTRL-C is hit right after the script has been launched
      Currently in pid==0 section, sleeping for 5 seconds 0 1 ===============WAIT SUB================= One moment, I just gotta finish this bit... ===============END WAIT SUB================= 2 ===============WAIT SUB================= One moment, I just gotta finish this bit... ===============END WAIT SUB================= 3 4 ===============TEST1 SUB================= Sleeping for 3 seconds In sub test1 0 1 2 ===============END TEST1 SUB================= ===============TEST2 SUB================= Sleeping for 3 secs In sub Test2 Not done yet gotta sleep for another 15 seconds then we can quit 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 DONE WITH ALL CODE PROGRAM SHOULD NOW EXIT ===============END TEST2 SUB=================
        it does not work as desired when it reaches the ELSE statement (else { print "$testFile1) when the lck file indeed exists. (...) the script just gets stuck and does not continue

        You're still not using exit in the child! :)  The problem with this is that the child process continues to run code outside of the if ( $pid == 0 ) {...}, i.e. you have two processes (parent and child) running the same code, which is not what you want (in this particular case, each child forks a new process, while its parent hangs in waitpid() waiting for it to terminate, which it doesn't because it in turn is waiting for its own child...)  Add

        ... print "doing waitpid($pid,0)...\n"; # <--- waitpid($pid,0);

        and you'll see what I mean — i.e. that it hangs after "doing waitpid(0,0)..." after you have pressed CTRL-C (in which case you stop forking new children due to $wantToQuit now being true), and that you're accumulating more and more processes otherwise — run ps axf from another terminal after a while, and you'll see something like this

        17001 pts/16 S+ 0:00 \_ /usr/bin/perl ./810377.pl 17002 pts/16 S+ 0:00 \_ /usr/bin/perl ./810377.pl 17004 pts/16 S+ 0:00 \_ /usr/bin/perl ./810377. +pl 17005 pts/16 S+ 0:00 \_ /usr/bin/perl ./810 +377.pl 17007 pts/16 S+ 0:00 \_ /usr/bin/perl . +/810377.pl 17008 pts/16 S+ 0:00 \_ /usr/bin/pe +rl ./810377.pl 17009 pts/16 S+ 0:00 \_ /usr/bi +n/perl ./810377.pl 17018 pts/16 S+ 0:00 \_ /us +r/bin/perl ./810377.pl 17021 pts/16 S+ 0:00 \_ + /usr/bin/perl ./810377.pl 17054 pts/16 R+ 0:03 + \_ /usr/bin/perl ./810377.pl

        with all those processes hanging in waitpid() because their children haven't yet exited.  This problem only manifests in case of the else branch being run, because otherwise you are in fact exiting with the exit 0; at the end of test2().

        Add an exit here

        if ( $pid == 0 ) { if ( ! -e $lck ) { ... } else { ... } $SIG{INT} = 'DEFAULT'; exit; # <--- }

        and the problem is gone.  And if you want to execute the test*() routines in the else case, too (which I'm not quite sure as you're saying "...only exit if all code has been run through its entirety"), you'd have to take them out of the if branch...

Re: Call Intercepts
by ikegami (Patriarch) on Nov 30, 2009 at 23:33 UTC

    You weren't clear on what behaviour you are getting and what behaviour you were expecting, but I think you're complaining about your operations getting interrupted by signals. That's a must for signals to be useful.

    However, nothing is stopping you from checking if your blocking operations (sleep, flock) got interrupted and restarting them when they are.

    use Errno qw( EINTR ); sub unint_flock(*$) { for (;;) { return if flock($_[0], $_[1]) || $! != EINTR; } } sub unint_sleep($) { my $sleep_til = time + $_[0]; for (;;) { my $sleep_dur = time - $sleep_til; last if $sleep_dur <= 0; sleep($sleep_dur); } }

    This is a separate issue from the serious problem almut pointed out.

Re: Call Intercepts
by cdarke (Prior) on Dec 01, 2009 at 11:12 UTC
    It's not a good idea to have your own subroutine called wait, since that is the name of a Perl builtin.