package Log::Simple;
use 5.007;
use strict;
use warnings;

use Carp qw(croak);
use POSIX qw(strftime);
use Time::HiRes qw(time);

our $VERSION = '0.05';

BEGIN {

    sub _sub_names {
        my @levels = qw(
            emergency alert critical
            error warning notice info debug
        );
        my @short = qw(emerg crit err warn);
        my @nums = qw(_0 _1 _2 _3 _4 _5 _6 _7);

        my @all;
        push @all, @levels, @short, @nums;

        return \@all;
    }

    my $sub_names = _sub_names();

    {
        no strict 'refs';

        for (@$sub_names) {
            my $sub = $_;

            *$_ = sub {
                my ($self, $msg) = @_;

                $self->level($ENV{LS_LEVEL}) if defined $ENV{LS_LEVEL};

                if ($sub =~ /^_(\d)$/){
                    return if $1 > $self->level;
                }
                return if $self->_level_value($sub) > $self->level;

                my $proc = join '|', (caller(0))[1..2];

                my %log_entry = (
                    label => $sub,
                    proc => $proc,
                    msg => $msg,
                );

                $self->_generate_entry(%log_entry);
            }
        }
    }
}
sub new {
    my ($class, %args) = @_;

    my $self = bless {}, $class;

    if (defined $args{level}) {
        $self->level($args{level});
    }
    else {
        my $lvl = defined $ENV{LS_LEVEL} ? $ENV{LS_LEVEL} : 4;
        $self->level($lvl);
    }

    if ($args{file}){
        $self->file($args{file}, $args{write_mode});
    }

    my $print = defined $args{print} ? $args{print} : 1;
    $self->print($print);

    $self->display(
            time  => 1,
            label => 1,
            name  => 1,
            pid   => 0,
            proc  => 0,
    );

    if (defined $args{display}){
        $self->display($args{display});
    }

    $self->name($args{name});

    return $self;
}
sub level {
    my ($self, $level) = @_;

    my %levels = $self->levels;
    my %rev = reverse %levels;

    $self->{level} = $ENV{LS_LEVEL} if defined $ENV{LS_LEVEL};
    my $lvl;

    if (defined $level) {
        if ($level =~ /^\d$/ && defined $levels{$level}){
            $self->{level} = $level;
        }
        elsif ($level =~ /^\w{3}/ && defined($lvl = $self->_translate($level))){
            $self->{level} = $lvl;
        }
        else {
            CORE::warn
                "invalid level $level specified, using default 'warning'/4\n";
        }
    }
    return $self->{level};
}
sub file {
    my ($self, $file, $mode) = @_;

    if (! defined $file){
        return $self->{file};
    }
    if ($file =~ /^0$/){
        if (tell($self->{fh}) != -1) {
            close $self->{fh};
        }
        delete $self->{file};
        delete $self->{fh};
        return;
    }
    if (defined $file && $self->{file} && $file ne $self->{file}){
        close $self->{fh};
    }
    $mode = 'a' if ! defined $mode;
    my $op = $mode =~ /^a/ ? '>>' : '>';

    open $self->{fh}, $op, $file or die "can't open log file for writing: $!";
    $self->{file} = $file;

    return $self->{file};
}
sub name {
    my ($self, $name) = @_;
    $self->{name} = $name if defined $name;
    return $self->{name};
}
sub timestamp {
	my $t = time;
    my $date = strftime "%Y-%m-%d %H:%M:%S", localtime $t;
    $date .= sprintf ".%03d", ($t-int($t))*1000; # without rounding
    return $date;
}
sub levels {
    my ($self, $want) = @_;

    my %levels = (
        0 => 'emergency',
        1 => 'alert',
        2 => 'critical',
        3 => 'error',
        4 => 'warning',
        5 => 'notice',
        6 => 'info',
        7 => 'debug',
    );

    if (defined $want && $want eq 'names'){
        my @level_list;
        for (0..7){
            push @level_list, $levels{$_};
        }
        return @level_list;
    }

    return %levels;
}
sub display {
    my $self = shift;
    my ($tag, %tags);

    if (@_ == 1){
        $tag = shift;
    }
    else {
        %tags = @_;
    }

    if (defined $tag){
        if ($tag =~ /^0$/){
            for (keys %{ $self->{display} }){
                $self->{display}{$_} = 0;
            }
            return 0;
        }
        if ($tag =~ /^1$/){
            for (keys %{ $self->{display} }){
                $self->{display}{$_} = 1;
            }
            return 1;
        }

        return $self->{display}{$tag};
    }

    my %valid = (
        name => 0,
        time => 0,
        label => 0,
        pid => 0,
        proc => 0,
    );

    for (keys %tags) {
        if (! defined $valid{$_}){
            CORE::warn "$_ is an invalid tag...skipping\n";
            next;
        }
        $self->{display}{$_} = $tags{$_};
    }


    return %{ $self->{display} };
}
sub print {
    $_[0]->{print} = $_[1] if defined $_[1];
    return $_[0]->{print};
}
sub child {
    my ($self, $name) = @_;
    my $child = bless { %$self }, ref $self;
    $child->name($self->name .".$name");
    return $child;
}
sub _level_value {
    my ($self, $level) = @_;

    if ($level =~ /^_(\d)$/){
        return $1;
    }
    else {
        return $self->_translate($level);
    }
}
sub _translate {
    my ($self, $label) = @_;

    my %levels = $self->levels;

    if ($label =~ /^_?(\d)$/){
        return $levels{$1};
    }
    else {
        my %rev = reverse %levels;
        my ($lvl) = grep /^$label/, keys %rev;
        return $rev{$lvl};
    }
}
sub _generate_entry {
    my $self = shift;
    my %entry = @_;

    my $label = $entry{label};
    my $proc = $entry{proc};
    my $msg = $entry{msg};

    my $subs = $self->_sub_names;
    if (! grep { $label eq $_ } @$subs){
        croak "_generate_entry() requires a sub/label name as its first param\n";
    }

    if ($label =~ /^_(\d)$/){
        $label = $self->_translate($1);
    }

    $msg = $msg ? "$msg\n" : "\n";

    my $log_entry;
    $log_entry .= "[".$self->timestamp()."]" if $self->display('time');
    $log_entry .= "[$label]" if $self->display('label');
    $log_entry .= "[".$self->name."]" if $self->display('name') && $self->name;
    $log_entry .= "[$$]" if $self->display('pid');
    $log_entry .= "[$proc]" if $self->display('proc');
    $log_entry .= " " if $log_entry;
    $log_entry .= $msg;

    return $log_entry if ! $self->print;

    if ($self->{fh}){
        print { $self->{fh} } $log_entry;
    }
    else {
        print $log_entry;
    }
}

1;
__END__

=head1 NAME

Log::Simple - A simple but featureful logging mechanism.

=for html
<a href="http://travis-ci.org/stevieb9/p5-log-simple"><img src="https://secure.travis-ci.org/stevieb9/p5-log-simple.png"/>
<a href='https://coveralls.io/github/stevieb9/p5-log-simple?branch=master'><img src='https://coveralls.io/repos/stevieb9/p5-log-simple/badge.svg?branch=master&service=github' alt='Coverage Status' /></a>

=head1 SYNOPSIS

    use Log::Simple;

    my $log = Log::Simple->new(name => 'whatever'); # name is optional

    $log->warning("default level (4)");

    $log->_4("all levels can be called by number. This is warning()");

    $log->_7("this is debug(). Default level is 4, so this won't print");

    $log->level(7);
    $log->debug("same as _7(). It'll print now");

    $log->file('file.log');
    $log->info("this will go to file");
    $log->file(0); # back to STDOUT

    $log->_6("info facility, example output");
    #[2016-03-17 16:49:32.491][info][whatever] info facility, example output

    $log->display(0);
    $log->info("display(0) disables all output but this msg");
    $log->info("see display() method for disabling, enabling individual tags");

    $log->display(1);
    $log->info("all tags enabled");
    #[2016-03-17 16:52:06.356][info][whatever][5689][t/syn.pl|29] all tags enabled

    $log->print(0);
    my $log_entry = $log->info("print(0) disables printing and returns the entry");


=head1 DESCRIPTION

*** This is the first public release. The POD may be off a bit, and despite
extensive CI testing on multiple platforms, there still may be a few small
issues. ***

Lightweight (core-only) and very simple yet powerful debug tool for printing or
writing to file log type entries based on a configurable level (0-7).

It provides the ability to programmatically change which output tags to display,
provides numbered methods so you don't have to remember the name to number
level translation, provides the ability to create descendent children, easily
enable/disable file output, levels, display etc.

=head2 Log entry format

By default, log entries appear as such, with a timestamp, the name of the
facility, the name (if specified in the constructor) and finally the actual
log entry message.

    [2016-03-17 17:01:21.959][info][whatever] info facility, example output

All of the above tags can be enabled/disabled programatically at any time, and
there are others that are not enabled by default. See L<display> method for
details.

=head2 Levels

Verbosity and associated levels are:

=over 4

=item level 0, 'emergency|emerg'
=item level 1, 'alert'
=item level 2, 'critical|crit'
=item level 3, 'error|err'
=item level 4, 'warning|warn'
=item level 5, 'notice'
=item level 6, 'info'
=item level 7, 'debug'

=back

Note that all named level methods have an associated _N method, so you don't
have to remember the names at all. Using the numbers is often much easier.

Setting the C<level> will display all messages related to that level and below.

=head1 METHODS

=head2 new(%args)

Builds and returns a new C<Log::Simple> object. All arguments are optional, and
they can all be set using accessor methods after instantiation. These params
are:

=head3 name

Default: undef

Specify a name for your log object. It will be displayed by default in the log
output. The name of your program or module is a good choice.

=head3 level => Integer

Default: 4

Specify the name or equivalent number (0-7) of the highest level to log. Note
that this can be set in a C<LS_LEVEL> environment variable (and changed while
your program is running).

=head3 file => String

Default: undef

The name of a file to write log entries into. By default, we print to STDOUT.

=head3 write_mode => Bool

Default: 'a' (append)

By default, we append to the chosen log file. Send in 'w' or 'write' to
overwrite instead.

=head3 print => Bool

Default: 1 (enabled)

If a false value is sent in (ie. 0), we'll disable printing the log entries,
and return them as a string value instead on each call.

=head3 display => Bool

Default: enabled

Send in a false value to disable all log entry tags, less the actual message.
See C<display()> in L<METHODS> to learn how to enable and disable individual
tags.

=head2 level(Ingeger)

Set and return the facility level. Will return the current value with a param
sent in or not. It can be changed at any time. Note that you can set this with
the C<LS_LEVEL> environment variable, at any time. the next method call
regardless of what it is will set it appropriately.

=head2 file('file.log', 'mode')

By default, we write to STDOUT. Send in the name of a file to write there
instead. Mode is optional; we'll append to the file by default. Send in 'w' or
'write' to overwrite the file.

=head2 display(HASH|Bool)

List of log entry tags, and default printing status:
    name  => 1, #specified in new() or name()
    time  => 1,
    label => 1, # the string value of the level being called
    pid   => 0, # process ID
    proc  => 0, # "filename|line number" of the caller

In HASH param mode, send in any or all of the tags with 1 (enable) or 0
(disable).

You can also send in 1 to enable all of the tags, or 0 to disable them all.

=head2 print(Bool)

Default is enabled. If disabled, we won't print at all, and instead, return the
log entry as a scalar string value.

=head2 child('name')

This method will create a clone of the existing C<Log::Simple> object, and then
concatenate the parent's name with the optional name sent in here for easy
identification in the logs.

All settings employed by the parent will be used in the child, unless explicity
changed via the methods.

In a module or project, you can create a top-level log object, then in all
subs, create a child with the sub's name to easily identify flow within the
log. In an OO project, stuff the parent log into the main object, and clone it
from there.

=head1 LOGGING METHODS

=head2 emergency

Level 0

aka: C<_0()>, C<emerg()>

=head2 alert

Level 1

aka: C<_1()>

=head2 critical

Level 2

aka: C<_2()>, C<crit()>

=head2 error

Level 3

aka: C<_3()>, C<err()>

=head2 warning

Level 4

aka: C<_4()>, C<warn()>

=head2 notice

Level 5

aka: C<_5()>

=head2 info

Level 6

aka: C<_6()>

=head2 debug

Level 7

aka: C<_7()>

=head1 HELPER METHODS

These methods may be handy to the end user, but aren't required for end-use.

=head2 levels('names')

Returns the hash of level_num => level_name mapping.

If the optional string C<names> is sent in, we'll return an array of just the
names, in numeric order from lowest to highest.

=head2 timestamp

Returns the current time in the following format: C<2016-03-17 17:51:02.241
>

=head1 AUTHOR

Steve Bertrand, C<< <steveb at cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to
L<https://github.com/stevieb9/p5-log-simple/issues>

=head1 REPOSITORY

L<https://github.com/stevieb9/p5-log-simple>

=head1 BUILD RESULTS (THIS VERSION)

CPAN Testers: L<http://matrix.cpantesters.org/?dist=Log-Simple>

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Log::Simple

=head1 SEE ALSO

There are too many other logging modules to list here, but the idea for this
one came from L<Log::Basic>. However, this one was written completely from
scratch.

=head1 LICENSE AND COPYRIGHT

Copyright 2016 Steve Bertrand.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See L<http://dev.perl.org/licenses/> for more information.

