view release on metacpan or  search on metacpan

lib/Acme/Ghost.pm  view on Meta::CPAN

See C<TODO> file

=head1 SEE ALSO

L<CTK::Daemon>, L<Net::Server::Daemonize>, L<Mojo::Server>,
L<Mojo::Server::Prefork>, L<Daemon::Daemonize>, L<MooseX::Daemonize>,
L<Proc::Daemon>

=head1 AUTHOR

Serż Minus (Sergey Lepenkov) L<https://www.serzik.com> E<lt>abalama@cpan.orgE<gt>

=head1 COPYRIGHT

Copyright (C) 1998-2026 D&D Corporation

=head1 LICENSE

This program is distributed under the terms of the Artistic License Version 2.0

See the C<LICENSE> file or L<https://opensource.org/license/artistic-2-0> for details

=cut

our $VERSION = '1.03';

use Carp qw/carp croak/;
use Cwd qw/getcwd/;
use File::Basename qw//;
use File::Spec qw//;
use POSIX qw/ :sys_wait_h SIGINT SIGTERM SIGQUIT SIGKILL SIGHUP SIG_BLOCK SIG_UNBLOCK /;

use Acme::Ghost::FilePid;
use Acme::Ghost::Log;

use constant {
    DEBUG       => $ENV{ACME_GHOST_DEBUG} || 0,
    IS_ROOT     => (($> == 0) || ($< == 0)) ? 1 : 0,
    SLEEP       => 60,
    INT_TRIES   => 3,
    LSB_COMMANDS=> [qw/start stop reload restart status/],
};

sub new {
    my $class = shift;
    my $args = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {};
    my $name = $args->{name} || File::Basename::basename($0);
    my $user = $args->{user} // '';
    my $group = $args->{group} // '';

    # Get UID by User
    my $uid = $>; # Effect. UID
    if (IS_ROOT) {
        if ($user =~ /^(\d+)$/) {
            $uid = $user;
        } elsif (length($user)) {
            $uid = getpwnam($user) || croak "getpwnam failed - $!\n";
        }
    }
    $user = getpwuid($uid || 0) unless length $user;

    # Get GID by Group
    my $gids = $); # Effect. GIDs
    if (IS_ROOT) {
        if ($group =~ /^(\d+)$/) {
            $gids = $group;
        } elsif (length($group)) {
            $gids = getgrnam($group) || croak "getgrnam failed - $!\n";
        }
    }
    my $gid  = (split /\s+/, $gids)[0]; # Get first GID
    $group = getpwuid($gid || 0) unless length $group;

    # Check name
    croak "Can't create unnamed daemon\n" unless $name;

    my $self = bless {
        name        => $name,
        user        => $user,
        group       => $group,
        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}
    );
}