view release on metacpan or  search on metacpan

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

L<Acrux::Log> logging plugin

=back

=head1 TO DO

See C<TODO> file

=head1 SEE ALSO

L<CTK>, L<CTK::App>

=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

use Carp qw/carp croak/;
use Time::HiRes qw/gettimeofday tv_interval/;
use FindBin qw/$RealBin $Script/;
use File::Spec qw//;
use Cwd qw/getcwd/;
use Sub::Util qw/set_subname/;
use Acrux::RefUtil qw/
        as_hash_ref is_hash_ref
        as_array_ref is_array_ref
        is_value is_code_ref is_true_flag
    /;
use Acrux::Const qw/:dir/;
use Acrux::Util qw/load_class trim words/;

use constant {
    WIN             => !!($^O =~ /mswin/i),
    ALOWED_MODES    => [qw/debug test verbose/],
    PRELOAD_PLUGINS => [qw/Config Log/], # Order is very important!
    DEFAULT_PLUGINS => {
        Config  => "Acme::Crux::Plugin::Config",
        Log     => "Acme::Crux::Plugin::Log",
    },
};

sub new {
    my $class = shift;
    my $args = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {};

    # Get project name and moniker
    my $project = $args->{project} || $args->{name}
      || ($Script =~ /^(.+?)\.(pl|t|pm|cgi)$/ ? $1 : $Script)
      || $class || scalar(caller(0));
    my $moniker = $args->{moniker} || _project2moniker($project)
      || _project2moniker($class || scalar(caller(0)));

    # Current dir
    my $pwd = getcwd();

    # Create
    my $self = bless {
        # Common
        error       => "",
        script      => $Script,
        invocant    => scalar(caller(0)),
        project     => $project,
        moniker     => $moniker,
        pid         => $$,
        running     => 0,

        # General
        orig        => {%$args},
        created     => Time::HiRes::time,
        hitime      => [gettimeofday],
        options     => as_hash_ref($args->{options}), # Options of command line
        plugins     => {},
        preload_plugins => $args->{preload} || $args->{preload_plugins} || PRELOAD_PLUGINS,

        # Modes (defaults)
        debugmode   => 0,
        testmode    => 0,
        verbosemode => 0,

        # Dirs
        pwd         => $pwd,
        exedir      => $RealBin, # Script dir
        root        => $args->{root}, # Root dir of project. Default: /etc/moniker
        tempdir     => $args->{tempdir}, # Temp dir of project. Default: /tmp/moniker
        datadir     => $args->{datadir}, # Data dir of project. Defaut: /var/lib/moniker
        logdir      => $args->{logdir}, # Log dir of project. Default: /var/log/moniker
        sharedir    => $args->{sharedir}, # Share dir. Default: /usr/share/moniker
        docdir      => $args->{docdir}, # Share dir. Default: /usr/share/doc/moniker
        cachedir    => $args->{cachedir}, # Cache dir. Default: /var/cache/moniker
        spooldir    => $args->{spooldir}, # Spool dir. Default: /var/spool/moniker
        rundir      => $args->{rundir}, # Run dir. Default: /var/run/moniker
        lockdir     => $args->{lockdir}, # Lock dir. Default: /var/lock/moniker
        webdir      => $args->{webdir}, # Web dir. Default: /var/www/moniker

        # Files
        logfile     => $args->{logfile}, # Log file of project. Default: /var/log/moniker/moniker.log
        configfile  => $args->{configfile}, # Config file of project. Default: /etc/moniker/moniker.conf
        pidfile     => $args->{pidfile}, # PID file of project. Default: /var/run/moniker.pid

    }, $class;

    # Modes
    foreach my $mode ( @{(ALOWED_MODES)}) {
        $self->{$mode."mode"} = 1 if is_true_flag($args->{$mode});
    }

    # Root dir
    my $root = $self->{root};
    $root = $self->{root} = $pwd if defined($root) && $root eq '.'; # Set root to cwd if specified as '.'
    unless (defined($root) && length($root)) {
        $root = $self->{root} = File::Spec->catdir(SYSCONFDIR, $moniker);
    }

    # Temp dir
    my $temp = $self->{tempdir};
    unless (defined($temp) && length($temp)) {
        $temp = $self->{tempdir} = File::Spec->catdir(File::Spec->tmpdir(), $moniker);
    }

    # Data dir
    my $datadir = $self->{datadir};

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

        'class'     => $class,
        'loaded'    => 1,
        'time'      => time,
        'something' => $ret,
    };

    return $ret;
}

# Handlers
sub register_handler {
    my $class = shift;
       $class = ref($class) if ref($class);
    my %info = @_;
    my $k = "$class.$$";
    $Acme::Crux::Sandbox::HANDLERS{$k} = {} unless exists($Acme::Crux::Sandbox::HANDLERS{$k});
    my $handlers = $Acme::Crux::Sandbox::HANDLERS{$k};

    # Handler name
    my $name = trim($info{handler} // $info{name} // 'default');
    croak("The handler name missing") unless length($name);
    delete $info{handler};
    $info{name} = $name;
    croak("The $name duplicate handler definition") if defined($handlers->{$name});

    # Handler aliases
    my $_aliases = $info{alias} // $info{aliases} // [];
       $_aliases = [ trim($_aliases) ] unless is_array_ref($_aliases);
    my $aliases = words(@$_aliases);
    #foreach my $al (@$_aliases) {
    #    next unless defined($al) && is_value($al);
    #    foreach my $p (split(/[\s;,]+/, $al)) {
    #        next unless defined($p) && length($p);
    #        $aliases{$p} = 1;
    #    }
    #}
    delete $info{alias};
    $info{aliases} = [grep {$_ ne $name} @$aliases];

    # Handler description
    $info{description} //= '';

    # Handler params
    my $params = $info{parameters} || $info{params} || {};
    delete $info{parameters};
    $params = {} unless is_hash_ref($params);
    $info{params} = $params;

    # Handler code
    my $code = $info{code} || sub {return 1};
    $info{code} = is_code_ref($code) ? $code : sub { $code };

    # Set info to handler data
    $handlers->{$name} = {%info};
    return 1;
}
sub lookup_handler {
    my $self = shift;
    my $name = trim(shift // '');
    return undef unless length $name;
    my $invocant = ref($self) || scalar(caller(0));
    my $handlers = $Acme::Crux::Sandbox::HANDLERS{"$invocant.$$"};
    return undef unless defined($handlers) && is_hash_ref($handlers);
    foreach my $n (keys %$handlers) {
        my $aliases = as_array_ref($handlers->{$n}->{aliases});
        return $handlers->{$n} if grep {defined && $_ eq $name} ($n, @$aliases);
    }
    return undef;
}
sub handlers {
    my $self = shift;
    my $all = shift // 0; # returns aliases too
    my $invocant = ref($self) || scalar(caller(0));
    my $handlers = $Acme::Crux::Sandbox::HANDLERS{"$invocant.$$"};
    return [] unless defined($handlers) && is_hash_ref($handlers);
    return [(sort {$a cmp $b} keys %$handlers)] unless $all;

    # All: names and aliases
    my %seen = ();
    foreach my $n (keys %$handlers) {
        my $aliases = as_array_ref($handlers->{$n}->{aliases});
        foreach my $_a ($n, @$aliases) {
            $seen{$_a} = 1 if defined($_a) and length($_a);
        }
    }
    return [(sort {$a cmp $b} keys %seen)];
}
sub run_handler {
    my $self = shift;
    my $name = shift // 'default';
    my @args = @_;
    if ($self->{running}) {
        $self->error(sprintf(qq{The application "%s" is already runned}, $self->project));
        return 0;
    }
    unless(length($name)) {
        $self->error("Invalid handler name");
        return 0;
    }
    my $meta = $self->lookup_handler($name);
    unless ($meta) {
        $self->error(sprintf("Handler %s not found", $name));
        return 0;
    }

    # Run
    my %info = (orig => $name);
    my $func;
    $self->{running} = 1;
    foreach my $k (keys %$meta) {
        next unless defined $k;
        if ($k eq 'code') {
            $func = $meta->{code};
            next;
        }
        $info{$k} = $meta->{$k};
    }
    unless(is_code_ref($func)) {
        $self->error("Handler code not found! Maybe you need to implement it?");
        return 0;
    }

    # Call function and return
    my $ret = &$func($self, {%info}, @args);
    $self->{running} = 0;
    return $ret;
}
sub run { goto &run_handler }

# Internal functions (NOT METHODS)
sub _project2moniker {
    my $prj = shift;
    return unless defined($prj);