Acrux

 view release on metacpan or  search on metacpan

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

    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

lib/Acme/Crux/Plugin.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 = '0.01';

use Carp qw/croak/;

sub new { bless { name => $_[1] }, $_[0] }
sub name { shift->{name} }
sub register { croak 'Method "register" not implemented by subclass' }

1;

__END__

lib/Acrux/Config.pm  view on Meta::CPAN

use constant DEFAULT_CG_OPTS => {
    '-ApacheCompatible' => 1, # Makes possible to tweak all options in a way that Apache configs can be parsed
    '-LowerCaseNames'   => 1, # All options found in the config will be converted to lowercase
    '-UTF8'             => 1, # All files will be opened in utf8 mode
    '-AutoTrue'         => 1, # All options in your config file, whose values are set to true or false values, will be normalised to 1 or 0 respectively
};

sub new {
    my $class = shift;
    my $args = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {};
    my $self  = bless {
            default => $args->{defaults} || $args->{default} || {},
            file    => $args->{file} // '',
            root    => $args->{root} // '', # base path to default files/directories
            dirs    => $args->{dirs} || [],
            noload  => $args->{noload} || 0,
            options => {},
            error   => '',
            config  => {},
            pointer => Acrux::Pointer->new,
            files   => [],

lib/Acrux/Digest.pm  view on Meta::CPAN

    BUFFER_SIZE => 4*1024, # 4kB
};

use Carp;

use IO::File;
use MIME::Base64;

sub new {
    my $class = shift;
    return bless {
        data => '',
    }, $class;
}
sub data {
    my $self = shift;
    if (scalar(@_) >= 1) {
        $self->{data} = shift;
        return $self;
    }
    return $self->{data};

lib/Acrux/FilePid.pm  view on Meta::CPAN

use Carp qw/croak/;
use File::Spec;
use File::Basename qw/basename/;
use IO::File qw//;
use Cwd qw/getcwd/;

sub new {
    my $class = shift;
    my $args = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {};
    my $self  = bless {%$args}, $class;
    $self->{autoremove} ||= $args->{auto} ? 1 : 0;
    $self->{autosave}   ||= $args->{auto} ? 1 : 0;;
    $self->{file}       //= File::Spec->catfile(getcwd, sprintf("%s.pid", basename($0)));
    $self->{pid}        ||= $$; # Current PID
    $self->{owner}      ||= 0; # Owner PID
    $self->{is_running} = -1; # Unknown (is as running)
    if ($self->{autosave}) {
        return $self->running ? $self : $self->save;
    }
    return $self->load;

lib/Acrux/Log.pm  view on Meta::CPAN

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

See C<LICENSE> file and L<https://dev.perl.org/licenses/>

=cut

our $VERSION = '0.01';

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 Acrux::Util qw/color/;

use constant {
    LOGOPTS         => 'ndelay,pid', # For Sys::Syslog

lib/Acrux/Log.pm  view on Meta::CPAN

    $args->{color}      ||= 0;

    # Check level
    $args->{level} = lc($args->{level});
    unless (exists $MAGIC{$args->{level}}) {
        carp "Incorrect log level specified. Well be used debug log level by default";
        $args->{level} = 'debug';
    }

    # Instance
    my $self = bless {%$args}, $class;

    # Set formatter
    $self->{format} ||= $self->{short} ? \&_short : $self->{color} ? \&_color : \&_default;

    # 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 log file "$file": $!/ unless defined $self->{handle};
        $self->{provider} = "file";
    } else {

lib/Acrux/Pointer.pm  view on Meta::CPAN

See C<LICENSE> file and L<https://dev.perl.org/licenses/>

=cut

our $VERSION = '0.01';

sub new {
    my $class = shift;
    my $args = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {};
    my $self  = bless {
            data => $args->{data}
        }, $class;
    return $self;
}
sub data {
    my $self = shift;
    if (scalar(@_) >= 1) {
        $self->{data} = shift;
        return $self;
    }

t/09-log.t  view on Meta::CPAN

    );
    ok $log->error("My test error message"), 'Error message to handler STDOUT';
}

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/09-log.t