################################################## # CronDaemon.pm -- Start/stop a pseudo daemon # triggered by the cron ################################################## package CronDaemon; use warnings; use strict; use Log::Log4perl qw(:easy); our $VERSION = "1.02"; our $CVSVERSION = '$Revision: 1.6 $'; our @ISA = qw(Exporter); # The time when a lingering process will be # considered hung and will be shot down my $KILL_TIME = 30*60; # 30 minutes ################################################## sub new { ################################################## my ($class, @opts) = @_; my $self = { pidfile => "/tmp/pid", verbose => 0, @opts, }; bless $self, $class; return $self; } ################################################## sub info { ################################################## my ($self) = @_; return undef unless -f $self->{pidfile}; open F, "<$self->{pidfile}" or die "Cannot open $self->{pidfile}"; my ($pid, $starttime) = split / /, scalar , 2; chomp $pid; close F; return($pid, $starttime); } ################################################## sub already_running { ################################################## my ($self) = @_; my($pid, $starttime) = $self->info(); return 0 unless $pid; # Is the process still running? if(!kill(0, $pid)) { # pid file there, but process gone $self->rm_pidfile(); return 0; } # Another instance of this script is running INFO "Another instance is running"; # It's running already - so don't erase the pidfile later $self->{keeppidfile} = 1; # Older than 5 mins? Kill instance and remove file if($starttime < time() - $KILL_TIME) { INFO "Killing hung instance"; for(1..5) { kill 2, $pid; last unless kill(0, $pid); sleep 2; INFO "Trying again"; } if(kill 0, $pid) { kill(9, $pid); sleep(10); } unlink $self->{pidfile} or die "Cannot rm $self->{pidfile}"; # We killed it, so it's no longer running return 0; } return 1; } ################################################## sub register { ################################################## my ($self) = @_; open F, ">$self->{pidfile}" or die "Cannot open $self->{pidfile} (writing)"; print F "$$ ", time(), "\n"; close F; return 1; } ################################################## sub DESTROY { ################################################## my ($self) = @_; if($self->{keeppidfile}) { INFO "Keeping pidfile"; } else { $self->rm_pidfile(); } } ################################################## sub rm_pidfile { ################################################## my ($self) = @_; INFO "Deleting $self->{pidfile}"; unlink $self->{pidfile} or die "Cannot unlink $self->{pidfile}"; } 1; __END__ =head1 NAME CronDaemon.pm -- Utility module for crontab-triggered pseudo daemons =head1 DOWNLOAD _SRC_HERE_ =head1 SYNOPSIS use CronDaemon; =head1 DESCRIPTION Sometimes instead of running a permanent daemon you want a script to kick in in regular intervals, do its job and then terminate. This way it's not susceptible to memory growth, unreclaimed file handles and other issues badly programmed scripts run into when run 24 hours a day without restart. If you run a script e.g. every minute from the cron, however, and it takes more than 60 secs to complete, there's going to be 2 instances of the same script potentially interfering with each other. Enter C. It will make sure that at all times, there's only one instance of the script. If an instance hangs, and therefore prevents a script restart for a configurable number of rounds, the new instance will kill the old one and step in its place. =head1 EXAMPLES use CronDaemon; my $cd = CronDaemon->new(pidfile => "/tmp/myapp_pid_file"); if($cd->already_running()) { print "Another instance already running\n"; exit 0; } else { print "Registering new instance\n"; $cd->register(); } sleep(10); # This is our application # PID file will be erased automatically if $cd goes out of scope C is C enabled. If you turn on logging in the C category, you'll see logging statements according to your C settings. =head1 LEGALESE Copyright 2002 by Mike Schilli, all rights reserved. This program is free software, you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR 2002, Mike Schilli