File Coverage

blib/lib/Log/Log4perl/CommandLine.pm

Criterion	Covered	Total	%
statement	35	82	42.6
branch	6	64	9.3
condition	6	17	35.2
subroutine	8	8	100.0
pod	1	1	100.0
total	56	172	32.5

package Log::Log4perl::CommandLine;

use warnings;
use strict;

our $VERSION = '0.07';

use Log::Log4perl qw(get_logger :levels);
use Getopt::Long;

my %init;     # logconfig, loginit, logfile, logcategory, noinit
my %options;  # options set on command line

my %levelmap =
(
    q => 'off',
    quiet => 'off',
    v => 'info',
    verbose => 'info',
    d => 'debug'
);

sub import
{
    my $class = shift;

    my $caller = caller;

    my @getoptlist;
    my $next;
    foreach (@_)
    {
        if ($next)
        {
            $init{$next} = $_;
            $next = undef;
            next;
        }

        /^:(log(?:config|file|init|category))$/ and $next = $1; # Grab next arg

        /^(?:trace|:levels|:all)$/ and push(@getoptlist, 'trace:s@');
        /^(?:debug|:levels|:all)$/ and push(@getoptlist, 'debug:s@');
        /^(?:info|:levels|:all)$/  and push(@getoptlist, 'info:s@');
        /^(?:warn|:levels|:all)$/  and push(@getoptlist, 'warn:s@');
        /^(?:error|:levels|:all)$/ and push(@getoptlist, 'error:s@');
        /^(?:fatal|:levels|:all)$/ and push(@getoptlist, 'fatal:s@');
        /^(?:off|:levels|:all)$/   and push(@getoptlist, 'off:s@');

        /^(?:quiet|:long|:all)$/   and push(@getoptlist, 'quiet:s@');
        /^(?:verbose|:long|:all)$/ and push(@getoptlist, 'verbose:s@');

        /^(?:q|:short|:all)$/      and push(@getoptlist, 'q:s@');
        /^(?:v|:short|:all)$/      and push(@getoptlist, 'v:s@');
        /^(?:d|:short|:all)$/      and push(@getoptlist, 'd:s@');

        /^(?:loglevel|:logopts|:all)$/ and push(@getoptlist, 'loglevel:s@');

        /^(?:logconfig|:logopts|:all)$/ and
            push(@getoptlist, 'logconfig=s' => \$init{logconfig});

        /^(?:logfile|:logopts|:all)$/ and
            push(@getoptlist, 'logfile=s' => \$init{logfile});

        { no strict 'refs';
            /^handlelogoptions$/ and
                *{"$caller\::handlelogoptions"} = *handlelogoptions;
        }

        /^:noinit$/ and $init{noinit} = 1;
    }

    my $getopt = Getopt::Long::Parser->new
                 ( config => [qw(pass_through no_auto_abbrev
                                 no_ignore_case)] );

    $getopt->getoptions(\%options, @getoptlist);

    # Allow: --option --option foo --option foo,bar
    while (my ($opt, $cats) = each %options)
    {
        $options{$opt} = [ map { length $_ ? split(',') : '' } @$cats ];
    }

    # --loglevel category=level or --loglevel level
    foreach (@{$options{loglevel}})
    {
        my ($category, $level) = /^([^=]*?)=?([^=]+)$/;
        push(@{$options{$level}}, $category);
    }
    delete $options{loglevel};
}

INIT
{
    return if $init{noinit};

    if (defined $init{logconfig} and -f $init{logconfig} and -r _)
    {
        Log::Log4perl->init($init{logconfig});
    }
    else
    {
        if ($init{loginit} and not ref $init{loginit})
        {
            Log::Log4perl->init(\$init{loginit});
        }
        elsif ($init{loginit} and ref $init{loginit} eq 'ARRAY')
        {
            Log::Log4perl->easy_init(@{$init{loginit}});
        }
        else
        {
            my $init = ref $init{loginit} eq 'HASH' ? $init{loginit} : {};

            $init->{level} ||= $ERROR;
            $init->{layout} ||= '[%-5p] %m%n';

            Log::Log4perl->easy_init($init);
        }
    }

    handlelogoptions();
}

sub handlelogoptions
{
    if ($init{logfile})
    {
        my $logfile = $init{logfile};
        my $layout = '%d %c %m%n';

        if ($logfile =~ s/\|(.*)$//)   # "logfilename|logpattern"
        {
            $layout = $1;
        }

        my $file_appender = Log::Log4perl::Appender->new(
                                "Log::Log4perl::Appender::File",
                                name => 'logfile',
                                filename  => $logfile);

        $file_appender->layout(Log::Log4perl::Layout::PatternLayout->new(
                               $layout));

        get_logger('')->add_appender($file_appender);
    }

    while (my ($level, $vals) = each %options)
    {
        $level = $levelmap{$level} if exists $levelmap{$level};

        my $level_id = Log::Log4perl::Level::to_priority(uc $level);

        foreach my $category (@$vals)
        {
            if ($category eq '')
            {
                $category = defined($init{logcategory})
                            ? $init{logcategory}
                            : $level_id >= $INFO ? '' : 'main';
            }

            $category = '' if $category eq 'root';

            get_logger($category)->level($level_id);
        }
    }
}

1;

__END__