################################################################################
#                                                                              #
# ############################################################################ #
# # 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-PRE                                                  # #
# # 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;
use subs qw(
  die   print
  warn  close
  debug log
);

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

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


 # setup some global tokens
my %TOKE = (
  A => { # message
    val   => undef,
    onoff => 1
  },
  F => { # users current "function title"
    val   => undef,
    onoff => 0
  },
  S => { # users script name, doesn't need to be anything special
    val   => basename($main::0), #'super cool script.pl', #'fake name',
    onoff => 1
  },
  L => { # log level: info, debug, warning, fatal
    val   => undef,
    onoff => 1
  },
  E => { # $! from the users script, or custom error message
    val   => undef,
    onoff => 1
  },
  Y => {
    val   => _mk_dt('year'),
    onoff => 1
  },
  M => {
    val   => _mk_dt('month'),
    onoff => 1
  },
  D => {
    val   => _mk_dt('day'),
    onoff => 1
  },
  h => {
    val   => _mk_dt('hour'),
    onoff => 1
  },
  m => {
    val   => _mk_dt('minute'),
    onoff => 1
  },
  s => {
    val   => _mk_dt('second'),
    onoff => 1
  }
); # Y, M, D, h, m, and s are ugly but work


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

sub _setup {
  my $stp = shift;
  my %slf = (
    stamp => '[%h:%m:%s] (%L){'."\t".'%F} - %A{ ( %E )}',
    level => 2,
  );


  unless (defined $stp)              { $stp = {}; }
  unless (ref     $stp eq 'HASH')    { return ( ERR => 1 ); }
  unless (exists  $stp->{Directory}
     and  defined $stp->{Directory}) { $stp->{Directory} = _skew(@{[ fileparse($main::0) ]}[1],'logs'); }
  unless (-d      $stp->{Directory}) { mkdir(_skew($stp->{Directory}),0777) or return ( ERR => 1 ); }
  if     (exists  $stp->{Level}
     and  defined $stp->{Level})     { $slf{level} = int($stp->{Level}); }
  if     (exists  $stp->{To_Keep}
     and  defined $stp->{To_Keep})   { _keep_logs(int($stp->{To_Keep})) or return ( ERR => 1 ); }
  if     (exists  $stp->{String}
     and  defined $stp->{String})    { $slf{string} = $stp->{String}; }
  if     (exists  $stp->{Sectional}
     and  defined $stp->{Sectional}) { $TOKE{F}->{onoff} = 1; section_title(); }

  if     (exists  $stp->{Dated_Directories}
     and          $stp->{Dated_Directories}) {

    unless (exists  $stp->{File_Name} # if only this part could have been more pretty
       and  defined $stp->{File_Name}) { $stp->{File_Name} = _detoke('%h;%m;%s')); }
    $stp->{Directory} = _skew($stp->{Directory},_detoke('%Y-%M-%D'));
    mkdir($stp->{Directory},0777) or return ( ERR => 1 );
  }

  unless (exists  $stp->{File_Name}
     and  defined $stp->{File_Name}) { $stp->{File_Name} = _detoke('%Y-%M-%D %h;%m;%s'); }
  else                               { $stp->{File_Name} = _detoke($stp->{File_Name});   }

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

  print(\%slf,'info',
}

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

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

sub _block_decode {
  my $blk = shift;
  if ($blk =~ /(?<!\\)\%(.)/o) { # first succeeds and all are parsed
    my $dcd = _decode($1);
    if ($dcd and $dcd ne '?') {
      return $blk; # first token succeeded, send it all back for parsing
    }
  }

  return; # no first token, or it failed
}

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

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

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

sub _

sub print {
  my $self  = shift;
  @TOKE{qw(L A)} = (uc(shift),_parse_msg(@_));

  $self->{handle}->print(_decode($self{stamp}));
  @TOKE{qw(L A)} = ('','');
}

sub section_title {
  $TOKE{S} = pop or 'main'; # hide from self
}

sub close {
  my $self = shift;

  print $self, 'info', 'Well, it\'s been fun!';
  $self->{handle}->close;
  return 1;
}

sub note {
  log(@_);
}

sub log {
  my $self = shift;
  return unless $self->{level} > 0;

  print $self, 'info', @_;
}

sub debug {
  my $self = shift;
  return unless $self->{level} > 1;

  print $self, 'debug', @_;
}

sub warn {
  my $self = shift;

  print $self, 'warning', @_;
  carp join(' ',@_);
}

sub die {
  my $self = shift;

  print $self, 'fatal', @_;
  $self->{handle}->close;
  croak join(' ',@_);
}

1;