PRETTY BUT NOT FUNCTIONAL

################################################################################
#                                                                              #
# ############################################################################ #
# # 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-RC0                                                  # #
# # 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;

our(@ISA,@EXPORT_OK);
BEGIN {
  require Exporter;
  @ISA = qw(Exporter);
  @EXPORT_OK = qw( _skew );
}

use Carp;
use FileHandle;
use File::Basename;
use File::Find;
use Class::Date qw(now);



 #######################################
 #                                 ##
 # ################################
 ### START OF THE OBJECT INTERFACE

sub new {
  my $class = shift;
  my $self = { _setup(@_) };
  return if exists $self->{ERR};
  return bless $self, $class;
}



 #############################
 #                       ##
 # ######################
 ### THE _SETUP FUNCTION

sub _setup {
  my $stp = shift;
  my %slf = (
    stamp => '[%h:%m:%s] (%L)'."\t".'- {[%F]}{ %A}{ [ERROR] %E}',
    level => 2,
    lpath => _skew(@{[ fileparse($main::0) ]}[1],'logs'),
    token => { _have_a_toke_man() }
  );

  unless (defined $stp)              { $stp = {}; }
  unless (ref     $stp eq 'HASH')    { return ( ERR => 1 ); }
  if     (defined $stp->{Level})     { $slf{level} = int($stp->{Level}); } # I don't even trust my mom
  if     (defined $stp->{String})    { $slf{stamp} = $stp->{String}; }
  if     (defined $stp->{Sectional}) { $slf{token}->{S}->{toe} = 1; }
  if     (defined $stp->{Directory}) { $slf{lpath} = _skew($stp->{Directory}); }
  if     (defined $stp->{To_Keep})   { unless(_housekeep($slf{lpath},int($stp->{To_Keep}))) { return ( ERR => 1 ); } }
  unless (-d      $slf{lpath})       { unless(mkdir($slf{lpath},0777)) { return ( ERR => 1 ); } }

  if (defined $stp->{Dated_Directories}) {
    unless (defined $stp->{File_Name}) {
      $stp->{File_Name} = '%h;%m;%s.log';
    }

    $slf{lpath} = _skew($slf{lpath},_decode('%Y-%M-%D'));
    unless(mkdir($slf{lpath},0777)) { return ( ERR => 1 ); }
  }

  $stp->{File_Name} = defined $stp->{File_Name}  ?
                      _decode($stp->{File_Name}) :
                      _decode('%Y-%M-%D %h;%m;%s.log');

  $slf{lpath}  = _skew($slf{lpath},$stp->{File_Name});
  $slf{handle} = new FileHandle;
  $slf{handle}->open($slf{lpath},'>');
  defined($slf{handle}) or return ( ERR => 1 );

  return %slf;
}



 ##################################
 #                            ##
 # ###########################
 ### RANDOM AWESOME FUNCTIONS

sub _skew { #murder stupid paths
  my $skew = join('/',@_);
  $skew =~ s/(?:\\|\/)+/\//go;
  return $skew;
}



 #########################
 #                   ##
 # ##################
 ### TOKEN FUNCTIONS

sub _decode {
  my $smk = shift;
  $smk =~ s/(?<!\\)\{(.*?)(?<!\\)\}/
  $smk =~ s/(?<!\\)\%(.)/_detoke($1)/ge;
  $smk =~ s/(?<!\\)\\(.)/$1/g;
  return $smk;
}

sub _detoke {
  my $tik = shift;
  my $tak = shift;
  if (exists $tik->{$tak} and $tik->{$tak}->{toe}) { # exists & active
    if (defined $tik->{$tok}->{val}) { # defined
      if (ref $tik->{$tok}->{val} eq 'CODE') {
        return &{$tik->{$tok}->{val}};
      } else {
        return $tik->{$tok}->{val};
      }
    } else {
      return '?'; # active, but no value (suggests problem)
    }
  } else {
    return ''; # doesn't exist or not active
  }
}

sub _mk_dt {
  my $gm = shift or return;
  return sub {
    my %dt;
    @dt{
      qw( year
          month
          day
          hour
          minute
          second )
    } = split(/(?:\s|:|-|;)+/,now);

    return scalar $dt{lc($gm)};
  }
}

sub _have_a_toke_man {
  return (
    A => { # message
      val => '',
      toe => 1
    },
    F => { # function title
      val => '',
      toe => 0
    },
    S => { # script name
      val => basename($main::0), #'super cool script.pl', #'fake name',
      toe => 1
    },
    L => { # log level
      val => '',
      toe => 1
    },
    E => { # error message
      val => '',
      toe => 0
    },
    Y => {
      val => _mk_dt('year'),
      toe => 1
    },
    M => {
      val => _mk_dt('month'),
      toe => 1
    },
    LETS_GET_DRUGS => {
      val => 'zeke',
      toe => 0
    },
    D => {
      val => _mk_dt('day'),
      toe => 1
    },
    h => {
      val => _mk_dt('hour'),
      toe => 1
    },
    m => {
      val => _mk_dt('minute'),
      toe => 1
    },
    s => {
      val => _mk_dt('second'),
      toe => 1
    }
  )
}



 ################################
 #                          ##
 # #########################
 ### CORE LOGGING FUNCTIONS

sub print {
}



 ##########################
 #                    ##
 # ###################
 ### OBJECT FUNCTIONS

sub close {
  my $log = shift;

  $log->print({
    MSG => shift,
    LVL => 'INFO'
  });
  $log->{handle}->close;
}

sub log { #alias for note()
  note(@_);
}

sub note {
  my $log = shift;

  $log->print({
    MSG => shift,
    LVL => 'INFO'
  });
}

sub debug {
  my $log = shift;

  $log->print({
    MSG => shift,
    LVL => 'DEBUG'
  });
}

sub warn {
  my $log = shift;

  $log->print({
    MSG => shift,
    LVL => 'WARN',
    ERR => shift
  });
  carp '';
}

sub die {
  my $log = shift;

  $log->print({
    MSG => shift,
    LVL => 'FATAL',
    ERR => shift
  });
  croak '';
}

1;