data-logger 4-rc3

################################################################################
#                                                                              #
# ############################################################################ #
# # 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.4.0-RC2                                                  # #
# # 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   log
  warn  close
  debug time
  print
);

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

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

my %TOKE = (
  N => 'Data::Logger',
  S => '',
  O => basename($main::0),
  Y => sub { @{[ split(/(?:\s|:|-)+/,now) ]}[0] },
  M => sub { @{[ split(/(?:\s|:|-)+/,now) ]}[1] },
  D => sub { @{[ split(/(?:\s|:|-)+/,now) ]}[2] },
  h => sub { @{[ split(/(?:\s|:|-)+/,now) ]}[3] },
  m => sub { @{[ split(/(?:\s|:|-)+/,now) ]}[4] },
  s => sub { @{[ split(/(?:\s|:|-)+/,now) ]}[5] },
); # Y, M, D, h, m, and s are ugly but work

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

sub _setup {
  my $stp = shift;
  my %slf = (
    D => _skew(@{[ fileparse($main::0) ]}[1],'logs'),
    L => 2,
    N => '%Y-%M-%D %h;%m;%s.log',
    K => 5,
    S => '%Y-%M-%D %h:%m:%s',
  );

  unless (defined $stp)                     { $stp = {}; }
  unless (ref     $stp eq 'HASH')           { return ( ERR => 1 ); }
  if     (exists  $stp->{Directory}
     and  defined $stp->{Directory}) { $slf{D} = $stp->{Directory}; }
  if     (exists  $stp->{Level}
     and  defined $stp->{Level})     { $slf{L} = $stp->{Level}; }
  if     (exists  $stp->{Keep}
     and  defined $stp->{Keep})      { $slf{K} = $stp->{Keep}; }
  if     (exists  $stp->{Format}
     and  defined $stp->{Format})    { $slf{N} = $stp->{Format}; }
  if     (exists  $stp->{Stamp}
     and  defined $stp->{Stamp})     { $slf{S} = $stp->{Stamp}; }
  if     (exists  $stp->{Name}
     and  defined $stp->{Name})     { $TOKE{O} = $stp->{Name}; }
  unless (-d      $slf{D})                  { mkdir($slf{D},0777) or return ( ERR => 1 ); }

  $slf{H} = new FileHandle;
  $slf{H}->open(_skew($slf{D},_decode($slf{N})),'>');
  _set_flag();
  _log_print(\%slf,'thanks for using Data::Logger! ..');

  return %slf;
}

sub _decode {
  my $tdc = shift;
  while ($tdc =~ /\%(\S)/o) {
    my $tok = $1;
    if (exists $TOKE{$tok} and defined $TOKE{$tok}) {
      if (ref $TOKE{$tok} eq 'CODE') {
        $tdc =~ s/\%$tok/&{$TOKE{$tok}}/eg;
      } else {
        $tdc =~ s/\%$tok/$TOKE{$tok}/g;
      }
    } else {
      $tdc =~ s/\%$tok//g;
    }
  }

  return $tdc;
}

sub _set_flag {
  $TOKE{F} = uc(shift) or 'INFO';
}

sub _log_print {
  my $self = shift;
  my $msg  = join(' ',@_);

  $self->{H}->print(_decode($slf{S}) . "\u$msg.\n");
}

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

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

sub time {
  my $self = shift;
  if (ref $self eq 'HASH') {
    return _decode($self->{S});
  } else {
    return _decode($self);
  }
}

sub close {
  my $self = shift;

  _set_flag('info');
  _log_print($self,'well, it\'s been fun! ..');
  $self->{H}->close;
  return 1;
}

sub note {
  log(@_);
}

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

  _set_flag('info');
  _log_print($self,@_);
}

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

  _set_flag('debug');
  _log_print($self,@_);
}

sub warn {
  my $self = shift;

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

sub die {
  my $self = shift;

  _set_flag('fatal');
  _log_print($self,@_);
  $self->{H}->close;
  croak join(' ',@_);
}

1;