File Coverage

lib/Mail/SpamAssassin/Logger/Stderr.pm
Criterion Covered Total %
statement 26 41 63.4
branch 0 12 0.0
condition 1 3 33.3
subroutine 8 9 88.8
pod 0 3 0.0
total 35 68 51.4


line stmt bran cond sub pod time code
1             # <@LICENSE>
2             # Licensed to the Apache Software Foundation (ASF) under one or more
3             # contributor license agreements. See the NOTICE file distributed with
4             # this work for additional information regarding copyright ownership.
5             # The ASF licenses this file to you under the Apache License, Version 2.0
6             # (the "License"); you may not use this file except in compliance with
7             # the License. You may obtain a copy of the License at:
8             #
9             # http://www.apache.org/licenses/LICENSE-2.0
10             #
11             # Unless required by applicable law or agreed to in writing, software
12             # distributed under the License is distributed on an "AS IS" BASIS,
13             # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
14             # See the License for the specific language governing permissions and
15             # limitations under the License.
16             # </@LICENSE>
17              
18             =head1 NAME
19              
20             Mail::SpamAssassin::Logger::Stderr - log to standard error
21              
22             =head1 SYNOPSIS
23              
24             loadplugin Mail::SpamAssassin::Logger::Stderr
25              
26             =head1 DESCRIPTION
27              
28             =cut
29              
30              
31             use strict;
32 45     45   268 use warnings;
  45         85  
  45         1259  
33 45     45   222 # use bytes;
  45         80  
  45         1338  
34             use re 'taint';
35 45     45   208  
  45         114  
  45         1293  
36             use POSIX ();
37 45     45   1051 use Time::HiRes ();
  45         10873  
  45         774  
38 45     45   184  
  45         81  
  45         3820  
39             our @ISA = ();
40              
41             # ADDING OS-DEPENDENT LINE TERMINATOR - BUG 6456
42              
43             # Using Mail::SpamAssassin::Util::am_running_on_windows() leads to circular
44             # dependencies. So, we are duplicating the code instead.
45             use constant RUNNING_ON_WINDOWS => ($^O =~ /^(?:mswin|dos|os2)/oi);
46 45     45   265  
  45         74  
  45         18404  
47             my $eol = "\n";
48             if (RUNNING_ON_WINDOWS) {
49             $eol = "\r\n";
50             }
51              
52             my $class = shift;
53              
54 45     45 0 96 $class = ref($class) || $class;
55             my $self = { };
56 45   33     340 bless ($self, $class);
57 45         81  
58 45         92 my %params = @_;
59             $self->{timestamp_fmt} = $params{timestamp_fmt};
60 45         90  
61 45         205 return($self);
62             }
63 45         241  
64             my ($self, $level, $msg, $ts) = @_;
65              
66             my $timestamp;
67 0     0 0 0 my $fmt = $self->{timestamp_fmt};
68             my $now = defined $ts ? $ts : Time::HiRes::time;
69 0         0 if (!defined $fmt) {
70 0         0 # default since 3.3.0
71 0 0       0 my $datetime = POSIX::strftime("%b %d %H:%M", localtime($now));
72 0 0       0 utf8::encode($datetime) if utf8::is_utf8($datetime); # Bug 7305
    0          
73             $timestamp = sprintf("%s:%06.3f", $datetime, $now-int($now/60)*60);
74 0         0 # Bug 6329: %e is not in a POSIX standard, use %d instead and edit
75 0 0       0 local $1; $timestamp =~ s/^(\S+\s+)0/$1 /;
76 0         0 } elsif ($fmt eq '') {
77             $timestamp = '';
78 0         0 } else {
  0         0  
79             $timestamp = POSIX::strftime($fmt, localtime($now));
80 0         0 }
81             $timestamp .= ' ' if $timestamp ne '';
82 0         0  
83             my($nwrite) = syswrite(STDERR, sprintf("%s[%d] %s: %s%s",
84 0 0       0 $timestamp, $$, $level, $msg, $eol));
85             defined $nwrite or warn "error writing to log file: $!";
86 0         0 }
87              
88 0 0       0 my ($self) = @_;
89             }
90              
91             1;