###############################################################################
#                                                                             #
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# # Title       : Data::Logger.pm                                           # #
# # Description : A super simple logger, you don't actually need to tell i  # #
# #               a single thing.                                           # #
# # Coded by    : Justin "I'm Really Tired Now" Lee                         # #
# # Version     : 0.8.0-PRE                                                 # #
# # Date        : Thursday, March 20, 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/>               # #
# ########################################################################### #
#                                                                             #
###############################################################################



   ###############################
  ## ########################
###### MODULE PREAMBLE

package Data::Logger;

use strict;
use warnings;
use subs qw( skew );

use Carp;
use Deans::Functions qw( skew housekeep );
use FileHandle;
use File::Basename;
use File::Find;
use Class::Date qw(now);



   ##########################################
  ## ###################################
###### `GLOBAL' VARIABLES AND CONSTANTS

use constant {
  DEFAULT_LEVEL => 2,
  DEFAULT_STRING => '\\[%h:%m:%s\\] [(%F)] %L:[ %A]'
};

my @LVL = ( # now with less evil
  '^one|first|(?:warn(?:ing)?|err(?:(?:o|0)r)?|fatal|d(?:ie|eath))(?:s|z)?|1$',
  '^(?:log(?:ging)?|noted?|info(?:rmation)?)(?:s|z)?|second|two|2$',
  '^third|debug(?:g?(?:er|ing))?(?:s|z)?|all|three|3$'
};

my %TOK = ( # global tokens
  1 => '\\',
  2 => '%',
  3 => '[',
  4 => ']',
  5 => '|',
);

my @ORD = qw(
  MSG
  LVL
  ERR
  FNC
);



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

sub new {
  my ($class,$config) = @_;

  my $log = {
    _setup($config,caller);
  };

  return if exists $log->{ERR};
  return bless $log, $class;
}



   ###############################
  ## ########################
###### THE _SETUP FUNCTIONZ

 #####
 # determines whether to run in
 # explicit mode (meaning the user
 # must specify all their info) or
 # simple mode (meaning if a piece
 # of information is left out, a
 # default is used
sub _stp_mode {
  my ($stp) = @_;
  if (exists $stp->{Explicit} and $stp->{Explicit}) {
    return 1;
  } else {
    return 0;
  }
}

 #####
 # sets the logging level to
 # use, can be overriden by the
 # user at log time
sub _stp_level {
  my ($stp) = @_;
  if (defined $stp->{Level}) {
    for (my $i = 0; $i < $#LVL; $i++) {
      return $i if $stp->{Level} =~ /$LVL[$i]/i;
    }
  }

  return if _stp_mode($stp); #explicit

  return DEFAULT_LEVEL;
}

 #####
 # duh
sub _stp_string {
  my ($stp) = @_;
  return _charachangi($stp->{String}) if defined $stp->{String};

  return { ERR => 'EXP' } if _stp_mode($stp); #explicit

  return DEFAULT_STRING;
}

 #####
 # finds the correct path to use,
 # if 'Dated' is set, then it will
 # use (or create) directories with
 # the current date (yyyy-mm-dd) and
 # store the log files there
 # if any step fails the logger dies
 # (even with out explicit) cause you
 # know, it would just be retarded to
 # continue... with the exception of 
 # 'Path', we can guess that if we have to
sub _stp_path {
  my ($stp,$tok) = @_;
  if (not defined $stp->{Path}) {
    return { ERR => 'EXP' } if _stp_mode($stp); #explicit

    $stp->{Path} = DEFAULT_dir;
    mkdir($stp->{Path},0777) or return { ERR => 'FAILURE: MKDIR' };
  }
  if (defined $stp->{Dated}) {
    $stp->{Path} = skew $stp->{Path}, decode('%Y-%M-%D',$tok);
    mkdir($stp->{Path},0777) or return { ERR => 'FAILURE: MKDIR' };
  }

  return $stp->{Path} if -d $stp->{Path};
  return { ERR => 'ERROR: PATH NOT DIR' };
}

 #####
 # use housekeep to remove all
 # but the last 'Keep' logs,
 # if you catch my meaning
sub _stp_clean_house {
  my ($stp,$dir) = @_;
  if (defined $stp->{Keep}) {
    return { ERR => 'FAILURE: HOUSEKEEPING' } unless housekeep(
      $dir,
      int($stp->{Keep}), # I don't even trust my mom.
      1
    );
  }

  return 1;
}

 #####
 # on it's own because it both
 # annoys and desmozes me....
 # desmozes?
sub _stp_tokes {
  return (
    A => undef,
    F => [0,undef],
    T => undef,
    L => undef,
    Y => _mk_dt_obj_thg('year'),
    M => _mk_dt_obj_thg('month'),
    LETS_GET_DRUGS => 'zeke',
    D => _mk_dt_obj_thg('day'),
    h => _mk_dt_obj_thg('hour'),
    m => _mk_dt_obj_thg('minute'),
    s => _mk_dt_obj_thg('second'),
  );
}

 #####
 # build the token hash
sub _stp_tokens {
  my ($stp,$caller) = @_;
  my $tok = _have_a_toke_man();

  if (defined $stp->{Functional}) {
    $tok->{F}->{toe} = 1;
  }
  if (defined $stp->{Title}) {
    $tok->{T}->{val} = $stp->{Title};
  } else {
    $tok->{T}->{val} = $caller;
  }

  return $tok;
}

 #####
 # test the setup for ERRROORRRZZZZzz
 # if there's an error return it, else
 # return the log
sub _stp_can_has_errors {
  return 0; # to be done
}

 #####
 # sadly the cake was a lie :(
sub _setup {
  my ($stp,$caller) = @_;

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

  my %log;
  $log->{Handle}   = new FileHandle;
  $log->{Level}    = _stp_level($stp);
  $log->{String}   = _stp_string($stp);
  $log->{Token}    = _stp_tokens($stp,$caller);
  $log->{Path}     = _stp_path($stp,$log->{Token});
  $log->{Explicit} = _stp_mode($stp);

  $log->{Handle}->open($log->{Path},'>');

  return _stp_can_has_errors(%log);
}



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

 #####
 # removes all escaped characters
 # so that they aren't picked up
 # by the _deblock()er
sub _charachangi {
  my ($str) = @_;
  $str =~ s/\\\\/\%1/og;
  $str =~ s/\\\%/\%2/og;
  $str =~ s/\\\[/\%3/og;
  $str =~ s/\\\]/\%4/og;
  $str =~ s/|/\%5/og;
  return $str;
}

 #####
 # recursively tests "if" blocks
 # which means: if the first token
 # in the block is active and set
 # the whole block will be left for
 # parsing
 # if a string was [ %a: [ %b ] ] and
 # %a was not active & set, nothing
 # would be shown; even if the %b block
 # was active & set
 # future: implement a [%b|\%b was invalid]
 # style "or" block, if %b does not prove to
 # be active and set, use text on the otherside
 # of the | character
sub _deblock {
  my ($str) = @_;
  while ($str =~ s/\[([^\[\]]*)\]/\%0/o) {
    my $blk = $1;
    if ($blk =~ /\%([^\d])/o) {
      my $wtf = _gettoke($1);
      if ($wtf and $wtf ne '?') {
        $str =~ s/\%0/$blk/;
        next;
      }
    } else {
      $str =~ s/\%0//o;
    }
  }

  return $str;
}

 #####
 # after all blocks are evaluated
 # _detoke will interpolate all tokens
 # with their values (with help from
 # _have_a_toke_man)
sub _detoke {
  my ($str) = @_;
  $str =~ s/\%(.)/_have_a_toke_man($1)/ge;
  return $str;
}

sub _decode {
  my ($log,$str) = @_;
  $str = _deblock($log,$str);
  $str = _detoke($log,$str);
  return $str;
}

sub _have_a_toke_man {
  my ($log,$tok) = @_;
  # used to be _gettoke() but I liked
  # this name better... also needs to
  # be recoded, I have plans!
}



   #################################
  ## ##########################
###### STUFF THAT BUILDS STUFF

 #####
 # builds a date closure
 # @{qw()} = (); # ftw
sub _mk_dt_obj_thg {
  my ($gm) = @_;
  return unless defined $gm;
  return sub {
    my %dt;
    @dt{
      qw( year
          month
          day
          hour
          minute
          second )
    } = split(/(?:\s|:|-|;)+/,now);

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



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

sub print {
}

sub update {
  my ($log,@tik) = @_;
  if (ref $tik[0] eq 'HASH') {
    $log = $log->_update_tokens(map {
      exists $tik[0]->{$_} ? $tik[0]->{$_} : undef
    } @ORD);
  } else {
    $log = $log->_update_tokens(@tik)
  }

  $log or return;
  return $log;
}



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

 #####
 # these are the main aliases
sub LOGDEBUG { shift->print (); } #
sub LOGDIE   { shift->print (); }  #  to be done, need to decide how I want
sub LOGWARN  { shift->print (); }   # shift->print(); to recieve it's args,
sub LOGNOTE  { shift->print (); }  #  maybe as a hash? or keep as an array?
sub LOGPRINT { shift->print (); } #

 #####
 # that's all the main ones, these
 # are just some handy-dandy aliases
 # and you can like, add some too
 # .... if you wanted to... just...
 # putting that out there... ...
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    (); }



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

1;