Data::Logger.pm

####
#### .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  <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(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;