Acme-Ghost
view release on metacpan or search on metacpan
eg/ghost_acme.pl view on Meta::CPAN
package MyGhost;
use parent 'Acme::Ghost';
sub init {
my $self = shift;
$SIG{HUP} = sub { $self->hangup }; # Listen USR2 (reload)
}
sub hangup {
my $self = shift;
$self->log->debug("Hang up!");
}
sub startup {
my $self = shift;
my $max = 100;
my $i = 0;
while ($self->ok) {
$i++;
sleep 3;
$self->log->debug(sprintf("> %d/%d", $i, $max));
last if $i >= $max;
}
}
1;
__END__
eg/ghost_ae.pl view on Meta::CPAN
my $watcher = AnyEvent->timer (after => 1, interval => 1, cb => sub {
$quit->send unless $self->ok;
});
# Create process timer
my $timer = AnyEvent->timer(after => 3, interval => 3, cb => sub {
$self->log->info("Tick! " . ++$i);
$quit->send if $i >= 10;
});
$self->log->debug("Start AnyEvent");
$quit->recv; # Run!
$self->log->debug("Finish AnyEvent");
}
1;
__END__
eg/ghost_ioloop.pl view on Meta::CPAN
my $l = shift; # loop
$self->log->info("Timer!");
});
my $recur = $loop->recurring(1 => sub {
my $l = shift; # loop
$l->stop unless $self->ok;
$self->log->info("Tick! " . ++$i);
$l->stop if $i >= 10;
});
$self->log->debug("Start IOLoop");
# Start event loop if necessary
$loop->start unless $loop->is_running;
$self->log->debug("Finish IOLoop");
}
1;
__END__
eg/ghost_nobody.pl view on Meta::CPAN
use parent 'Acme::Ghost';
sub startup {
my $self = shift;
my $max = 100;
my $i = 0;
while ($self->ok) {
$i++;
sleep 3;
$self->log->debug(sprintf("> %d/%d", $i, $max));
last if $i >= $max;
}
}
1;
__END__
sudo ACME_GHOST_DEBUG=1 perl -Ilib eg/ghost_nobody.pl start
eg/ghost_simple.pl view on Meta::CPAN
}
# Daemonize
$g->daemonize;
my $max = 10;
my $i = 0;
while (1) {
$i++;
sleep 3;
$g->log->debug(sprintf("> %d/%d", $i, $max));
last if $i >= $max;
}
exit 0;
__END__
eg/prefork_acme.pl view on Meta::CPAN
use parent 'Acme::Ghost::Prefork';
use Data::Dumper qw/Dumper/;
sub init {
my $self = shift;
$SIG{HUP} = sub { $self->hangup };
}
sub hangup {
my $self = shift;
$self->log->debug(Dumper($self->{pool}));
}
sub spirit {
my $self = shift;
my $max = 10;
my $i = 0;
while ($self->tick) {
$i++;
sleep 1;
$self->log->debug(sprintf("$$> %d/%d", $i, $max));
last if $i >= $max;
}
}
1;
__END__
perl -Ilib eg/prefork_acme.pl start
eg/prefork_ioloop.pl view on Meta::CPAN
# Add a timers
my $timer = $loop->timer(5 => sub {
my $l = shift; # loop
$self->log->info("Timer!");
});
my $recur = $loop->recurring(1 => sub {
my $l = shift; # loop
$l->stop unless $self->tick;
$self->log->debug(sprintf("$$> %d/%d", ++$i, $max));
$l->stop if $i >= $max;
});
$self->log->debug("Start IOLoop");
# Start event loop if necessary
$loop->start unless $loop->is_running;
$self->log->debug("Finish IOLoop");
}
1;
__END__
perl -Ilib eg/prefork_ioloop.pl start
lib/Acme/Ghost.pm view on Meta::CPAN
my $g = Acme::Ghost->new(
name => 'myDaemon',
user => 'nobody',
group => 'nogroup',
pidfile => '/var/run/myDaemon.pid',
logfile => '/var/log/myDaemon.log',
ident => 'myDaemon',
logopt => 'ndelay,pid',
facility => 'user',
logger => Mojo::Log->new,
loglevel => 'debug',
loghandle => IO::Handler->new,
);
=head1 ATTRIBUTES
This class implements the following attributes
=head2 facility
facility => 'user',
lib/Acme/Ghost.pm view on Meta::CPAN
If you set this attribute, the specified logger will be used as the preferred logger
=head2 loghandle
Log filehandle, defaults to opening "file" or uses syslog if file not specified
See L<Acme::Ghost::Log/handle>
=head2 loglevel
loglevel => 'debug',
This attribute sets the log level
See L<Acme::Ghost::Log/level>
=head2 logopt
logopt => 'ndelay,pid',
This attribute contains zero or more of the options
lib/Acme/Ghost.pm view on Meta::CPAN
For example (on Your inherit subclass):
sub init {
my $self = shift;
# Listen USR2 (reload)
$SIG{HUP} = sub { $self->hangup };
}
sub hangup {
my $self = shift;
$self->log->debug(">> Hang up!");
}
=head1 EXAMPLES
=over 4
=item ghost_simple.pl
This is traditional way to start daemons
lib/Acme/Ghost.pm view on Meta::CPAN
}
# Daemonize
$g->daemonize;
my $max = 10;
my $i = 0;
while (1) {
$i++;
sleep 3;
$g->log->debug(sprintf("> %d/%d", $i, $max));
last if $i >= $max;
}
=item ghost_acme.pl
Simple acme example of daemon with reloading demonstration
my $g = MyGhost->new(
logfile => 'daemon.log',
pidfile => 'daemon.pid',
lib/Acme/Ghost.pm view on Meta::CPAN
package MyGhost;
use parent 'Acme::Ghost';
sub init {
my $self = shift;
$SIG{HUP} = sub { $self->hangup }; # Listen USR2 (reload)
}
sub hangup {
my $self = shift;
$self->log->debug("Hang up!");
}
sub startup {
my $self = shift;
my $max = 100;
my $i = 0;
while ($self->ok) {
$i++;
sleep 3;
$self->log->debug(sprintf("> %d/%d", $i, $max));
last if $i >= $max;
}
}
1;
=item ghost_ioloop.pl
L<Mojo::IOLoop> example
lib/Acme/Ghost.pm view on Meta::CPAN
my $l = shift; # loop
$self->log->info("Timer!");
});
my $recur = $loop->recurring(1 => sub {
my $l = shift; # loop
$l->stop unless $self->ok;
$self->log->info("Tick! " . ++$i);
$l->stop if $i >= 10;
});
$self->log->debug("Start IOLoop");
# Start event loop if necessary
$loop->start unless $loop->is_running;
$self->log->debug("Finish IOLoop");
}
1;
=item ghost_ae.pl
AnyEvent example
my $g = MyGhost->new(
logfile => 'daemon.log',
lib/Acme/Ghost.pm view on Meta::CPAN
my $watcher = AnyEvent->timer (after => 1, interval => 1, cb => sub {
$quit->send unless $self->ok;
});
# Create process timer
my $timer = AnyEvent->timer(after => 3, interval => 3, cb => sub {
$self->log->info("Tick! " . ++$i);
$quit->send if $i >= 10;
});
$self->log->debug("Start AnyEvent");
$quit->recv; # Run!
$self->log->debug("Finish AnyEvent");
}
1;
=item ghost_nobody.pl
This example shows how to start daemons over nobody user and logging to syslog (default)
my $g = MyGhost->new(
pidfile => '/tmp/daemon.pid',
lib/Acme/Ghost.pm view on Meta::CPAN
use parent 'Acme::Ghost';
sub startup {
my $self = shift;
my $max = 100;
my $i = 0;
while ($self->ok) {
$i++;
sleep 3;
$self->log->debug(sprintf("> %d/%d", $i, $max));
last if $i >= $max;
}
}
1;
=back
=head1 DEBUGGING
lib/Acme/Ghost.pm view on Meta::CPAN
die "Already running $runned\n";
}
# Store current PID to instance as Parent PID
$self->{ppid} = $$;
# Get UID & GID
my $uid = $self->{uid}; # UID
my $gids = $self->{gid}; # returns list of groups (gids)
my $gid = (split /[\s,]+/, $gids)[0]; # First GID
_debug("!! UID=%s; GID=%s; GIDs=\"%s\"", $uid, $gid, $gids);
# Pre Init Hook
$self->preinit;
$self->{_log} = undef; # Close log handlers before spawn
# Spawn
my $pid = _fork();
if ($pid) {
_debug("!! Spawned (PID=%s)", $pid);
if ($safe) { # For internal use only
$self->{pid} = $pid; # Store child PID to instance
return $self;
}
exit 0; # exit parent process
}
# Child
$self->{daemonized} = 1; # Set daemonized flag
$self->filepid->pid($$)->save; # Set new PID and Write PID file
lib/Acme/Ghost.pm view on Meta::CPAN
# LSB Daemon Control Methods
# These methods can be used to control the daemon behavior.
# Every effort has been made to have these methods DWIM (Do What I Mean),
# so that you can focus on just writing the code for your daemon
sub _term {
my $self = shift;
my $signo = shift || 0;
$self->{ok} = 0; # Not Ok!
$self->{signo} = $signo;
$self->log->debug(sprintf("Request for terminate of ghost process %s received on signal %s", $self->pid, $signo));
if ($self->{interrupt} >= INT_TRIES) { # Forced terminate
POSIX::_exit(1) if $self->is_spirited;
$self->cleanup(1);
$self->log->fatal(sprintf("Ghost process %s forcefully terminated on signal %s", $self->pid, $signo));
$self->filepid->remove;
POSIX::_exit(1);
}
$self->{interrupt}++;
}
sub start {
lib/Acme/Ghost.pm view on Meta::CPAN
}
if ( $loop < 6 && ( $! == POSIX::EAGAIN() || $! == POSIX::ENOMEM() ) ) {
$loop++;
_sleep(2);
redo MYFORK;
}
}
die "Can't fork: $!\n";
}
sub _debug {
return unless DEBUG;
my $message = (scalar(@_) == 1) ? shift(@_) : sprintf(shift(@_), @_);
print STDERR $message, "\n";
}
1;
__END__
lib/Acme/Ghost/Log.pm view on Meta::CPAN
# Using file
my $log = Acme::Ghost::Log->new(file => '/tmp/test.log');
$log->error("My test error message to /tmp/test.log")
# Customize minimum log level
my $log = Acme::Ghost::Log->new(level => 'warn');
# Log messages
$log->trace('Doing stuff');
$log->debug('Not sure what is happening here');
$log->info('FYI: it happened again');
$log->warn('This might be a problem');
$log->error('Garden variety error');
$log->fatal('Boom');
=head1 DESCRIPTION
Acme::Ghost::Log is a simple logger for Acme::Ghost logging after daemonization
=head2 new
my $log = Acme::Ghost::Log->new(
logopt => 'ndelay,pid',
facility => 'user',
level => 'debug',
ident => 'test.pl',
);
With default attributes
use Mojo::Log;
my $log = Acme::Ghost::Log->new( logger => Mojo::Log->new );
$log->error("Test error message");
This is example with external loggers
lib/Acme/Ghost/Log.pm view on Meta::CPAN
Log filehandle, defaults to opening "file" or uses syslog if file not specified
=head2 ident
The B<ident> is prepended to every message
Default: script name C<basename($0)>
=head2 level
There are six predefined log levels: C<fatal>, C<error>, C<warn>, C<info>, C<debug>, and C<trace> (in descending priority).
The syslog supports followed additional log levels: C<emerg>, C<alert>, C<crit'> and C<notice> (in descending priority).
But we recommend not using them to maintain compatibility.
Your configured logging level has to at least match the priority of the logging message.
If your configured logging level is C<warn>, then messages logged with info(), debug(), and trace()
will be suppressed; fatal(), error() and warn() will make their way through, because their
priority is higher or equal than the configured setting.
Default: C<debug>
See also L<Sys::Syslog/Levels>
=head2 logger
This attribute perfoms to set predefined logger, eg. Mojo::Log
Default: C<undef>
=head2 logopt
lib/Acme/Ghost/Log.pm view on Meta::CPAN
Log C<alert> message
=head2 crit
$log->crit('Its over...');
$log->crit('Bye', 'bye');
Log C<crit> message (See L</fatal> method)
=head2 debug
$log->debug('You screwed up, but that is ok');
$log->debug('All', 'cool');
Log C<debug> message
=head2 emerg
$log->emerg('System is unusable');
$log->emerg('To', 'die');
Log C<emerg> message
=head2 error
lib/Acme/Ghost/Log.pm view on Meta::CPAN
=head2 info
$log->info('You are bad, but you prolly know already');
$log->info('Ok', 'then');
Log C<info> message
=head2 level
my $level = $log->level;
$log = $log->level('debug');
Active log level, defaults to debug.
Available log levels are C<trace>, C<debug>, C<info>, C<notice>, C<warn>, C<error>,
C<fatal> (C<crit>), C<alert> and C<emerg>, in that order
=head2 logger
my $logger = $log->logger;
This method returns the logger object or undef if not exists
=head2 notice
lib/Acme/Ghost/Log.pm view on Meta::CPAN
use Fcntl qw/:flock/;
use Encode qw/find_encoding/;
use Time::HiRes qw/time/;
use constant {
LOGOPTS => 'ndelay,pid', # For Sys::Syslog
SEPARATOR => ' ',
LOGFORMAT => '%s',
};
my %LOGLEVELS = (
'trace' => Sys::Syslog::LOG_DEBUG, # 7 debug-level message
'debug' => Sys::Syslog::LOG_DEBUG, # 7 debug-level message
'info' => Sys::Syslog::LOG_INFO, # 6 informational message
'notice' => Sys::Syslog::LOG_NOTICE, # 5 normal, but significant, condition
'warn' => Sys::Syslog::LOG_WARNING, # 4 warning conditions
'error' => Sys::Syslog::LOG_ERR, # 3 error conditions
'fatal' => Sys::Syslog::LOG_CRIT, # 2 critical conditions
'crit' => Sys::Syslog::LOG_CRIT, # 2 critical conditions
'alert' => Sys::Syslog::LOG_ALERT, # 1 action must be taken immediately
'emerg' => Sys::Syslog::LOG_EMERG, # 0 system is unusable
);
my %MAGIC = (
'trace' => 8,
'debug' => 7,
'info' => 6,
'notice' => 5,
'warn' => 4,
'error' => 3,
'fatal' => 2, 'crit' => 2,
'alert' => 1,
'emerg' => 0,
);
my %SHORT = ( # Log::Log4perl::Level notation
0 => 'fatal', 1 => 'fatal', 2 => 'fatal',
3 => 'error',
4 => 'warn',
5 => 'info', 6 => 'info',
7 => 'debug',
8 => 'trace',
);
my $ENCODING = find_encoding('UTF-8') or croak qq/Encoding "UTF-8" not found/;
sub new {
my $class = shift;
my $args = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {};
$args->{facility} ||= Sys::Syslog::LOG_USER;
$args->{ident} ||= basename($0);
$args->{logopt} ||= LOGOPTS;
$args->{logger} ||= undef;
$args->{level} ||= 'debug';
$args->{file} ||= undef;
$args->{handle} ||= undef;
$args->{provider} = 'unknown';
# Check level
croak "Incorrect log level specified" unless exists $MAGIC{$args->{level}};
# Instance
my $self = bless {%$args}, $class;
lib/Acme/Ghost/Log.pm view on Meta::CPAN
$self->{level} = shift;
return $self;
}
return $self->{level};
}
sub logger { shift->{logger} }
sub handle { shift->{handle} }
sub provider { shift->{provider} }
sub trace { shift->_log('trace', @_) }
sub debug { shift->_log('debug', @_) }
sub info { shift->_log('info', @_) }
sub notice { shift->_log('notice', @_) }
sub warn { shift->_log('warn', @_) }
sub error { shift->_log('error', @_) }
sub fatal { shift->_log('fatal', @_) }
sub crit { shift->_log('crit', @_) }
sub alert { shift->_log('alert', @_) }
sub emerg { shift->_log('emerg', @_) }
sub _log {
lib/Acme/Ghost/Prefork.pm view on Meta::CPAN
my $g = Acme::Ghost::Prefork->new(
logfile => '/tmp/daemon.log',
pidfile => '/tmp/daemon.pid',
spirit => sub {
my $self = shift;
my $max = 10;
my $i = 0;
while ($self->tick) {
$i++;
sleep 1;
$self->log->debug(sprintf("$$> %d/%d", $i, $max));
last if $i >= $max;
}
},
);
exit $g->ctrl(shift(@ARGV) // '');
=head1 DESCRIPTION
Pre-forking ghost daemon (server)
lib/Acme/Ghost/Prefork.pm view on Meta::CPAN
my $self = shift;
my $graceful = shift;
# . . .
}
Is called when the server shuts down
sub finish {
my $self = shift;
my $graceful = shift;
$self->log->debug($graceful ? 'Graceful server shutdown' : 'Server shutdown');
}
=head2 heartbeat
sub heartbeat {
my $self = shift;
my $pid = shift;
# . . .
}
Is called when a heartbeat message has been received from a spirit
sub heartbeat {
my $self = shift;
my $pid = shift;
$self->log->debug("Spirit $pid has a heartbeat");
}
=head2 reap
sub reap {
my $self = shift;
my $pid = shift;
# . . .
}
Is called when a child process (spirit) finished
sub reap {
my $self = shift;
my $pid = shift;
$self->log->debug("Spirit $pid stopped");
}
=head2 spawn
sub spawn {
my $self = shift;
my $pid = shift;
# . . .
}
Is called when a spirit process is spawned
sub spawn {
my $self = shift;
my $pid = shift;
$self->log->debug("Spirit $pid started");
}
=head2 waitup
sub waitup {
my $self = shift;
# . . .
}
Is called when the manager starts waiting for new heartbeat messages
sub waitup {
my $self = shift;
my $spirits = $prefork->{spirits};
$self->log->debug("Waiting for heartbeat messages from $spirits spirits");
}
=head2 spirit
B<The spirit body>
This hook is called when the spirit process has started and is ready to run in isolation.
This is main hook that MUST BE implement to in user subclass
sub spirit {
lib/Acme/Ghost/Prefork.pm view on Meta::CPAN
use parent 'Acme::Ghost::Prefork';
use Data::Dumper qw/Dumper/;
sub init {
my $self = shift;
$SIG{HUP} = sub { $self->hangup };
}
sub hangup {
my $self = shift;
$self->log->debug(Dumper($self->{pool}));
}
sub spirit {
my $self = shift;
my $max = 10;
my $i = 0;
while ($self->tick) {
$i++;
sleep 1;
$self->log->debug(sprintf("$$> %d/%d", $i, $max));
last if $i >= $max;
}
}
1;
=item prefork_ioloop.pl
L<Mojo::IOLoop> example
lib/Acme/Ghost/Prefork.pm view on Meta::CPAN
# Add a timers
my $timer = $loop->timer(5 => sub {
my $l = shift; # loop
$self->log->info("Timer!");
});
my $recur = $loop->recurring(1 => sub {
my $l = shift; # loop
$l->stop unless $self->tick;
$self->log->debug(sprintf("$$> %d/%d", ++$i, $max));
$l->stop if $i >= $max;
});
$self->log->debug("Start IOLoop");
# Start event loop if necessary
$loop->start unless $loop->is_running;
$self->log->debug("Finish IOLoop");
}
1;
=back
=head1 TO DO
See C<TODO> file
lib/Acme/Ghost/Prefork.pm view on Meta::CPAN
my $cb = $self->{spirit_cb};
return unless $cb;
return $self->$cb if ref($cb) eq 'CODE';
$self->log->error("Callback `spirit` is incorrect");
$self->tick(1);
}
# Internal methods
sub _increase { # Manager level
my $self = shift;
$self->log->debug(sprintf("> Increase spirit pool by one")) if DEBUG;
$self->{spirits} = $self->{spirits} + 1;
}
sub _decrease { # Manager level
my $self = shift;
$self->log->debug(sprintf("> Decrease spirit pool by one")) if DEBUG;
return unless $self->{spirits} > 0;
$self->{spirits} = $self->{spirits} - 1;
# Set graceful time for first found unfinished pid (spirit)
for my $w (values %{$self->{pool}}) {
unless ($w->{graceful}) {
$w->{graceful} = Time::HiRes::time;
last;
}
}
}
sub _stop { # Manager level
my ($self, $graceful) = @_;
$self->log->debug(sprintf("> Received stop signal/command: %s",
$graceful ? 'graceful shutdown' : 'forced shutdown')) if DEBUG;
$self->finish($graceful);
$self->{finished} = 1;
$self->{gracefully_stop} = $graceful ? 1 : 0;
}
sub _stopped { # Manager level (Calls when a child process exited)
my $self = shift;
my $pid = shift;
$self->log->debug(sprintf("> Reap %s", $pid)) if DEBUG;
$self->reap($pid);
return unless my $w = delete $self->{pool}{$pid};
$self->log->info("Spirit $pid stopped");
unless ($w->{healthy}) {
$self->log->error("Spirit $pid stopped too early, shutting down");
$self->_stop;
}
}
sub _manage { # Manager level
lib/Acme/Ghost/Prefork.pm view on Meta::CPAN
# Spawn more spirits if necessary
if (!$self->{finished}) { # No finished
my $graceful = grep { $_->{graceful} } values %{$self->{pool}}; # Number gracefuled spirits
my $spare = $self->{spare};
$spare = $graceful # Check gracefuls
? $graceful > $spare # Check difference between graceful numbers and spare numbers
? $spare # graceful numbers greater than spare numbers - use original spare value
: $graceful # graceful numbers less or equal to spare numbers - set spare to graceful
: 0; # No gracefuls - no spares - set spare to 0 ('spare = 0')
my $required = ($self->{spirits} - keys %{$self->{pool}}) + $spare; # How many spirits are required?
$self->log->debug(sprintf("> graceful=%d; spare=%d; need=%d", $graceful, $spare, $required))
if DEBUG && $required;
$self->_spawn while $required-- > 0; # Spawn required spirits
} elsif (!keys %{$self->{pool}}) { # No PIDs found, shutdown!
return delete $self->{running}; # Return from the manager and exit immediately
}
# Wait for heartbeats
$self->_wait;
# Stops
t/02-daemon.t view on Meta::CPAN
# Copyright (C) 1998-2023 D&D Corporation. All Rights Reserved
#
# This is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
#########################################################################
use strict;
use Test::More;
use Acme::Ghost;
# Set debug mode
$ENV{ACME_GHOST_DEBUG} //= 0;
my $g = Acme::Ghost->new(
logfile => 'daemon.log',
pidfile => 'daemon.pid',
);
#note explain $ghost;
ok !$g->is_daemonized, "Is not daemonized";
is $g->pid, 0, "No PID in ghost process";
# This is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
#########################################################################
use strict;
use utf8;
use Test::More;
use_ok qw/Acme::Ghost::Log/;
# Error message with debug loglevel
{
my $log = Acme::Ghost::Log->new();
is $log->level, 'debug', "Debug LogLevel";
ok $log->error("My test error message"), 'Error message';
}
# Info and fatal message with eror loglevel
{
my $log = Acme::Ghost::Log->new(level => 'error');
is $log->level, 'error', "Error LogLevel";
ok !$log->info("My test info message"), 'Info message not allowed';
ok $log->fatal("My test fatal message"), 'Fatal message';
#note explain $log;
}
# Fake Logger
{
my $fake = FakeLogger->new;
my $log = Acme::Ghost::Log->new(logger => $fake);
$log->error("Test error message") and ok 1, "Test error message to STDOUT";
#ok $log->debug("Test debug message");
$log->info("Test info message") and ok 1, "Test info message to STDOUT";
#note explain $log;
}
# File
{
my $log = Acme::Ghost::Log->new(file => 'log.tmp');
$log->error("Test error message") and ok 1, "Test error message to file";
$log->warn("ТеÑтовое Ñообщение") and ok 1, "Test error message to file (RU)";
$log->info("Test info message") and ok 1, "Test info message to file";
( run in 1.218 second using v1.01-cache-2.11-cpan-49f99fa48dc )