view release on metacpan or  search on metacpan

lib/Daemon/Generic.pm  view on Meta::CPAN

sub new
{
	my ($pkg, %args) = @_;

	if ($pkg eq __PACKAGE__) {
		$pkg = caller() || 'main';
	}

	srand(time ^ ($$ << 5))
		unless $args{no_srand};

	my $av0 = $0;
	$av0 =~ s!/!/.!g;

	my $self = {
		gd_av0		=> $av0,
		gd_args		=> \%args,
		gd_pidfile	=> $args{pidfile},
		gd_logpriority	=> $args{logpriority},
		gd_progname	=> $args{progname}
					? $args{progname}
					: $0,
		gd_pidbase	=> $args{pidbase}
					? $args{pidbase}
					: ($args{progname} 
						? "/var/run/$args{progname}"
						: "/var/run/$av0"),
		gd_foreground	=> $args{foreground} || 0,
		configfile	=> $args{configfile}
					? $args{configfile}
					: ($args{progname}
						? "/etc/$args{progname}.conf"
						: "/etc/$av0"),
		debug		=> $args{debug} || 0,
	};
	bless $self, $pkg;

	$self->gd_getopt;
	$self->gd_parse_argv;

	my $do = $self->{do} = $ARGV[0];

	$self->gd_help		if $do eq 'help';
	$self->gd_version	if $do eq 'version';
	$self->gd_install	if $do eq 'install';
	$self->gd_uninstall	if $do eq 'uninstall';

	$self->gd_pidfile unless $self->{gd_pidfile};

	my %newconfig = $self->gd_preconfig;

	$self->{gd_pidfile} = $newconfig{pidfile} if $newconfig{pidfile};

	print "PIDFILE=$self->{gd_pidfile}\n" if $self->{debug};

	print "Configuration looks okay\n" if $do eq 'check';

	my $pidfile = $self->{gd_pidfile};
	my $killed = 0;
	my $locked = 0;
	if (-e $pidfile) {
		if ($locked = lock($pidfile, undef, 'nonblocking')) {
			# old process is dead
			if ($do eq 'status') {
			    print "$self->{gd_progname} dead\n";
			    exit 1;
			}
		} else {
			sleep(2) if -M $pidfile < 2/86400;
			my $oldpid = read_file($pidfile);
			chomp($oldpid);
			if ($oldpid) {
				if ($do eq 'stop' or $do eq 'restart') {
					$killed = $self->gd_kill($oldpid);
					$locked = lock($pidfile);
					if ($do eq 'stop') {
						unlink($pidfile);
						exit;
					}
				} elsif ($do eq 'reload') {
					if (kill(1,$oldpid)) {
						print "Requested reconfiguration\n";
						exit;
					} else {
						print "Kill failed: $!\n";
					}
				} elsif ($do eq 'status') {
					if (kill(0,$oldpid)) {
						print "$self->{gd_progname} running - pid $oldpid\n";
						$self->gd_check($pidfile, $oldpid);
						exit 0;
					} else {
						print "$self->{gd_progname} dead\n";
						exit 1;
					}
				} elsif ($do eq 'check') {
					if (kill(0,$oldpid)) {
						print "$self->{gd_progname} running - pid $oldpid\n";
						$self->gd_check($pidfile, $oldpid);
						exit;
					} 
				} elsif ($do eq 'start' || $do eq 'debug') {
					print "\u$self->{gd_progname} is already running (pid $oldpid)\n";
					exit; # according to LSB, this is no error
				}
			} else {
				$self->gd_error("Pid file $pidfile is invalid but locked, exiting\n");
			}
		}
	} else {
		$locked = lock($pidfile, undef, 'nonblocking') 
			or die "Could not lock pid file $pidfile: $!";
	}

	if ($do eq 'reload' || $do eq 'stop' || $do eq 'check' || ($do eq 'restart' && ! $killed)) {
		print "No $self->{gd_progname} running\n";
	}

	if ($do eq 'stop') {
		unlink($pidfile);
		exit;
	}

	if ($do eq 'status') {
		print "No $self->{gd_progname} running\n";
		exit 3;
	}

	if ($do eq 'check') {
		$self->gd_check($pidfile);
		exit 
	}

	unless ($do eq 'reload' || $do eq 'restart' || $do eq 'start' || $do eq 'debug') {
		$self->gd_other_cmd($do, $locked);
	}

	unless ($self->{gd_foreground} || $do eq 'debug') {
		$self->gd_daemonize;
	}

	$locked or lock($pidfile, undef, 'nonblocking') 
		or die "Could not lock PID file $pidfile: $!";

	write_file($pidfile, "$$\n");

	print STDERR "Starting up...\n";

	$self->gd_postconfig(%newconfig);

	$self->gd_setup_signals;

	$self->gd_run;

	unlink($pidfile);
	exit(0);
}

sub gd_check {}

sub gd_more_opt { return() }

sub gd_getopt
{
	my $self = shift;
	Getopt::Long::Configure("auto_version");
	GetOptions(
		'configfile=s'	=> \$self->{configfile},
		'foreground!'	=> \$self->{gd_foreground},
		'debug!'	=> \$self->{debug},
		$self->{gd_args}{options}
			? %{$self->{gd_args}{options}}
			: (),
		$self->gd_more_opt(),
	) or exit($self->gd_usage());

	if (@ARGV < ($self->{gd_args}{minimum_args} || 1)) {
		exit($self->gd_usage());
	}
	if (@ARGV > ($self->{gd_args}{maximum_args} || 1)) {
		exit($self->gd_usage());
	}
}

sub gd_parse_argv { }

sub gd_help
{
	my $self = shift;
	exit($self->gd_usage($self->{gd_args}));
}

sub gd_version
{
	my $self = shift;
	no strict qw(refs);
	my $v = $self->{gd_args}{version} 
		|| ${ref($self)."::VERSION"} 
		|| $::VERSION 
		|| $main::VERSION 
		|| "?";
	print "$self->{gd_progname} - version $v\n";;