Acme-Ghost
view release on metacpan or search on metacpan
INSTALL.md Installation instructions
LICENSE License file
Makefile.PL Makefile builder
MANIFEST This file
README.md !!! README FIRST !!!
TODO TO DO
# Libs
lib/Acme/Ghost.pm Main library
lib/Acme/Ghost/FilePid.pm FilePid interface
lib/Acme/Ghost/Log.pm Daemon logger
lib/Acme/Ghost/Prefork.pm Preforked daemon
# Tests
t/00-fixme.t FIXME/TODO/BUG warnings
t/00-pod-coverage.t POD::Coverage testing
t/00-pod.t Checking all POD documents
t/00-trailingspace.t Style test: TrailingSpace
t/01-use.t Test script
t/02-daemon.t Daemon
t/03-filepid.t FilePid interface
t/04-log.t Daemon logger
# Examples
eg/ghost_acme.pl
eg/ghost_ae.pl
eg/ghost_ioloop.pl
eg/ghost_nobody.pl
eg/ghost_simple.pl
eg/prefork_acme.pl
eg/prefork_ioloop.pl
META.yml Module YAML meta-data (added by MakeMaker)
"Test::More" : "0.94"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"Sys::Syslog" : "0",
"perl" : "5.020"
}
}
},
"release_status" : "stable",
"resources" : {
"homepage" : "https://sourceforge.net/projects/acme-ghost/",
"license" : [
"https://dev.perl.org/licenses"
],
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: Acme-Ghost
no_index:
directory:
- t
- inc
requires:
Sys::Syslog: '0'
perl: '5.020'
resources:
homepage: https://sourceforge.net/projects/acme-ghost/
license: https://dev.perl.org/licenses
repository: https://abalama@git.code.sf.net/p/acme-ghost/code
version: '1.01'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
Makefile.PL view on Meta::CPAN
die "Acme::Ghost is not supported on Microsoft Windows and Cygwin operating systems\n"
if $^O eq 'MSWin32' or $^O =~ /cygwin/i;
die "Acme::Ghost does not support fork emulation\n" if $Config{d_pseudofork};
my $build_requires = {
'ExtUtils::MakeMaker' => 6.60,
'Test::More' => 0.94,
};
my $prereq_pm = {
'Sys::Syslog' => 0,
};
WriteMakefile(
'NAME' => 'Acme::Ghost',
'MIN_PERL_VERSION' => 5.020001,
'VERSION_FROM' => 'lib/Acme/Ghost.pm',
'ABSTRACT_FROM' => 'lib/Acme/Ghost.pm',
'BUILD_REQUIRES' => $build_requires,
'PREREQ_PM' => $prereq_pm,
'AUTHOR' => 'Serz Minus (Sergey Lepenkov) <abalama@cpan.org>',
Makefile.PL view on Meta::CPAN
homepage => 'https://sourceforge.net/projects/acme-ghost/',
license => 'https://dev.perl.org/licenses',
repository => {
type => 'git',
url => 'https://abalama@git.code.sf.net/p/acme-ghost/code',
web => 'https://sourceforge.net/p/acme-ghost/code/ci/master/tree/',
},
},
},
clean => {
FILES => '*.pid *.tmp *.log',
},
);
1;
eg/ghost_acme.pl view on Meta::CPAN
#!/usr/bin/perl -w
use strict;
my $g = MyGhost->new(
logfile => 'daemon.log',
pidfile => 'daemon.pid',
);
exit $g->ctrl(shift(@ARGV) // 'start'); # start, stop, restart, reload, status
1;
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
#!/usr/bin/perl -w
use strict;
my $g = MyGhost->new(
logfile => 'daemon.log',
pidfile => 'daemon.pid',
);
exit $g->ctrl(shift(@ARGV) // 'start', 0); # start, stop, restart, reload, status
1;
package MyGhost;
use parent 'Acme::Ghost';
eg/ghost_ae.pl view on Meta::CPAN
my $quit = AnyEvent->condvar;
my $i = 0;
# Create watcher timer
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
#!/usr/bin/perl -w
use strict;
my $g = MyGhost->new(
logfile => 'daemon.log',
pidfile => 'daemon.pid',
);
exit $g->ctrl(shift(@ARGV) // 'start', 0); # start, stop, restart, reload, status
1;
package MyGhost;
use parent 'Acme::Ghost';
eg/ghost_ioloop.pl view on Meta::CPAN
$self->{loop} = Mojo::IOLoop->new;
}
sub startup {
my $self = shift;
my $loop = $self->{loop};
my $i = 0;
# 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->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
#!/usr/bin/perl -w
use strict;
use Acme::Ghost;
my $g = Acme::Ghost->new(
logfile => 'daemon.log',
pidfile => 'daemon.pid',
);
my $cmd = shift(@ARGV) // 'start';
if ($cmd eq 'status') {
if (my $runned = $g->status) {
print "Running $runned\n";
} else {
print "Not running\n";
}
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
#!/usr/bin/perl -w
use strict;
my $g = MyGhost->new(
logfile => 'daemon.log',
pidfile => 'daemon.pid',
);
exit $g->ctrl(shift(@ARGV) // 'start');
1;
package MyGhost;
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
#!/usr/bin/perl -w
use strict;
my $g = MyGhost->new(
logfile => 'daemon.log',
pidfile => 'daemon.pid',
);
exit $g->ctrl(shift(@ARGV) // 'start');
1;
package MyGhost;
use parent 'Acme::Ghost::Prefork';
use Mojo::IOLoop;
eg/prefork_ioloop.pl view on Meta::CPAN
}
sub spirit {
my $self = shift;
my $loop = $self->{loop};
my $max = 10;
my $i = 0;
# 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
=head1 NAME
Acme::Ghost - An yet another view to daemon processes
=head1 SYNOPSIS
use Acme::Ghost
my $g = Acme::Ghost->new(
logfile => '/tmp/daemon.log',
pidfile => '/tmp/daemon.pid',
user => 'nobody',
group => 'nogroup',
);
$g->daemonize;
$g->log->info('Oops! I am Your Ghost');
=head1 DESCRIPTION
An yet another view to daemon processes
=head2 new
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',
This attribute sets facility for logging
See L<Acme::Ghost::Log/facility>
=head2 group
group => 'nogroup',
group => 65534,
This attribute sets group/gid for spawned process
=head2 ident
ident => 'myDaemon',
This attribute sets ident string for system log (syslog)
=head2 logfile
logfile => '/var/log/myDaemon.log',
This attribute sets log file path. By default all log entries will be printed to syslog
See L<Acme::Ghost::Log/file>
=head2 logger
logger => Mojo::Log->new,
This attribute perfoms to set predefined logger, eg. Mojo::Log.
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
See L<Acme::Ghost::Log/logopt>
=head2 name
name => 'myDaemon',
This attribute sets name of daemon. Default: script name C<basename($0)>
=head2 pidfile
pidfile => '/var/run/myDaemon.pid',
lib/Acme/Ghost.pm view on Meta::CPAN
=head2 is_spirited
my $is_spirited = $g->is_spirited;
This method returns status of spirit:
True - the process is an spirit;
False - the process is not spirit;
=head2 log
my $log = $g->log;
This method returns L<Acme::Ghost::Log> object
=head2 ok
$g->ok or die "Interrupted!";
This method checks process state and returns boolean status of healthy.
If this status is false, then it is immediately to shut down Your process
as soon as possible, otherwise your process will be forcibly destroyed
lib/Acme/Ghost.pm view on Meta::CPAN
my $scope = shift; # 0 or 1
# . . .
}
The cleanup() method is called at before exit
This method passes one argument:
0 -- called at normal DESTROY;
1 -- called at interrupt
B<NOTE!> On DESTROY phase logging is unpossible.
We not recommended to use logging in this method
=head2 hangup
sub hangup {
my $self = shift;
# . . .
}
The hangup() method is called on HUP or USR2 signals
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
use Acme::Ghost;
my $g = Acme::Ghost->new(
logfile => 'daemon.log',
pidfile => 'daemon.pid',
);
my $cmd = shift(@ARGV) // 'start';
if ($cmd eq 'status') {
if (my $runned = $g->status) {
print "Running $runned\n";
} else {
print "Not running\n";
}
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',
);
exit $g->ctrl(shift(@ARGV) // 'start'); # start, stop, restart, reload, status
1;
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
my $g = MyGhost->new(
logfile => 'daemon.log',
pidfile => 'daemon.pid',
);
exit $g->ctrl(shift(@ARGV) // 'start', 0); # start, stop, restart, reload, status
1;
package MyGhost;
use parent 'Acme::Ghost';
lib/Acme/Ghost.pm view on Meta::CPAN
$self->{loop} = Mojo::IOLoop->new;
}
sub startup {
my $self = shift;
my $loop = $self->{loop};
my $i = 0;
# 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->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',
pidfile => 'daemon.pid',
);
exit $g->ctrl(shift(@ARGV) // 'start', 0); # start, stop, restart, reload, status
1;
package MyGhost;
use parent 'Acme::Ghost';
lib/Acme/Ghost.pm view on Meta::CPAN
my $quit = AnyEvent->condvar;
my $i = 0;
# Create watcher timer
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',
user => 'nobody',
group => 'nogroup',
);
exit $g->ctrl(shift(@ARGV) // 'start', 0); # start, stop, restart, status
1;
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
uid => $uid,
gid => $gid,
gids => $gids,
# PID
pidfile => $args->{pidfile} || File::Spec->catfile(getcwd(), sprintf("%s.pid", $name)),
_filepid => undef,
# Log
facility => $args->{facility},
logfile => $args->{logfile},
ident => $args->{ident} || $name,
logopt => $args->{logopt},
logger => $args->{logger},
loglevel => $args->{loglevel},
loghandle => $args->{loghandle},
_log => undef,
# Runtime
initpid => $$, # PID of root process
ppid => 0, # PID before daemonize
pid => 0, # PID daemonized process
daemonized => 0, # 0 - no daemonized; 1 - daemonized
spirited => 0, # 0 - is not spirit; 1 - is spirit (See ::Prefork)
# Manage
ok => 0, # 1 - Ok. Process is healthy (ok)
signo => 0, # The caught signal number
interrupt => 0, # The interrupt counter
}, $class;
return $self->again(%$args);
}
sub again { shift }
sub log {
my $self = shift;
return $self->{_log} //= Acme::Ghost::Log->new(
facility => $self->{facility},
ident => $self->{ident},
logopt => $self->{logopt},
logger => $self->{logger},
level => $self->{loglevel},
file => $self->{logfile},
handle => $self->{loghandle},
);
}
sub filepid {
my $self = shift;
return $self->{_filepid} //= Acme::Ghost::FilePid->new(
file => $self->{pidfile}
);
}
sub set_uid {
my $self = shift;
lib/Acme/Ghost.pm view on Meta::CPAN
$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
lib/Acme/Ghost.pm view on Meta::CPAN
chown($uid, $gid, $pid_file) if IS_ROOT && -e $pid_file;
# Set GID and UID
$self->set_gid->set_uid;
# Turn process into session leader, and ensure no controlling terminal
unless (DEBUG) {
die "Can't start a new session: $!" if POSIX::setsid() < 0;
}
# Init logger!
my $log = $self->log;
# Close all standart filehandles
unless (DEBUG) {
my $devnull = File::Spec->devnull;
open STDIN, '<', $devnull or die "Can't open STDIN from $devnull: $!\n";
open STDOUT, '>', $devnull or die "Can't open STDOUT to $devnull: $!\n";
open STDERR, '>&', STDOUT or die "Can't open STDERR to $devnull: $!\n";
}
# Chroot if root
if (IS_ROOT) {
my $rootdir = File::Spec->rootdir;
unless (chdir $rootdir) {
$log->fatal("Can't chdir to \"$rootdir\": $!");
die "Can't chdir to \"$rootdir\": $!\n";
}
}
# Clear the file creation mask
umask 0;
# Store current PID to instance
$self->{pid} = $$;
# Set a signal handler to make sure SIGINT's remove our pid_file
$SIG{TERM} = $SIG{INT} = sub {
POSIX::_exit(1) if $self->is_spirited;
$self->cleanup(1);
$log->fatal("Termination on INT/TERM signal");
$self->filepid->remove;
POSIX::_exit(1);
};
# Init Hook
$self->init;
return $self;
}
sub is_daemonized { shift->{daemonized} }
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 {
my $self = shift;
$self->daemonize(1); # First daemonize and switch to child process
return 0 unless $self->is_daemonized; # Exit from parent process
# Signals Trapping for interruption
local $SIG{INT} = sub { $self->_term(SIGINT) }; # 2
local $SIG{TERM} = sub { $self->_term(SIGTERM) }; # 15
local $SIG{QUIT} = sub { $self->_term(SIGQUIT) }; # 3
$self->flush; # Flush process counters
$self->log->info(sprintf("Ghost process %s started", $self->pid));
$self->startup(); # Master hook
$self->log->info(sprintf("Ghost process %s stopped", $self->pid));
exit 0; # Exit code for child: ok
}
sub stop {
my $self = shift;
my $pid = $self->filepid->running;
$self->{pid} = $pid;
return 0 unless $pid; # Not running
# Try SIGQUIT ... 2s ... SIGTERM ... 4s ... SIGINT ... 3s ... SIGKILL ... 3s ... UNDEAD!
my $tsig = 0;
lib/Acme/Ghost/Log.pm view on Meta::CPAN
package Acme::Ghost::Log;
use strict;
use utf8;
=encoding utf-8
=head1 NAME
Acme::Ghost::Log - Simple logger
=head1 SYNOPSIS
use Acme::Ghost::Log;
my $log = Acme::Ghost::Log->new();
$log->error("My test error message to syslog")
# 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
=head1 ATTRIBUTES
This class implements the following attributes
=head2 facility
This attribute sets facility for logging
Available standard facilities: C<auth>, C<authpriv>, C<cron>, C<daemon>, C<ftp>,
C<kern>, C<local0>, C<local1>, C<local2>, C<local3>, C<local4>, C<local5>, C<local6>,
C<local7>, C<lpr>, C<mail>, C<news>, C<syslog>, C<user> and C<uucp>
Default: C<user> (Sys::Syslog::LOG_USER)
See also L<Sys::Syslog/Facilities>
=head2 file
Log file path used by "handle"
=head2 handle
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
This attribute contains zero or more of the options detailed in L<Sys::Syslog/openlog>
Default: C<'ndelay,pid'>
=head1 METHODS
This class implements the following methods
=head2 alert
$log->alert('Action must be taken immediately');
$log->alert('Real', 'problem');
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
$log->error('You really screwed up this time');
$log->error('Wow', 'seriously');
Log C<error> message
=head2 fatal
$log->fatal('Its over...');
$log->fatal('Bye', 'bye');
Log C<fatal> message
=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
$log->notice('Normal, but significant, condition...');
$log->notice('Ok', 'then');
Log C<notice> message
=head2 provider
print $log->provider;
Returns provider name (C<external>, C<handle>, C<file> or C<syslog>)
=head2 trace
$log->trace('Whatever');
$log->trace('Who', 'cares');
Log C<trace> message
=head2 warn
$log->warn('Dont do that Dave...');
$log->warn('No', 'really');
Log C<warn> message
=head1 HISTORY
See C<Changes> file
=head1 TO DO
See C<TODO> file
=head1 SEE ALSO
L<Sys::Syslog>
=head1 AUTHOR
Serż Minus (Sergey Lepenkov) L<https://www.serzik.com> E<lt>abalama@cpan.orgE<gt>
=head1 COPYRIGHT
Copyright (C) 1998-2023 D&D Corporation. All Rights Reserved
=head1 LICENSE
lib/Acme/Ghost/Log.pm view on Meta::CPAN
modify it under the same terms as Perl itself.
See C<LICENSE> file and L<https://dev.perl.org/licenses/>
=cut
our $VERSION = '1.00';
use Carp qw/carp croak/;
use Scalar::Util qw/blessed/;
use Sys::Syslog qw//;
use File::Basename qw/basename/;
use IO::File qw//;
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,
lib/Acme/Ghost/Log.pm view on Meta::CPAN
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;
# Open sys log socket
if ($args->{logger}) {
croak "Blessed reference expected in logger attribute" unless blessed($args->{logger});
$self->{provider} = "external";
} elsif ($args->{handle}) {
$self->{provider} = "handle";
return $self;
} elsif ($args->{file}) {
my $file = $args->{file};
$self->{handle} = IO::File->new($file, ">>");
croak qq/Can't open file "$file": $!/ unless defined $self->{handle};
$self->{provider} = "file";
} else {
Sys::Syslog::openlog($args->{ident}, $args->{logopt}, $args->{facility});
$self->{provider} = "syslog";
}
return $self;
}
sub level {
my $self = shift;
if (scalar(@_) >= 1) {
$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 {
my ($self, $level, @msg) = @_;
my $req = $MAGIC{$self->level};
my $mag = $MAGIC{$level} // 7;
return 0 unless $mag <= $req;
# Logger
if (my $logger = $self->logger) {
my $name = $SHORT{$mag};
if (my $code = $logger->can($name)) {
return $logger->$code(@msg);
} else {
carp(sprintf("Can't found '%s' method in '%s' package", $name, ref($logger)));
}
return 0;
}
# Handle
if (my $handle = $self->handle) {
flock $handle, LOCK_EX;
my $tm = time;
my ($s, $m, $h, $day, $month, $year) = localtime $tm;
my $time = sprintf '%04d-%02d-%02d %02d:%02d:%08.5f', $year + 1900, $month + 1, $day, $h, $m,
"$s." . ((split /\./, $tm)[1] // 0);
$handle->print($ENCODING->encode("[$time] [$$] [$level] " . join(SEPARATOR, @msg) . "\n", 0))
or croak "Can't write to log: $!";
flock $handle, LOCK_UN;
return 1;
}
return 0 if $self->provider ne "syslog";
my $lvl = $LOGLEVELS{$level} // Sys::Syslog::LOG_DEBUG;
Sys::Syslog::syslog($lvl, LOGFORMAT, join(SEPARATOR, @msg));
}
DESTROY {
my $self = shift;
undef $self->{handle} if $self->{file};
Sys::Syslog::closelog() unless $self->logger;
}
1;
__END__
lib/Acme/Ghost/Prefork.pm view on Meta::CPAN
=head1 NAME
Acme::Ghost::Prefork - Pre-forking ghost daemon
=head1 SYNOPSIS
use Acme::Ghost::Prefork;
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
=head1 EXAMPLES
=over 4
=item prefork_acme.pl
Prefork acme example of daemon with reloading demonstration
my $g = MyGhost->new(
logfile => 'daemon.log',
pidfile => 'daemon.pid',
);
exit $g->ctrl(shift(@ARGV) // 'start');
1;
package MyGhost;
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
my $g = MyGhost->new(
logfile => 'daemon.log',
pidfile => 'daemon.pid',
);
exit $g->ctrl(shift(@ARGV) // 'start');
1;
package MyGhost;
use parent 'Acme::Ghost::Prefork';
use Mojo::IOLoop;
lib/Acme/Ghost/Prefork.pm view on Meta::CPAN
}
sub spirit {
my $self = shift;
my $loop = $self->{loop};
my $max = 10;
my $i = 0;
# 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
pipe($self->{reader}, $self->{writer}) or croak("Can't create pipe: $!\n");
# Set manager signals
local $SIG{INT} = local $SIG{TERM} = sub { $self->_stop };
local $SIG{QUIT} = sub { $self->_stop(1) };
local $SIG{CHLD} = sub { while ((my $pid = waitpid -1, WNOHANG) > 0) { $self->_stopped($pid) } };
local $SIG{TTIN} = sub { $self->_increase };
local $SIG{TTOU} = sub { $self->_decrease };
# Starting
$self->log->info("Manager $$ started");
$self->{running} = 1;
$self->_manage while $self->{running};
$self->log->info("Manager $$ stopped");
}
sub healthy {
return scalar grep { $_->{healthy} } values %{shift->{pool}};
}
sub tick { # Spirit level
my $self = shift;
my $finished = shift || 0; # 0 - no finished; 1 - finished
$self->_heartbeat($finished);
return $self->ok;
}
lib/Acme/Ghost/Prefork.pm view on Meta::CPAN
sub finish { } # Emitted when the server shuts down
sub heartbeat { } # Emitted when a heartbeat message has been received from a spirit
sub reap { } # Emitted when a child process exited
sub spawn { } # Emitted when a spirit process is spawned
sub waitup { } # Emitted when the manager starts waiting for new heartbeat messages
sub spirit {
my $self = shift;
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
my $self = shift;
# 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
my $interval = $self->{heartbeat_interval};
my $hb_to = $self->{heartbeat_timeout};
my $gf_to = $self->{graceful_timeout};
my $now = Time::HiRes::time;
my $log = $self->log;
for my $pid (keys %{$self->{pool}}) {
next unless my $w = $self->{pool}{$pid}; # Get spirit struct
# No heartbeat (graceful stop)
if (!$w->{graceful} && ($w->{time} + $interval + $hb_to <= $now)) {
$log->error("Spirit $pid has no heartbeat ($hb_to seconds), restarting");
$w->{graceful} = $now;
}
# Graceful stop with timeout
my $graceful = $w->{graceful} ||= $self->{gracefully_stop} ? $now : undef;
if ($graceful && !$w->{attempt}) {
$w->{attempt}++;
$log->info("Stopping spirit $pid gracefully ($gf_to seconds)");
kill 'QUIT', $pid or $self->_stopped($pid);
}
$w->{force} = 1 if $graceful && $graceful + $gf_to <= $now; # The conditions for a graceful stop by timeout were violated
# Normal stop
if ($w->{force} || ($self->{finished} && !$graceful)) {
$log->warn("Stopping spirit $pid immediately");
kill 'KILL', $pid or $self->_stopped($pid);
}
}
}
sub _spawn { # Manager level (Spawn a spirit and transferring control to it)
my $self = shift;
# Manager
croak("Can't fork: $!\n") unless defined(my $pid = fork);
if ($pid) { # Parent (manager)
lib/Acme/Ghost/Prefork.pm view on Meta::CPAN
}
$self->{spirited} = 1; # Inspiration! (disables cleanup)
weaken $self;
# Clean spirit signals
$SIG{$_} = 'DEFAULT' for qw/CHLD INT TERM TTIN TTOU/;
# Set QUIT signal
$SIG{QUIT} = sub {
$self->log->warn("Spirit $$ received QUIT signal") if DEBUG;
$self->_heartbeat(1); # Send finish command to manager
};
# Close reader pipe
delete $self->{reader};
# Reset the random number seed for spirit
srand;
$self->log->info("Spirit $$ started");
# Start spirit
$self->spirit;
exit 0; # EXIT FROM APPLICATION
}
sub _wait { # Manager level
my $self = shift;
# Call waitup hook
lib/Acme/Ghost/Prefork.pm view on Meta::CPAN
# Poll for heartbeats
my $reader = $self->{reader};
return unless _is_readable(1000, fileno($reader));
return unless $reader->sysread(my $chunk, 4194304);
# Update heartbeats (and stop gracefully if necessary)
my $now = Time::HiRes::time;
while ($chunk =~ /(\d+):(\d)\n/g) {
my $pid = $1;
my $finished = $2;
$self->log->warn("Spirit $$ received finished HeartBeat message $pid:$finished") if DEBUG && $finished;
next unless my $w = $self->{pool}{$pid};
$w->{healthy} = 1;
$w->{time} = $now;
$self->heartbeat($pid);
if ($finished) { # Oops! Needs to finish
$w->{graceful} ||= $now;
$w->{attempt}++;
}
}
}
t/02-daemon.t view on Meta::CPAN
#
#########################################################################
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";
#note $g->pid;
done_testing;
__END__
ACME_GHOST_DEBUG=1 prove -lv t/02-daemon.t
tail -f daemon.log | bell -s mush -v 36000 | ccze -A -p syslog
# 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";
}
done_testing;
1;
package FakeLogger;
sub new { bless {}, shift }
sub info { printf "# Info[$$] %s\n", pop @_ }
sub error { printf "# Error[$$] %s\n", pop @_ }
1;
__END__
prove -lv t/04-log.t
( run in 1.362 second using v1.01-cache-2.11-cpan-49f99fa48dc )