################################################################################
#                                                                              #
# ############################################################################ #
# # 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.6.0-PRE                                                  # #
# # Date        : Tuesday, March 4, 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);



 #####################
 # ##############
 ### "CONSTANTS"

my @LEVELS = (
  'fatal|warn(?:ing)|d(?:ie|eath)',
  'info(?:rmation)|log|note',
  'debug'
);




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

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



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

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

  unless (defined $stp)
    { $stp = {}; }

  unless (ref $stp eq 'HASH')
    { return ( ERR => 1 ); }

  if (defined $stp->{Level})
    { $log{level} = int($stp->{Level}); } # I don't even trust my mom

  if (defined $stp->{String})
    { $log{stamp} = $stp->{String}; }

  if (defined $stp->{Sectional})
    { $log{token}->{S}->{toe} = 1; }

  if (defined $stp->{Directory})
    { $log{lpath} = _skew($stp->{Directory}); }

  if (defined $stp->{To_Keep})
    { unless (_housekeep($log{lpath},int($stp->{To_Keep}))) { return ( ERR => 1 ); } }

  unless (-d $log{lpath})
    { unless (mkdir($log{lpath},0777)) { return ( ERR => 1 ); } }

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

      $log{lpath} = _skew($log{lpath},_decode('%Y-%M-%D'));

      unless (mkdir($log{lpath},0777))
        { return ( ERR => 1 ); }
    }

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

  $log{lpath}  = _skew($log{lpath},$stp->{File_Name});
  $log{handle} = new FileHandle;
  $log{handle}->open($log{lpath},'>');

  unless (defined $log{handle})
    { return ( ERR => 1 ); }

  return %log;
}



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

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



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


   ############
   # internal #
   ############

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

sub _deblock {
  my $blk = shift;

  if ($blk =~ /(?<!\\)\%(.)/o) {
    my $we_got_drugs = _detoke($1);
    if ($we_got_drugs and $we_got_drugs ne '?') {
      return $blk;
    }
  }

  return '';
}

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 _update_tokens {
  my $tik = shift;
  my $tok = shift;
  
}

sub _mk_dt_obj_thg {
  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_obj_thg('year'),
      toe => 1
    },
    M => {
      val => _mk_dt_obj_thg('month'),
      toe => 1
    },
    LETS_GET_DRUGS => {
      val => 'lets get drugs!',
      toe => 0
    },
    D => {
      val => _mk_dt_obj_thg('day'),
      toe => 1
    },
    h => {
      val => _mk_dt_obj_thg('hour'),
      toe => 1
    },
    m => {
      val => _mk_dt_obj_thg('minute'),
      toe => 1
    },
    s => {
      val => _mk_dt_obj_thg('second'),
      toe => 1
    }
  );
}


   ############
   # external #
   ############

sub last {
  my $log = shift;
  my %LST = (
    'ERR' => _get_tok('E'),
    'MSG' => _get_tok('A'),
    'LVL' => _get_tok('L')
  );

# will use closure to provide the user
# with a hash ref, think: $last_log = $log->last;
# print $last_log->{'ERR'};
# but this may not be needed as they gave -us- that error >.>
# whatever
}

sub reset {
 ## will reset all pertinent tokens
}



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

sub print {
  my $log = shift;
  $log->reset;

  $log->{token} = _update_tokens(shift);
}



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

sub LOGCLOSE {
  my $log = shift;

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

  $log->{handle}->close;
}

sub LOGNOTE {
  my $log = shift;

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

sub LOGDEBUG {
  my $log = shift;

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

sub LOGWARN {
  my $log = shift;

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

  carp $log->last->('ERR');
}

sub LOGDIE {
  my $log = shift;

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

  $log->{handle}->close;
  croak $log->last->('ERR');
}



 #################################
 # ##########################
 ### OBJECT FUNCTION ALIASES

sub LOGPRINT { shift->print (@_); }
sub raw   { shift->print    (@_); }
sub log   { shift->LOGNOTE  (@_); }
sub die   { shift->LOGDIE   (@_); }
sub warn  { shift->LOGWARN  (@_); }
sub close { shift->LOGCLOSE (@_); }
sub debug { shift->LOGDEBUG (@_); }
sub note  { shift->LOGNOTE  (@_); }
sub DEBUG { shift->LOGDEBUG (@_); }
sub WARN  { shift->LOGWARN  (@_); }
sub DIE   { shift->LOGDIE   (@_); }
sub LOG   { shift->LOGNOTE  (@_); }
sub NOTE  { shift->LOGNOTE  (@_); }
sub PRINT { shift->print    (@_); }
 # add yer own!!! PARRTYYYYYY!!



 #####################
 # ##############
 ### ONE!!!1 ... 

1;