################################################################################
# #
# ############################################################################ #
# # 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.5.0-PRE # #
# # Date : Monday, March 3, 2008 # #
# # License : GNU General Public License v.2 # #
# # Copyright (C) 2008 Justin Lee <kool.name at gmail.com> # #
# ############################################################################ #
# #
# ############################################################################ #
# # 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: <http://www.gnu.org/licenses/> # #
# ############################################################################ #
# #
################################################################################
package Data::Logger;
use strict;
use warnings;
use subs qw(
die print
warn close
debug log
);
our(@ISA,@EXPORT_OK);
BEGIN {
require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw( _skew section_title );
}
use Carp;
use FileHandle;
use File::Basename;
use File::Find;
use Class::Date qw(now);
# setup some global tokens
my %TOKE = (
A => { # message
val => undef,
onoff => 1
},
F => { # users current "function title"
val => undef,
onoff => 0
},
S => { # users script name, doesn't need to be anything special
val => basename($main::0), #'super cool script.pl', #'fake name',
onoff => 1
},
L => { # log level: info, debug, warning, fatal
val => undef,
onoff => 1
},
E => { # $! from the users script, or custom error message
val => undef,
onoff => 1
},
Y => {
val => _mk_dt('year'),
onoff => 1
},
M => {
val => _mk_dt('month'),
onoff => 1
},
D => {
val => _mk_dt('day'),
onoff => 1
},
h => {
val => _mk_dt('hour'),
onoff => 1
},
m => {
val => _mk_dt('minute'),
onoff => 1
},
s => {
val => _mk_dt('second'),
onoff => 1
}
); # Y, M, D, h, m, and s are ugly but work
# start of the OO interface
sub new {
my $class = shift;
my $self = { _setup(@_) };
return if exists $self->{ERR};
return bless $self, $class;
}
sub _setup {
my $stp = shift;
my %slf = (
stamp => '[%h:%m:%s] (%L){'."\t".'%F} - %A{ ( %E )}',
level => 2,
);
unless (defined $stp) { $stp = {}; }
unless (ref $stp eq 'HASH') { return ( ERR => 1 ); }
unless (exists $stp->{Directory}
and defined $stp->{Directory}) { $stp->{Directory} = _skew(@{[ fileparse($main::0) ]}[1],'logs'); }
unless (-d $stp->{Directory}) { mkdir(_skew($stp->{Directory}),0777) or return ( ERR => 1 ); }
if (exists $stp->{Level}
and defined $stp->{Level}) { $slf{level} = int($stp->{Level}); }
if (exists $stp->{To_Keep}
and defined $stp->{To_Keep}) { _keep_logs(int($stp->{To_Keep})) or return ( ERR => 1 ); }
if (exists $stp->{String}
and defined $stp->{String}) { $slf{string} = $stp->{String}; }
if (exists $stp->{Sectional}
and defined $stp->{Sectional}) { $TOKE{F}->{onoff} = 1; section_title(); }
if (exists $stp->{Dated_Directories}
and $stp->{Dated_Directories}) {
unless (exists $stp->{File_Name} # if only this part could have been more pretty
and defined $stp->{File_Name}) { $stp->{File_Name} = _detoke('%h;%m;%s')); }
$stp->{Directory} = _skew($stp->{Directory},_detoke('%Y-%M-%D'));
mkdir($stp->{Directory},0777) or return ( ERR => 1 );
}
unless (exists $stp->{File_Name}
and defined $stp->{File_Name}) { $stp->{File_Name} = _detoke('%Y-%M-%D %h;%m;%s'); }
else { $stp->{File_Name} = _detoke($stp->{File_Name}); }
$slf{handle} = new FileHandle;
$slf{handle}->open(_skew($stp->{Directory},$stp->{File_Name}),'>');
$slf{fllpth} = _skew($stp->{Directory},$stp->{File_Name});
return ( ERR => 1 ) unless defined $slf{handle};
print(\%slf,'info',
}
sub _detoke {
my $smokin = shift;
$smokin =~ s/(?<!\\)\{(.*?)(?<!\\)\}/_block_decode($1)/ge; #wrapper
$smokin =~ s/(?<!\\)\%(.)/_decode($1)/ge;
$smokin =~ s/(?<!\\)\\(.)/$1/g;
return $smokin;
}
sub _decode {
my $tok = shift;
if (exists $TOKE{$tok} and $TOKE{$tok}->{onoff}) { # exists & active
if (defined $TOKE{$tok}->{val}) { # defined
return &{$TOKE{$tok}} if ref $TOKE{$tok} eq 'CODE';
return $TOKE{$tok};
} else {
return '?'; # active, but no value (suggests problem)
}
} else {
return; # doesn't exist or not active
}
}
sub _block_decode {
my $blk = shift;
if ($blk =~ /(?<!\\)\%(.)/o) { # first succeeds and all are parsed
my $dcd = _decode($1);
if ($dcd and $dcd ne '?') {
return $blk; # first token succeeded, send it all back for parsing
}
}
return; # no first token, or it failed
}
sub _mk_dt {
my $gm = shift or return;
return sub {
my %dt;
@dt{
qw(
year #0
month #1
day #2
hour #3
minute #4
second #5
)
} = split(/(?:\s|:|-|;)+/,now);
return $dt{lc($gm)};
}
}
sub _skew { # murder stupid paths
my $skew = join('/',@_);
$skew =~ s/(?:\\|\/)+/\//go;
return $skew;
}
sub _
sub print {
my $self = shift;
@TOKE{qw(L A)} = (uc(shift),_parse_msg(@_));
$self->{handle}->print(_decode($self{stamp}));
@TOKE{qw(L A)} = ('','');
}
sub section_title {
$TOKE{S} = pop or 'main'; # hide from self
}
sub close {
my $self = shift;
print $self, 'info', 'Well, it\'s been fun!';
$self->{handle}->close;
return 1;
}
sub note {
log(@_);
}
sub log {
my $self = shift;
return unless $self->{level} > 0;
print $self, 'info', @_;
}
sub debug {
my $self = shift;
return unless $self->{level} > 1;
print $self, 'debug', @_;
}
sub warn {
my $self = shift;
print $self, 'warning', @_;
carp join(' ',@_);
}
sub die {
my $self = shift;
print $self, 'fatal', @_;
$self->{handle}->close;
croak join(' ',@_);
}
1;