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