File Coverage

blib/lib/Log/ger/App.pm

Criterion	Covered	Total	%
statement	77	103	74.7
branch	34	82	41.4
condition	2	5	40.0
subroutine	7	8	87.5
pod			n/a
total	120	198	60.6

package Log::ger::App;

use strict;
use warnings;

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2022-02-18'; # DATE
our $DIST = 'Log-ger-App'; # DIST
our $VERSION = '0.023'; # VERSION

our $DEBUG = defined($ENV{LOG_GER_APP_DEBUG}) ? $ENV{LOG_GER_APP_DEBUG} : 0;

# last import args
our @IMPORT_ARGS;

sub _set_level {
    my $name = shift;

    while (my ($source, $param, $note) = splice @_, 0, 3) {
        if ($source eq 'val') {
            if (defined $param) {
                warn "[lga] Setting $name to $param (from $note)\n" if $DEBUG;
                return $param;
            }
        } elsif ($source eq 'envset') {
            my $prefix = $param;
            if (defined $ENV{"${prefix}LOG_LEVEL"}) {
                my $val = $ENV{"${prefix}LOG_LEVEL"};
                warn "[lga] Setting $name to $val (from environment ${prefix}LOG_LEVEL)\n" if $DEBUG;
                return $val;
            }
            if ($ENV{"${prefix}TRACE"}) {
                warn "[lga] Setting $name to trace (from environment ${prefix}TRACE)\n" if $DEBUG;
                return 'trace';
            }
            if ($ENV{"${prefix}DEBUG"}) {
                warn "[lga] Setting $name to debug (from environment ${prefix}DEBUG)\n" if $DEBUG;
                return 'debug';
            }
            if ($ENV{"${prefix}VERBOSE"}) {
                warn "[lga] Setting $name to info (from environment ${prefix}VERBOSE)\n" if $DEBUG;
                return 'info';
            }
            if ($ENV{"${prefix}QUIET"}) {
                warn "[lga] Setting $name to trace (from environment ${prefix}QUIET)\n" if $DEBUG;
                return 'error';
            }
        } else {
            die "BUG: Unknown level source '$source'";
        }
    }
    'warn';
}

sub _is_daemon {
    return $main::IS_DAEMON if defined $main::IS_DAEMON;
    for (
        "App/Daemon.pm",
        "Daemon/Easy.pm",
        "Daemon/Daemonize.pm",
        "Daemon/Generic.pm",
        "Daemonise.pm",
        "Daemon/Simple.pm",
        "HTTP/Daemon.pm",
        "IO/Socket/INET/Daemon.pm",
        #"Mojo/Server/Daemon.pm", # simply loading Mojo::UserAgent will load this too
        "MooseX/Daemonize.pm",
        "Net/Daemon.pm",
        "Net/Server.pm",
        "Proc/Daemon.pm",
        "Proc/PID/File.pm",
        "Win32/Daemon/Simple.pm") {
        return 1 if $INC{$_};
    }
    0;
}

sub import {
    no warnings 'once'; # $Log::ger::Current_Level

    my ($pkg, %args) = @_;

    require Log::ger;
    require Log::ger::Util;

    my $extra_conf = delete $args{extra_conf};
    my $level_arg = delete $args{level};
    my $default_level_arg = delete $args{default_level};

    my $default_level_var_name = delete($args{default_level_var_name});
    $default_level_var_name = "Default_Log_Level" unless defined $default_level_var_name;
    $default_level_var_name = "main::$default_level_var_name" unless $default_level_var_name =~ /::/;
    my $default_level_var_value = do {
        no strict 'refs'; ## no critic: TestingAndDebugging::ProhibitNoStrict
        ${"$default_level_var_name"};
    };

    my $level = _set_level(
        "general log level",
        val => $level_arg, "import argument 'level'",
        envset => "", "",
        val => $default_level_arg, "import argument 'default_level'",
        val => $default_level_var_value, "\$$default_level_var_name",
        val => 'warn', "fallback value",
    );
    $Log::ger::Current_Level = Log::ger::Util::numeric_level($level);

    my $is_daemon = delete $args{daemon};
    $is_daemon = _is_daemon() if !defined($is_daemon);

    my $is_oneliner = $0 eq '-e';

    my $progname = delete $args{name};
    unless (defined $progname) {
        ($progname = $0) =~ s!.+/!!;
        $progname =~ s/\.pl$//;
    }
    unless (length $progname) {
        $progname = "prog";
    }

    # configuration for Log::ger::Output::Composite
    my %conf = (
        outputs => {},
        %{ $extra_conf // {} },
    );

    my %off_categories = (
        # some known categories that are not normally logged to screen or
        # (error) file log
        #'_dumps'  => 'off', # e.g. in download-bca, download-mandiri
        '_access' => 'off', # e.g. in WWW::PAUSE::Simple
    );

    # add Screen
    {
        last if $is_daemon;
        my $olevel = _set_level(
            "screen log level",
            envset => "SCREEN_", "",
            val => $level, "general log level",
        );
        last if $olevel eq 'off';
        my $fmt =
            ($ENV{LOG_ADD_STACK_TRACE} ? '[stack %T] ': '').
            ($ENV{LOG_ADD_LOCATION} ? '[location %l] ': '').
            ($ENV{LOG_ADD_TIMESTAMP} ? '[%d] ': '').
            ($ENV{LOG_ADD_MEMORY_INFO} ? '[vmsize %_{vmsize}K] ': '').
            '%m';
        $conf{outputs}{Screen} = {
            conf   => { formatter => sub { "$progname: $_[0]" }, colorize_tags => 1 },
            level  => $olevel,
            category_level => \%off_categories,
            layout => [Pattern => {format => $fmt}],
        };
    }

    # add File
    {
        my $file_name = delete $args{file_name};
        unless (defined $file_name) {
            $file_name = "$progname.log";
        }

        my $file_dir  = delete $args{file_dir};
        unless (defined $file_dir) {
            require PERLANCAR::File::HomeDir;
            $file_dir = $> || $^O eq 'MSWin32' ?
                PERLANCAR::File::HomeDir::get_my_home_dir() :
                  (-d "/var/log" ? "/var/log" : "/");
        }

        last if $0 eq '-';

        my $file_path = "$file_dir/$file_name";
        my $olevel = _set_level(
            "file ($file_path) log level",
            envset => "FILE_", "",
            val => $level, "general log level",
        );
        last if $olevel eq 'off';
        my $fmt =
            '[pid %P] [%d] '.
            ($ENV{LOG_ADD_MEMORY_INFO} ? '[vmsize %_{vmsize}K] ': '').
            '%m';
        $conf{outputs}{File} = {
            conf   => { path => $file_path },
            level  => $olevel,
            category_level => \%off_categories,
            layout => [Pattern => {format => $fmt}],
        };
    }

    # add Syslog
    {
        last unless $is_daemon;
        my $olevel = _set_level(
            "syslog log level",
            envset => "SYSLOG_", "",
            val => $level, "general log level",
        );
        last if $olevel eq 'off';
        $conf{outputs}{Syslog} = {
            conf => { ident => $progname, facility => 'daemon' },
            level => $olevel,
            category_level => \%off_categories,
        };
    }

    if (my $outputs = delete $args{outputs}) {
        for my $o (sort keys %$outputs) {
            if ($conf{outputs}{$o}) {
                warn "[lga] OVERWRITING output '$o' using output from 'outputs' argument\n" if $DEBUG;
            } else {
                warn "[lga] Adding output '$o' from 'outputs' argument\n" if $DEBUG;
            }
            $conf{outputs}{$o} = $outputs->{$o};
        }
    }

    die "Unknown argument(s): ".join(", ", sort keys %args)
        if keys %args;

    # save, for those who want to check or modify
    @IMPORT_ARGS = @_;

    require Log::ger::Output;
    Log::ger::Output->set('Composite', %conf);
}

1;
# ABSTRACT: An easy way to use Log::ger in applications

__END__