################################################################################ # # # ############################################################################ # # # Title : Data::Logger.pm # # # # Description : A super simple logger, you don't actually need to tell it # # # # a single thing. # # # # Coded by : Justin "I'm Really Tired Now" Lee # # # # Version : 0.4.0-RC4 # # # # Date : Monday, March 3, 2008 # # # # License : GNU General Public License v.2 # # # # Copyright (C) 2008 Justin Lee # # # ############################################################################ # # # # ############################################################################ # # # This program is free software; you can redistribute it and/or # # # # modify it under the terms of the GNU General Public License version 2 # # # # as published by the Free Software Foundation. # # # # # # # # This program is distributed in the hope that it will be useful, # # # # but WITHOUT ANY WARRANTY; without even the implied warranty of # # # # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # # # # GNU General Public License for more details. # # # # # # # # You should have received a copy of the GNU General Public License # # # # along with this program; if not, write to the Free Software # # # # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # # # # 02110-1301, USA. Or, see: # # # ############################################################################ # # # ################################################################################ package Data::Logger; use strict; use warnings; use subs qw( die log warn close debug time print ); our(@ISA,@EXPORT_OK); BEGIN { require Exporter; @ISA = qw(Exporter); @EXPORT_OK = qw( _skew set_title ); } use Carp; use FileHandle; use File::Basename; use File::Find; use Class::Date qw(now); my %TOKE = ( N => 'Data::Logger', S => '', O => basename($main::0), Y => sub { @{[ split(/(?:\s|:|-)+/,now) ]}[0] }, M => sub { @{[ split(/(?:\s|:|-)+/,now) ]}[1] }, D => sub { @{[ split(/(?:\s|:|-)+/,now) ]}[2] }, h => sub { @{[ split(/(?:\s|:|-)+/,now) ]}[3] }, m => sub { @{[ split(/(?:\s|:|-)+/,now) ]}[4] }, s => sub { @{[ split(/(?:\s|:|-)+/,now) ]}[5] }, ); # Y, M, D, h, m, and s are ugly but work sub new { my $class = shift; my $self = { _setup(@_) }; return if exists $self->{ERR}; return bless $self, $class; } sub _setup { my $stp = shift; my %slf = ( D => _skew(@{[ fileparse($main::0) ]}[1],'logs'), L => 2, N => '%Y-%M-%D %h;%m;%s.log', K => 5, S => '%Y-%M-%D %h:%m:%s', ); unless (defined $stp) { $stp = {}; } unless (ref $stp eq 'HASH') { return ( ERR => 1 ); } if (exists $stp->{Directory} and defined $stp->{Directory}) { $slf{D} = $stp->{Directory}; } if (exists $stp->{Level} and defined $stp->{Level}) { $slf{L} = $stp->{Level}; } if (exists $stp->{Keep} and defined $stp->{Keep}) { $slf{K} = $stp->{Keep}; } if (exists $stp->{Format} and defined $stp->{Format}) { $slf{N} = $stp->{Format}; } if (exists $stp->{Stamp} and defined $stp->{Stamp}) { $slf{S} = $stp->{Stamp}; } if (exists $stp->{Name} and defined $stp->{Name}) { $TOKE{O} = $stp->{Name}; } unless (-d $slf{D}) { mkdir($slf{D},0777) or return ( ERR => 1 ); } $slf{H} = new FileHandle; $slf{H}->open(_skew($slf{D},_decode($slf{N})),'>'); _log_print(\%slf,'info','thanks for using Data::Logger! ..'); return %slf; } sub _decode { my $tdc = shift; while ($tdc =~ /\%(\S)/o) { my $tok = $1; if (exists $TOKE{$tok} and defined $TOKE{$tok}) { if (ref $TOKE{$tok} eq 'CODE') { $tdc =~ s/\%$tok/&{$TOKE{$tok}}/eg; } else { $tdc =~ s/\%$tok/$TOKE{$tok}/g; } } else { $tdc =~ s/\%$tok//g; } } return $tdc; } sub _set_flag { } sub _log_print { my $self = shift; $TOKE{F} = uc(shift); my $msg = join(' ',@_); $self->{H}->print(_decode($slf{S}) . "\u$msg.\n"); } sub _skew { my $skew = join('/',@_); $skew =~ s/(?:\\|\/)+/\//go; return $skew; } sub set_title { $TOKE{S} = pop or 'main'; # hide from self } sub time { my $self = shift; if (ref $self eq 'HASH') { return _decode($self->{S}); } else { return _decode($self); } } sub close { my $self = shift; _log_print($self,'info','well, it\'s been fun! ..'); $self->{H}->close; return 1; } sub note { log(@_); } sub log { my $self = shift; return unless $self->{L}; _log_print($self,'info',@_); } sub debug { my $self = shift; return unless $self->{L} > 1; _log_print($self,'debug',@_); } sub warn { my $self = shift; _log_print($self,'warning',@_); carp join(' ',@_); } sub die { my $self = shift; _log_print($self,'fatal',@_); $self->{H}->close; croak join(' ',@_); } 1;