root/trunk/omnipitr/lib/OmniPITR/Log.pm

Revision 87, 2.8 kB (checked in by depesz, 4 years ago)

omnipitr-archive is working

Line 
1 package OmniPITR::Log;
2 use strict;
3 use warnings;
4 use English qw( -no_match_vars );
5 use Carp;
6 use File::Basename;
7 use File::Path;
8 use Data::Dumper;
9 use POSIX qw(strftime floor);
10 use IO::File;
11
12 BEGIN {
13     eval { use Time::HiRes qw( time ); };
14 }
15
16 sub new {
17     my $class = shift;
18     my ( $filename_template ) = @_;
19     croak( 'Logfile name template was not provided!' ) unless $filename_template;
20
21     my $self = bless {}, $class;
22
23     $self->{ 'template' }       = $filename_template;
24     $self->{ 'program' }        = basename( $PROGRAM_NAME );
25     $self->{ 'current_log_ts' } = 0;
26     $self->{ 'current_log_fn' } = '';
27
28     return $self;
29 }
30
31 sub _log {
32     my $self = shift;
33     my ( $level, $format, @args ) = @_;
34
35     my $log_line_prefix = $self->get_log_line_prefix();
36     my $fh              = $self->get_log_fh();
37
38     @args = map { ref $_ ? Dumper( $_ ) : $_ } @args;
39
40     my $message = sprintf $format, @args;
41     $message =~ s/\s*\z//;
42
43     for my $line ( split /\r?\n/, $message ) {
44         printf $fh '%s : %s : %s%s', $log_line_prefix, $level, $line, "\n";
45     }
46
47     $fh->flush();
48     $fh->sync();
49
50     return;
51 }
52
53 sub log {
54     my $self = shift;
55     return $self->_log( 'LOG', @_ );
56 }
57
58 sub error {
59     my $self = shift;
60     return $self->_log( 'ERROR', @_ );
61 }
62
63 sub fatal {
64     my $self = shift;
65     $self->_log( 'FATAL', @_ );
66     exit( 1 );
67 }
68
69 sub time_start {
70     my $self    = shift;
71     my $comment = shift;
72     $self->{ 'timers' }->{ $comment } = time();
73     return;
74 }
75
76 sub time_finish {
77     my $self    = shift;
78     my $comment = shift;
79     my $start   = delete $self->{ 'timers' }->{ $comment };
80     $self->log( 'Timer [%s] took: %.3fs', $comment, time() - ( $start || 0 ) );
81     return;
82 }
83
84 sub get_log_line_prefix {
85     my $self         = shift;
86     my $time         = time();
87     my $date_time    = strftime( '%Y-%m-%d %H:%M:%S', localtime $time );
88     my $microseconds = ( $time * 1_000_000 ) % 1_000_000;
89     my $time_zone    = strftime( '%z', localtime $time );
90
91     my $time_stamp = sprintf "%s.%06u %s", $date_time, $microseconds, $time_zone;
92     return sprintf "%s : %u : %s", $time_stamp, $PROCESS_ID, $self->{ 'program' };
93 }
94
95 sub get_log_fh {
96     my $self = shift;
97
98     my $time = floor( time() );
99     return $self->{ 'log_fh' } if $self->{ 'current_log_ts' } == $time;
100
101     $self->{ 'current_log_ts' } = $time;
102     my $filename = strftime( $self->{ 'template' }, localtime $time );
103     return $self->{ 'log_fh' } if $self->{ 'current_log_fn' } eq $filename;
104
105     $self->{ 'current_log_fn' } = $filename;
106     close delete $self->{ 'log_fh' } if exists $self->{ 'log_fh' };
107
108     my $dirname = dirname $filename;
109     mkpath( $dirname ) unless -e $dirname;
110     open my $fh, '>>', $filename or croak( "Cannot open $filename for writing: $OS_ERROR" );
111
112     $self->{ 'log_fh' } = $fh;
113     return $fh;
114 }
115
116 1;
Note: See TracBrowser for help on using the browser.