File Coverage

blib/lib/Mojo/Weixin/Log.pm
Criterion Covered Total %
statement 31 101 30.6
branch 1 42 2.3
condition 0 27 0.0
subroutine 11 31 35.4
pod 3 17 17.6
total 46 218 21.1


line stmt bran cond sub pod time code
1             package Mojo::Weixin::Log;
2 1     1   8 use Mojo::Base;
  1         3  
  1         6  
3 1     1   39 use base qw(Mojo::Base Mojo::EventEmitter);
  1         3  
  1         162  
4 1     1   17 use Carp 'croak';
  1         2  
  1         46  
5 1     1   5 use Fcntl ':flock';
  1         2  
  1         443  
6 1     1   7 use Encode;
  1         2  
  1         130  
7 1     1   14 use POSIX qw();
  1         2  
  1         28  
8 1     1   483 use Encode::Locale;
  1         3179  
  1         45  
9 1     1   6 use IO::Handle;
  1         2  
  1         73  
10             BEGIN{
11 1     1   4 eval{require Term::ANSIColor};
  1         688  
12 1 50       8691 $Mojo::Weixin::Log::is_support_color = 1 unless $@;
13             }
14 11     11 1 25 sub has { Mojo::Base::attr(__PACKAGE__, @_) };
15            
16             has format => sub { \&_format };
17             has handle => sub {
18             # STDERR
19             return \*STDERR unless my $path = shift->path;
20             # File
21             croak qq{Can't open log file "$path": $!} unless open my $file, '>>', $path;
22             return $file;
23             };
24             has history => sub { [] };
25             has level => 'debug';
26             has head => '';
27             has encoding => undef;
28             has unicode_support => 1;
29             has disable_color => 0;
30             has console_output => 0;
31             has max_history_size => 10;
32             has 'path';
33            
34             # Supported log levels
35             my $LEVEL = {debug => 1, info => 2, msg=>3, warn => 4, error => 5, fatal => 6};
36             sub _format {
37 0     0     my ($time, $level, @lines) = @_;
38 0 0         my %opt = ref $lines[0] eq "HASH"?%{shift @lines}:();
  0            
39 0 0         $time = $opt{time} if defined $opt{time};
40 0 0         $time = $time?POSIX::strftime('[%y/%m/%d %H:%M:%S]',localtime($time)):"";
41             my $log = {
42             head => $opt{head} // "",
43             head_color => $opt{head_color},
44             'time' => $time,
45             time_color => $opt{time_color},
46             level => $opt{level} // $level,
47             level_color => $opt{level_color},
48             title => defined $opt{title}?"$opt{title} ":"",
49             title_color => $opt{title_color},
50             content => [split /\n/,join "",@lines],
51             content_color=> $opt{content_color},
52 0 0 0       };
      0        
53 0           return $log;
54             }
55             sub colored {
56             #black red green yellow blue magenta cyan white
57 0     0 0   my $self = shift;
58 0 0 0       return $_[0] if (!$_[0] or !$_[1] or $self->disable_color or !$Mojo::Weixin::Log::is_support_color);
      0        
      0        
59 0 0         return Term::ANSIColor::colored(@_) if $Mojo::Weixin::Log::is_support_color;
60             }
61             sub reform_encoding{
62 0     0 0   my $self = shift;
63 0           my $log = shift;
64 1     1   9 no strict;
  1         2  
  1         1074  
65 0           my $msg ;
66 0 0 0       if($self->unicode_support and Encode::is_utf8($log)){
67 0   0       $msg = encode($self->encoding || console_out,$log);
68             }
69             else{
70 0 0         if($self->encoding =~/^utf-?8$/i ){
71 0           $msg = $log;
72             }
73             else{
74 0   0       $msg = encode($self->encoding || console_out,decode("utf8",$log));
75             }
76             }
77 0           return $msg;
78             }
79             sub append {
80 0     0 0   my ($self,$log) = @_;
81 0 0         return unless my $handle = $self->handle;
82 0           flock $handle, LOCK_EX;
83 0           $log->{$_} = $self->reform_encoding($log->{$_}) for(qw(head level title ));
84 0           $_ = $self->reform_encoding($_) for @{$log->{content}};
  0            
85 0 0         if( -t $handle){
86 0           my $color_msg;
87 0           for(@{$log->{content}}){
  0            
88             $color_msg .= $self->colored($log->{head},$log->{head_color})
89             . $self->colored($log->{time},$log->{time_color})
90             . " "
91             . ( $log->{level}?"[".$self->colored($log->{level},$log->{level_color})."]":"" )
92             . " "
93             . $self->colored($log->{title},$log->{title_color})
94             . $self->colored($_,$log->{content_color})
95 0 0         . "\n";
96             }
97 0 0         $handle->print($color_msg) or croak "Can't write to log: $!";
98             }
99             else{
100 0           my $msg;
101 0           for(@{$log->{content}}){
  0            
102             $msg .= $log->{head}
103             . $log->{time}
104             . " "
105             . ($log->{level}?"[$log->{level}]":"")
106             . " "
107             . $log->{title}
108 0 0         . $_
109             . "\n";
110             }
111 0 0         $handle->print($msg) or croak "Can't write to log: $!";
112 0 0 0       if($self->console_output and -t STDOUT){
113 0           my $color_msg;
114 0           for(@{$log->{content}}){
  0            
115             $color_msg .= $self->colored($log->{head},$log->{head_color})
116             . $self->colored($log->{time},$log->{time_color})
117             . " "
118             . ( $log->{level}?"[".$self->colored($log->{level},$log->{level_color})."]":"" )
119             . " "
120             . $self->colored($log->{title},$log->{title_color})
121             . $self->colored($_,$log->{content_color})
122 0 0         . "\n";
123             }
124 0           print STDERR $color_msg;#or croak "Can't write to log: $!"
125             }
126             }
127 0           flock $handle, LOCK_UN;
128             }
129            
130 0     0 0   sub debug { shift->_log(debug => @_) }
131 0     0 1   sub error { shift->_log(error => @_) }
132 0     0 0   sub fatal { shift->_log(fatal => @_) }
133 0     0 0   sub info { shift->_log(info => @_) }
134 0     0 0   sub warn { shift->_log(warn => @_) }
135 0     0 0   sub msg { shift->_log(msg => @_) }
136            
137 0     0 0   sub is_debug { shift->_now('debug') }
138 0     0 0   sub is_error { shift->_now('error') }
139 0     0 0   sub is_info { shift->_now('info') }
140 0     0 0   sub is_warn { shift->_now('warn') }
141 0     0 0   sub is_msg { shift->_now('msg') }
142 0     0 0   sub is_fatal { shift->_now('fatal') }
143            
144             sub new {
145 0     0 1   my $self = shift->SUPER::new(@_);
146 0           $self->on(message => \&_message);
147 0           return $self;
148             }
149            
150 0 0   0     sub _log { shift->emit('message', shift, ref $_[0] eq 'CODE' ? $_[0]() : @_) }
151            
152             sub _message {
153 0     0     my ($self, $level) = (shift, shift);
154            
155 0 0         return unless $self->_now($level);
156            
157 0           my $max = $self->max_history_size;
158 0           my $history = $self->history;
159 0 0         if(ref $_[0] eq 'HASH'){
160 0 0         $_[0]{head} = $self->head if not defined $_[0]{head};
161             }
162             else{
163 0           unshift @_,{head=>$self->head};
164             }
165 0           push @$history, my $msg = [time, $level, @_];
166 0           shift @$history while @$history > $max;
167              
168 0           $self->append($self->format->(@$msg));
169             }
170            
171 0   0 0     sub _now { $LEVEL->{pop()} >= $LEVEL->{$ENV{MOJO_LOG_LEVEL} || shift->level} }
172            
173             1;