################################################################################ # # # ############################################################################ # # # Title : Data::Logger.pm # # # # Description : A logger coded for the camman script. # # # # Coded by : Justin Lee # # # # Version : 0.2.1 # # # # Date : Saturday, February 9, 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'}; return unless exists $log->{'method'}; return unless defined $log->{'method'}; $log->{'name'} = method_parse($log->{'basedir'},$log->{'method'}); $log->{'handle'} = new FileHandle $log->{'handle'}, '>'; return unless defined $log->{'log'}{'handle'}; return bless $log, $type; } sub date_decode { # 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 $method = shift; if (ref($method) eq 'HASH') { # might change this to something more awesome later return %datetime; } else { while ($method =~ /\%(\w)/o) { my $current = $1; if (exists $datetime{$current}) { $method =~ s/\%$current/$datetime{$current}/g; } else { $method =~ s/\%$current//g; } } return $method; } } } sub method_parse { my ($basedir,$method,$Oh_God_A_Count) = (shift,shift,0); my @to_create = split(/\\|\//,$method); pop(@to_create); # ditch file name my $decode = date_decode(now); foreach my $dir ($basedir,@to_create) { $dir = $decode->($dir); mkdir($dir,0777) or die unless -d $dir; chdir($dir) or die; ++$Oh_God_A_Count; } for (; $Oh_God_A_Count > 0; $Oh_God_A_Count--) { chdir('..') or die; } return $decode->($basedir . '/' . $method); } sub print_header { my $log = shift; } sub close { my $log = shift; $log->{'handle'}->close; } # who needs log() anyway? sub log { my $log = shift; } # ONE!!!!! 1;