package Mojo::Log::Che; use Mojo::Base 'Mojo::Log'; use Carp 'croak'; use Fcntl ':flock'; use Mojo::File; #~ use Debug::LTrace qw/Mojo::Log::_log/;; #~ use Carp::Trace; #~ use Encode qw(decode_utf8); use Mojo::Util 'encode'; #~ binmode STDERR, ":utf8"; has paths => sub { {} }; has handlers => sub { {} }; has trace => 4; #~ has parent => undef, weak => 1; # Standard log levels my %LEVEL = (debug => 1, info => 2, warn => 3, error => 4, fatal => 5); sub new { my $self = shift->SUPER::new(format => \&_format, @_); $self->unsubscribe('message'); $self->on(message => \&_message); return $self; } sub context {# override my ($self, @context) = @_; #~ push @{ $self->{context} ||= [] }, @context; $self->{context} = \@context if @context; return $self; #~ return $self->new(parent => $self->parent || $self, context => \@context, level => $self->level); } sub handler { my ($self, $level) = @_; my $handler = $self->handlers->{$level}; return $handler if $handler; my $path = shift->path; my $path_level = $self->paths->{$level}; my $is_dir = -d -w $path if $path; my $file; if ($is_dir) {# DIR # relative path for level chop($path) if $path =~ /\/$/; $file = sprintf "%s/%s", $path, $path_level ||"$level.log"; } elsif ($path_level) {# absolute FILE for level $file = $path_level; } else { #~ warn "Cant create log handler for level=[$level] and path=[$path] (also check filesystem permissions)"; return; # Parent way to handle } $handler = Mojo::File->new($file)->open('>>')#:encoding(UTF-8) or croak "Cant create log handler for [$file]"; $self->handlers->{$level} = $handler; return $handler; }; sub append { my ($self, $msg, $handle) = @_; return unless $handle ||= $self->handle; flock $handle, LOCK_EX; $handle->print(encode('UTF-8', $msg))# or croak "Can't write to log: $!"; flock $handle, LOCK_UN; } my @mon = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); #~ my @wday = qw(Sn Mn Ts Wn Th Fr St); sub _format { my ($time, $level) = (shift, shift); $level = '['.($LEVEL{$level} ? ($level =~ /^(\w)/)[0] : $level) . '] ' #"[$level] " if $level //= ''; my ($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime($time); $time = sprintf "%s %s %s:%s:%s", $mday, map(length == 1 ? "0$_" : $_, $mon[$mon], $hour, $min, $sec);#$wday[$wday], return "$time $level" . join "\n", @_, ''; } sub _trace { my $start = shift // 1; my @call = caller($start); return \@call if @call; #~ my @frames; $start = 1; #~ while (my @trace = caller($start++)) { push @call, \@trace } #~ return pop @call; while (@call = caller($start++)) { 1; } #~ return $frames[4]; return \@call; } sub _message { my ($self, $level) = (shift, shift); #~ warn @{$self->{context}} if $self->{context}; return unless !$LEVEL{$level} || $self->is_level($level); my $max = $self->max_history_size; my $history = $self->history; my $time = time; my $trace = _trace($self->trace) if $self->trace; splice(@_,0, scalar @{$self->{context}},) and $_[0]= join(' ', @{$self->{context}}, $_[0]) if $self->{context}; unshift @_, "$$〉". join(":", @$trace[$$trace[0] eq 'main' ? (1,2) : (0,2)]). ' ' . shift if $trace && @$trace; push @$history, my $msg = [$time, $level, @_]; shift @$history while @$history > $max; if (my $handle = $self->handler($level)) { return $self->append($self->format->($time, '', @_), $handle); } # as parent return $self->append($self->format->(@$msg)); } sub AUTOLOAD { my $self = shift; my ($package, $method) = our $AUTOLOAD =~ /^(.+)::(.+)$/; Carp::croak "Undefined log level(subroutine) &${package}::$method called" unless Scalar::Util::blessed $self && $self->isa(__PACKAGE__); return $self->_log(@_, $method); } our $VERSION = '0.902';# as to Mojolicious version/10+ =encoding utf8 Доброго всем =head1 Mojo::Log::Che I<¡ ¡ ¡ ALL GLORY TO GLORIA ! ! !> =head1 VERSION 0.902 (up to Mojolicious version/10+C) =head1 NAME Mojo::Log::Che - Little child of great parent Mojo::Log. =head1 SYNOPSIS Parent Mojo::Log behavior just works use Mojo::Log::Che; my $log = Mojo::Log::Log->new(path => '/var/log/mojo.log', level => 'warn'); $log->debug(...); =head2 EXTENDED THINGS # Set "path" to folder + have default "paths" for levels (be sure that mkdir /var/log/mojo) my $log = Mojo::Log::Log->new(path => '/var/log/mojo'); $log->warn(...);# log to /var/log/mojo/warn.log $log->error(...); # log to /var/log/mojo/error.log $log->foo(...);# log to /var/log/mojo/foo.log # set "path" to folder + set custom relative "paths" (be sure that mkdir /var/log/mojo) my $log = Mojo::Log::Log->new(path => '/var/log/mojo', paths=>{debug=>'dbg.log', foo=>'myfoo.log'}); $log->debug(...); # log to /var/log/mojo/dbg.log $log->warn(...);# log to /var/log/mojo/warn.log $log->foo(...);# log to /var/log/mojo/myfoo.log # set "path" to file + have default "paths" for levels # this is standard Mojo::Log behavior + custom level/method also my $log = Mojo::Log::Log->new(path => '/var/log/mojo.log'); $log->debug(...); # log to /var/log/mojo.log $log->warn(...);# log to /var/log/mojo.log $log->foo(...);# log to /var/log/mojo.log # set "path" to file + set custom absolute "paths" my $log = Mojo::Log::Log->new(path => '/var/log/mojo.log', paths => {error=>'/var/log/mojo.error.log'}); $log->debug(...); # log to /var/log/mojo.log $log->foo(...);# log to /var/log/mojo.log $log->error(...); # log to /var/log/mojo.error.log # Log to STDERR + set custom absolute "paths" $log->path(undef); # none path $log->level('info'); $log->paths->{'error'} = '/var/log/error.log'; # absolute file only for error level $log->error(...); # log to /var/log/error.log $log->info(...); # log to STDERR $log->debug(...); # no log $log->foo(...); # anyway log to STDERR =head1 DESCRIPTION This B is a extended logger module for L projects. =head1 EVENTS B inherits all events from L and override following ones. =head2 message See also parent L. Extends parent module logics for switching handlers. =head1 ATTRIBUTES B inherits all attributes from L logic none handlers but L will be in the scene. $log->handlers->{'foo'} = IO::Handle->new(); =head2 path See parent L. Can set to folder and file path. =head2 paths Hashref map level names to absolute or relative to L $log->path('/var/log'); # folder relative $log->paths->{'error'} = 'err.log'; $log->error(...);# /var/log/err.log $log->info(...); # log to filename as level name /var/log/info.log $log->path(undef); # none $log->paths->{'error'} = '/var/log/error.log'; # absolute path only error level $log->error(...); # log to /var/log/error.log $log->info(...); # log to STDERR =head2 trace An trace level, defaults to C<4>, C<0> value will disable trace log. This value pass to C. =head1 METHODS B inherits all methods from L and implements the following new ones. =head2 handler($level) Return undef when L undefined or L is file or has not defined L for $level. In this case L will return default handler. Return file handler overwise. =head1 AUTOLOAD Autoloads nonstandard/custom levels excepts already defined keywords of this and parent modules L, L, L: qw(message _message format _format handle handler handlers history level max_history_size path paths append debug error fatal info is_level new warn catch emit has_subscribers on once subscribers unsubscribe has attr tap _monkey_patch import) and maybe anymore! $log->foo('bar here'); That custom levels log always without reducing log output outside of level. =head1 SEE ALSO L, L, L, L. =head1 AUTHOR Михаил Че (Mikhail Che), C<< >> =head1 BUGS / CONTRIBUTING Please report any bugs or feature requests at L. Pull requests also welcome. =head1 COPYRIGHT Copyright 2017 Mikhail Che. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut