#### #### .pl below #### use strict; use warnings; use File::Basename; use constant { NAME => basename($0), HOME => @{[ fileparse($0) ]}[1] }; use lib HOME . 'lib'; use Data::Logger; my $debug = new Data::Logger ({ 'basedir' => HOME, 'directory' => 'logs', 'style' => '%Y-%M-%D %h;%m;%s.log' # using '\' or '/' will cause }) or die; # directory creation and such $debug->print_header('program' => NAME); $debug->log('working'); $debug->terminate(); #### #### .pm below #### ################################################################################ # # # ############################################################################ # # # Title : Data::Logger.pm # # # # Description : A logger coded for the camman script. # # # # Coded by : Justin Lee # # # # Version : 0.2.21 # # # # Date : Wednesday, February 13, 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(log); use FileHandle; use Class::Date qw(now); sub new { my $type = shift; my $log = shift; # comes in as a hash or fails return unless ref ($log) eq 'HASH'; return unless exists $log->{'basedir'}; return unless defined $log->{'basedir'}; unless(exists $log->{'directory'} and defined $log->{'directory'}) { $log->{'directory'} = 'logs'; } unless(exists $log->{'style'} and defined $log->{'style'}) { $log->{'style'} = '%Y-%M-%D %h;%m;%s.log'; } $log->{'name'} = style_parse(map { $log->{$_} } qw(basedir directory style)); return unless defined $log->{'name'}; $log->{'handle'} = new FileHandle; $log->{'handle'}->open("> $log->{'name'}"); return bless $log, $type; } sub decode_date { # vv ISO-style date my ($date,$time) = split(/\s+/,shift); # vv ISO-style date my ($year,$month,$day) = split(/-/,$date); my ($hour,$minute,$second) = split(/:/,$time); my %datetime = ( 'Y' => $year, 'M' => $month, 'D' => $day, 'h' => $hour, 'm' => $minute, 's' => $second ); return sub { my $style = shift; if (ref($style) eq 'HASH') { # might change this to something more awesome later return %datetime; } else { while ($style =~ /\%(\w)/o) { my $tag = $1; if (exists $datetime{$tag}) { $style =~ s/\%$tag/$datetime{$tag}/g; } else { $style =~ s/\%$tag//g; } } return $style; } } } sub style_parse { my ($b_dir,$l_dir,$style) = (shift,shift,shift); foreach my $var (\$b_dir,\$l_dir,\$style) { # so this is just to clean up the input ${$var} =~ s/\\+\/*/\//go; # toothpicks of DOOM ${$var} =~ s/\/+\\*/\//go; # see above ${$var} =~ s/(?:\\|\/)+\s*$//g; # trailing toothpicks } chdir($b_dir) or return; my $decode = decode_date(now); my $path = join('/',$l_dir,$style); while ($path =~ s/^\/?(.+?)\///o) { my $dir = $decode->($1); unless (-d $dir) { mkdir($dir,0777) or return; } chdir($dir) or return; } chdir($b_dir) or return; return $decode->(join('/',$b_dir,$l_dir,$style)); } sub print_header { my $log = shift; my %my = @_; my $date = decode_date(now)->('%h:%m:%s -'); $log->{'handle'}->print( "$date Data::Logger setup for `$my{'program'}'.\n" . "$date Let the logging commence!\n") or return; return 1; } sub terminate { my $log = shift; $log->{'handle'}->close; } # who needs log() anyway? sub log { my $log = shift; my $date = decode_date(now)->('%h:%m:%s -'); my $msg = shift; $log->{'handle'}->print("$date $msg\n"); } # ONE!!!!! 1;