1: #!/usr/bin/perl -w
   2: 
   3: #Here's a simple module that lets you run a "forever" kind 
   4: #of script, and know it will die at a time you specify.
   5: 
   6: #This could be better, but it does what I need.
   7: 
   8: #Edit: Added note about hooking $SIG{INT} for cleanup to
   9: #POD comments
  10: 
  11: package Until;
  12: 
  13: =head1 NAME
  14: 
  15: Until.pm
  16: 
  17: =head1 SYNOPSIS
  18: 
  19:     use Until "16:30";
  20: 
  21:     sub cleanup {
  22:         # do whatever you need to do on exit
  23:     }
  24: 
  25:     $SIG{INT}=\&cleanup;
  26: 
  27:     while(1) {
  28:         # do something...
  29:     }
  30: 
  31: =head1 DESCRIPTION
  32: 
  33: This simple module forks, and the child process returns.  The parent
  34: process waits for the designated end time, then kills the child process.
  35: 
  36: =cut
  37: 
  38: use strict;
  39: 
  40: sub import
  41: {
  42:     my $stopTime=$_[-1];
  43: 
  44:     die "Arg 1 ($stopTime) must be hh:mm" unless $stopTime=~/^(\d\d?):(\d\d)$/;
  45:     print "Running until $stopTime\n";
  46: 
  47:     my ($h,$m)=($1,$2);
  48:     my $endMinutes=$h*60+$m;
  49: 
  50:     my $pid;
  51: 
  52:     if(!($pid=fork)) {
  53:         # did fork fail?
  54:         die "Error forking ($!)" if !defined $pid;
  55: 
  56:         # child process
  57:         return;
  58:     }
  59:     else {
  60:         my $currMinutes;
  61:         do {
  62:             my ($h, $m)=(localtime)[2,1];
  63:             $currMinutes=$h*60+$m;
  64:             sleep(5) unless $currMinutes<$endMinutes;
  65:         } while($currMinutes < $endMinutes);
  66: 
  67:         # kill child process
  68:         my $result=kill "INT",$pid;
  69:         print "Killed child process $pid (result $result)\n";
  70: 
  71:         exit;
  72:     }
  73: }
  74: 
  75: 1;