r11023 - in /branches/upstream/libapp-control-perl: ./ current/ current/Changes current/Control.pm current/MANIFEST current/Makefile.PL current/README current/sample/ current/sample/test.pl current/test.pl
bremner-guest at users.alioth.debian.org
bremner-guest at users.alioth.debian.org
Sat Dec 8 13:51:26 UTC 2007
Author: bremner-guest
Date: Sat Dec 8 13:51:25 2007
New Revision: 11023
URL: http://svn.debian.org/wsvn/?sc=1&rev=11023
Log:
[svn-inject] Installing original source of libapp-control-perl
Added:
branches/upstream/libapp-control-perl/
branches/upstream/libapp-control-perl/current/
branches/upstream/libapp-control-perl/current/Changes
branches/upstream/libapp-control-perl/current/Control.pm
branches/upstream/libapp-control-perl/current/MANIFEST
branches/upstream/libapp-control-perl/current/Makefile.PL
branches/upstream/libapp-control-perl/current/README
branches/upstream/libapp-control-perl/current/sample/
branches/upstream/libapp-control-perl/current/sample/test.pl (with props)
branches/upstream/libapp-control-perl/current/test.pl
Added: branches/upstream/libapp-control-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libapp-control-perl/current/Changes?rev=11023&op=file
==============================================================================
--- branches/upstream/libapp-control-perl/current/Changes (added)
+++ branches/upstream/libapp-control-perl/current/Changes Sat Dec 8 13:51:25 2007
@@ -1,0 +1,9 @@
+$Log: Changes,v $
+Revision 1.6 2003/08/27 16:48:51 wrigley
+moved $SIG{CHLD} = "IGNORE" after the fork to prevent the child from inheriting it
+
+Revision 1.5 2003/02/24 13:39:19 wrigley
+added $Log: Changes,v $
+added Revision 1.6 2003/08/27 16:48:51 wrigley
+added moved $SIG{CHLD} = "IGNORE" after the fork to prevent the child from inheriting it
+added to Changes
Added: branches/upstream/libapp-control-perl/current/Control.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libapp-control-perl/current/Control.pm?rev=11023&op=file
==============================================================================
--- branches/upstream/libapp-control-perl/current/Control.pm (added)
+++ branches/upstream/libapp-control-perl/current/Control.pm Sat Dec 8 13:51:25 2007
@@ -1,0 +1,376 @@
+package App::Control;
+
+$VERSION = '1.02';
+
+use strict;
+use warnings;
+
+use File::Basename;
+use File::Path;
+
+sub new
+{
+ my $class = shift;
+ my %args = @_;
+
+ my $self = bless \%args, $class;
+
+ die "No EXEC specified\n" unless $self->{EXEC};
+ die "$self->{EXEC} doesn't exist\n" unless -e $self->{EXEC};
+ die "$self->{EXEC} is not executable\n" unless -x $self->{EXEC};
+ die "No PIDFILE specified\n" unless $self->{PIDFILE};
+ my $piddir = dirname( $self->{PIDFILE} );
+ die "Can't work out directory from path $self->{PIDFILE}\n"
+ unless $piddir
+ ;
+ unless ( -d $piddir )
+ {
+ warn "Creating $piddir ...\n" if $self->{VERBOSE};
+ mkpath( $piddir ) or die "Can't create path $piddir\n";
+ }
+ unless ( -w $piddir )
+ {
+ die "can't create $self->{PIDFILE}\n";
+ }
+ if ( -e $self->{PIDFILE} )
+ {
+ die "$self->{PIDFILE} is not readable\n"
+ unless -r $self->{PIDFILE}
+ ;
+ die "$self->{PIDFILE} is not writeable\n"
+ unless -w $self->{PIDFILE}
+ ;
+ }
+ if ( defined $self->{ARGS} )
+ {
+ die "ARGS should be an ARRAY ref\n"
+ unless ref( $self->{ARGS} ) eq 'ARRAY'
+ ;
+ }
+ $self->{SLEEP} = 1 unless defined $self->{SLEEP};
+ $self->{ARGS} ||= [];
+ return $self;
+}
+
+sub running()
+{
+ my $self = shift;
+ my $pid = $self->pid;
+ return defined( $pid ) ? kill( 0, $self->{PID} ) : 0;
+}
+
+sub pid()
+{
+ my $self = shift;
+ return unless -e $self->{PIDFILE};
+ die "Can't read $self->{PIDFILE}\n" unless -r $self->{PIDFILE};
+ open( PID, $self->{PIDFILE} )
+ or die "Can't open pid file $self->{PIDFILE}\n"
+ ;
+ my $pid = <PID>;
+ close( PID );
+ return undef unless defined $pid;
+ chomp( $pid );
+ return undef unless $pid;
+ die "$pid looks like a funny pid!\n"
+ unless $pid =~ /^(\d+)$/
+ ;
+ return $self->{PID} = $1;
+}
+
+sub cmd()
+{
+ my $self = shift;
+ my $cmd = shift;
+
+ return if
+ defined $self->{IGNOREFILE} and
+ -e $self->{IGNOREFILE}
+ ;
+ unless ( defined $cmd )
+ {
+ die "CMD should be <start|stop|restart|status|hup>\n";
+ }
+ if ( $cmd eq 'status' )
+ {
+ return
+ "$self->{EXEC} (",
+ ( $self->pid ? $self->pid : "no pidfile $self->{PIDFILE}" ),
+ ") is ",
+ ( $self->running ? '' : 'not ' ),
+ "running\n"
+ ;
+ }
+ elsif ( $cmd eq 'start' )
+ {
+ die $self->status if $self->running;
+ my $child = fork;
+ if ( $child )
+ {
+ $SIG{CHLD} = 'IGNORE';
+ warn "$self->{EXEC} @{$self->{ARGS}} ($child) started\n"
+ if $self->{VERBOSE}
+ ;
+ if ( $self->{CREATE_PIDFILE} )
+ {
+ warn "Creating $self->{PIDFILE} ...\n" if $self->{VERBOSE};
+ open( FH, ">$self->{PIDFILE}" )
+ or die "Can't write to $self->{PIDFILE}"
+ ;
+ print FH "$child\n";
+ close( FH );
+ }
+ my $loop = 0;
+ while( not $self->running )
+ {
+ warn $self->status if $self->{VERBOSE};
+ sleep( $self->{SLEEP} );
+ warn "is $self->{EXEC} ruinning (${loop}'th time)?\n"
+ if $self->{VERBOSE} and $loop
+ ;
+ if ( defined $self->{LOOP} and $loop++ == $self->{LOOP} )
+ {
+ warn "Failed to start $self->{EXEC}\n"
+ if $self->{VERBOSE}
+ ;
+ if ( kill( 0, $child ) )
+ {
+ warn "killing $child ...\n" if $self->{VERBOSE};
+ kill( 'KILL', $child );
+ exit;
+ }
+ }
+ }
+ warn "$self->{EXEC} running\n" if $self->{VERBOSE};
+ }
+ else
+ {
+ exec( $self->{EXEC}, @{$self->{ARGS}} );
+ }
+ }
+ elsif ( $cmd eq 'stop' )
+ {
+ die $self->status unless $self->running;
+ warn "kill ", $self->pid, "\n" if $self->{VERBOSE};
+ die "failed to kill ", $self->pid, "\n"
+ unless kill( 'TERM', $self->pid )
+ ;
+ while ( $self->running )
+ {
+ warn $self->status if $self->{VERBOSE};
+ sleep( 1 );
+ }
+ warn $self->pid, " killed\n" if $self->{VERBOSE};
+ if ( $self->{CREATE_PIDFILE} )
+ {
+ warn "unlink $self->{PIDFILE}\n" if $self->{VERBOSE};
+ unlink( $self->{PIDFILE} ) or
+ warn "Can't unlink $self->{PIDFILE}\n"
+ ;
+ }
+ }
+ elsif ( $cmd eq 'restart' )
+ {
+ if ( $self->running )
+ {
+ eval { $self->stop };
+ if ( $@ ) {
+ die "Error stopping $self->{EXEC}: $@\n";
+ }
+ }
+ eval { $self->start };
+ if ( $@ )
+ {
+ die "Error starting $self->{EXEC}: $@\n";
+ }
+ }
+ elsif ( $cmd eq 'hup' )
+ {
+ if ( $self->running )
+ {
+ unless ( kill( 'HUP', $self->pid ) )
+ {
+ die "Error hup'ing $self->{EXEC}: $@\n";
+ }
+ }
+ else
+ {
+ die "Can't hup $self->{EXEC}: not running\n";
+ }
+ }
+ else
+ {
+ die "CMD should be <start|stop|restart|status|hup>\n";
+ }
+}
+
+sub AUTOLOAD
+{
+ use vars qw( $AUTOLOAD );
+ my $self = shift;
+ my $method = $AUTOLOAD;
+ $method =~ s/.*:://;
+ return if $method eq 'DESTROY';
+ die "unkown method $method\n"
+ unless $method =~ /^(start|stop|restart|status|hup)$/
+ ;
+ $self->cmd( $method );
+}
+
+# True
+
+1;
+
+__END__
+
+=head1 NAME
+
+App::Control - Perl module for apachectl style control of another script or
+executable
+
+=head1 SYNOPSIS
+
+ use App::Control;
+ my $ctl = App::Control->new(
+ EXEC => $exec,
+ ARGS => \@args,
+ PIDFILE => $pidfile,
+ SLEEP => 1,
+ VERBOSE => 1,
+ );
+ my $pid = $ctl->pid;
+ if ( $ctl->running )
+ {
+ print "$pid is running\n";
+ }
+ else
+ {
+ print "$pid is not running\n";
+ }
+ # or alternatively ...
+ print $ctl->status;
+ $ctl->start;
+ # or alternatively ...
+ $ctl->cmd( 'start' );
+ $ctl->stop;
+ $ctl->hup;
+ $ctl->restart;
+
+=head1 DESCRIPTION
+
+App::Control is a simple module to replicate the kind of functionality you get
+with apachectl to control apache, but for any script or executable. There is a
+very simple OO interface, where the constructor is used to specify the
+executable, command line arguments, and pidfile, and various methods (start,
+stop, etc.) are used to control the executable in the obvious way.
+
+The module is intended to be used in a simple wrapper control script. Currently
+the module does a fork and exec to start the executable, and sets the signal
+handler for SIGCHLD to 'IGNORE' to avoid zombie processes.
+
+=head1 CONSTRUCTOR
+
+The constructor is called with a hash of options in the standard way. The
+options are as follows:
+
+=head2 EXEC
+
+Path to the executable to be controlled. This option is REQUIRED.
+
+=head2 ARGS
+
+Command line arguments for the executable. This option is OPTIONAL, but if set,
+should be an ARRAY reference.
+
+=head2 PIDFILE
+
+Path to the pidfile for the executable. This need not exists, but the
+constructor will die if it thinks it can't create it. If the path where
+the pidfile lives doesn't exist the constructor will try to create it. This
+option is REQUIRED.
+
+=head2 IGNOREFILE
+
+The ignore file allows you to temporarily disable the control functionality.
+Suppose you have a chkdaemon / crontab entry that restarts a service;
+specifying an IGNOREFILE means that you can disable this wihtout having to edit
+the relevant config files.
+
+=head2 CREATE_PIDFILE
+
+By default, App::Control depends on the application to manage the pid file.
+This is consistent will analogous utilities (apachectl, chkdaemon, etc.), but
+if you would like App::Control to create and remove pid files for you, then set
+this option to a true value.
+
+=head2 SLEEP
+
+Number of seconds to sleep before checking that the process has been started.
+If the start fails, the control script will loop with a SLEEP delay per
+iteration until it has (see <"LOOP">). Default is 1 second.
+
+head2 LOOP
+
+Number of times to loop before giving up on starting the process.
+
+=head2 VERBOSE
+
+If set to a true value, the module will output verbose messages to STDERR.
+
+=head1 METHODS
+
+=head2 start
+
+Start the executable specified in the constructor. This method waits until it
+is convinced that the executable has started. It then writes the new pid to the
+pidfile.
+
+=head2 stop
+
+Stop the executable specified in the constructor. It assumes that the pid
+listed in the pidfile specified in the constructor is the process to kill.
+This method waits until it is convinced that the executable has stopped.
+
+=head2 hup
+
+Send a SIGHUP to the executable.
+
+=head2 restart
+
+Basically; stop if running, and then start.
+
+=head2 status
+
+Returns a status message along the lines of "$exec ($pid) is / is not running".
+
+=head2 cmd
+
+All of the above methods can also be invoked using cmd; i.e.:
+
+ $ctl->start;
+
+is equivilent to:
+
+ $ctl->cmd( 'start' );
+
+give or take a call to AUTOLOAD!
+
+=head2 pid
+
+Returns the current value of the pid in the pidfile.
+
+=head2 running
+
+returns true if the pid in the pidfile is running.
+
+=head1 AUTHOR
+
+Ave Wrigley <Ave.Wrigley at itn.co.uk>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2001 Ave Wrigley. All rights reserved. This program is free
+software; you can redistribute it and/or modify it under the same terms as Perl
+itself.
+
+=cut
Added: branches/upstream/libapp-control-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libapp-control-perl/current/MANIFEST?rev=11023&op=file
==============================================================================
--- branches/upstream/libapp-control-perl/current/MANIFEST (added)
+++ branches/upstream/libapp-control-perl/current/MANIFEST Sat Dec 8 13:51:25 2007
@@ -1,0 +1,7 @@
+Changes
+Control.pm
+MANIFEST
+Makefile.PL
+README
+sample/test.pl
+test.pl
Added: branches/upstream/libapp-control-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libapp-control-perl/current/Makefile.PL?rev=11023&op=file
==============================================================================
--- branches/upstream/libapp-control-perl/current/Makefile.PL (added)
+++ branches/upstream/libapp-control-perl/current/Makefile.PL Sat Dec 8 13:51:25 2007
@@ -1,0 +1,8 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'App::Control',
+ 'VERSION_FROM' => 'Control.pm', # finds $VERSION
+ 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1
+);
Added: branches/upstream/libapp-control-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libapp-control-perl/current/README?rev=11023&op=file
==============================================================================
--- branches/upstream/libapp-control-perl/current/README (added)
+++ branches/upstream/libapp-control-perl/current/README Sat Dec 8 13:51:25 2007
@@ -1,0 +1,35 @@
+App::Control
+============
+
+Description
+-----------
+
+App::Control is a simple module to replicate the kind of
+functionality you get with apachectl to control apache, but
+for any script or executable. There is a very simple OO
+interface, where the constructor is used to specify the
+executable, command line arguments, and pidfile, and various
+methods (start, stop, etc.) are used to control the
+executable in the obvious way.
+
+Installation
+------------
+
+The usual ...
+
+> perl Makefile.PL
+> make
+[ > make test ]
+> make install
+
+Copyright
+---------
+
+Copyright (c) 2001 Ave Wrigley. All rights reserved. This program is free
+software; you can redistribute it and/or modify it under the same terms as Perl
+itself.
+
+Author
+------
+
+Ave Wrigley <Ave.Wrigley at itn.co.uk>
Added: branches/upstream/libapp-control-perl/current/sample/test.pl
URL: http://svn.debian.org/wsvn/branches/upstream/libapp-control-perl/current/sample/test.pl?rev=11023&op=file
==============================================================================
--- branches/upstream/libapp-control-perl/current/sample/test.pl (added)
+++ branches/upstream/libapp-control-perl/current/sample/test.pl Sat Dec 8 13:51:25 2007
@@ -1,0 +1,13 @@
+#!/usr/bin/perl
+
+use sigtrap qw( handler hangup HUP );
+
+sub hangup { warn "got HUP\n" }
+my $pidfile = shift;
+open( PID, ">$pidfile" ) or die "Can't create pidfile $pidfile\n";
+print PID "$$\n";
+close PID;
+while( 1 )
+{
+ sleep( 1 );
+}
Propchange: branches/upstream/libapp-control-perl/current/sample/test.pl
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libapp-control-perl/current/test.pl
URL: http://svn.debian.org/wsvn/branches/upstream/libapp-control-perl/current/test.pl?rev=11023&op=file
==============================================================================
--- branches/upstream/libapp-control-perl/current/test.pl (added)
+++ branches/upstream/libapp-control-perl/current/test.pl Sat Dec 8 13:51:25 2007
@@ -1,0 +1,78 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..2\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use App::Control;
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+
+eval {
+ warn "Creating new App::Control object\n";
+ my $exec = 'sample/test.pl';
+ my $pidfile = 'pids/test.pid';
+ my $ctl = App::Control->new(
+ EXEC => $exec,
+ ARGS => [ $pidfile ],
+ PIDFILE => $pidfile,
+ VERBOSE => 1,
+ ) or die "failed to create new App::Control object\n";
+ die $ctl->pid, "running\n" if $ctl->running;
+ warn "test start ...\n";
+ $ctl->start;
+ die "Not running\n" unless $ctl->running;
+ warn "test status ...\n";
+ warn $ctl->status;
+ warn "test stop ...\n";
+ $ctl->stop;
+ die "Still running\n" if $ctl->running;
+ warn "test restart after stop ...\n";
+ $ctl->restart;
+ die "Not running\n" unless $ctl->running;
+ warn "test restart after start ...\n";
+ $ctl->stop;
+ $ctl->start;
+ $ctl->restart;
+ die "Not running\n" unless $ctl->running;
+ warn "cleaning up ...\n";
+ $ctl->stop;
+ die "Still running\n" if $ctl->running;
+ unlink( $pidfile ) or die "Can't remove pidfile $pidfile\n";
+ my $ignore_file = 'ignore.tmp';
+ die "can't create $ignore_file\n" unless open( FH, ">$ignore_file" );
+ close( FH );
+ my $ctl = App::Control->new(
+ IGNOREFILE => 'ignore.tmp',
+ EXEC => $exec,
+ ARGS => [ $pidfile ],
+ PIDFILE => $pidfile,
+ VERBOSE => 1,
+ ) or die "failed to create new App::Control object\n";
+ warn "test ignore ...\n";
+ $ctl->start;
+ die $ctl->pid, "running\n" if $ctl->running;
+ unlink( $ignore_file );
+ $ctl->start;
+ die $ctl->pid, " not running\n" unless $ctl->running;
+ $ctl->hup;
+ die $ctl->pid, " not running\n" unless $ctl->running;
+ $ctl->stop;
+ die "Still running\n" if $ctl->running;
+};
+if ( $@ )
+{
+ warn $@;
+ print "not ";
+}
+print "ok 2\n";
More information about the Pkg-perl-cvs-commits
mailing list