view release on metacpan or  search on metacpan

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

    7 | debug     |
    6 | info      |
    5 | notice    |
    4 | warning   | warn  |
    3 | error     | err   |
    2 | critical  | crit  |
    1 | alert     |
    0 | emergency | emerg |
        fatal
)\z/x;

# to convert minlevel and maxlevel to a number
our %LEVEL_BY_STRING = (
    DEBUG     =>  7,
    INFO      =>  6,
    NOTICE    =>  5,
    WARNING   =>  4,
    WARN      =>  4,
    ERROR     =>  3,
    ERR       =>  3,
    CRITICAL  =>  2,
    CRIT      =>  2,
    ALERT     =>  1,
    EMERGENCY =>  0,
    EMERG     =>  0,
    FATAL     =>  0,
);

# to iterate from minlevel to maxlevel and
# create an HoA with all active levels
our @LEVEL_BY_NUM = qw(
    EMERGENCY
    ALERT
    CRITICAL
    ERROR
    WARNING
    NOTICE
    INFO
    DEBUG
    NOTHING
);

# shortcuts for each output
our %AVAILABLE_OUTPUTS = (
    file     => "Log::Handler::Output::File",
    email    => "Log::Handler::Output::Email",
    sendmail => "Log::Handler::Output::Sendmail",
    forward  => "Log::Handler::Output::Forward",
    dbi      => "Log::Handler::Output::DBI",
    screen   => "Log::Handler::Output::Screen",
    socket   => "Log::Handler::Output::Socket",
    gearman  => "Log::Handler::Output::Gearman",
);

# use Log::Handler foo => "LOGFOO", bar => "LOGBAR";
# use Log::Handler qw/foo LOGFOO bar LOGBAR/;
sub import {
    return unless @_ > 1;
    my $class  = shift;
    my %create = @_ > 1 ? @_ : (@_, undef);
    my $caller = (caller)[0];

    foreach my $appl (keys %create) {
        my $export = $create{$appl};
        my $logger = ();

        if (!exists $LOGGER{$appl}) {
            $LOGGER{$appl} = __PACKAGE__->new();
        }

        if ($export) {
            no strict "refs";
            my $method = $caller."::".$export;
            *{$method} = sub { $LOGGER{$appl} };
        }
    }
}

sub get_logger {
    @_ == 2 || croak 'Usage: Log::Handler->get_logger($app)';
    my ($class, $logger) = @_;

    if (!exists $LOGGER{$logger}) {
        return $class->create_logger($logger);
    }

    return $LOGGER{$logger};
}

sub create_logger {
    @_ == 2 || croak 'Usage: Log::Handler->create_logger($app)';
    my ($class, $logger) = @_;

    if (!exists $LOGGER{$logger}) {
        $LOGGER{$logger} = __PACKAGE__->new();
    }

    return $LOGGER{$logger};
}

sub exists_logger {
    @_ == 2 || croak 'Usage: Log::Handler->exists_logger($app)';
    my ($class, $logger) = @_;

    if (exists $LOGGER{$logger}) {
        return 1;
    }

    return undef;
}

sub new {
    my $class = shift;

    my $self = bless {
        priority => PRIORITY,   # start priority
        levels   => { },        # outputs (Output.pm) stored by active levels
        alias    => { },        # outputs (Output.pm) stored by an alias
        outputs  => [ ],        # all Output::* objects - for flush()
        pattern  =>             # default pattern
            &Log::Handler::Pattern::get_pattern,