#!/usr/bin/perl
# ----------------------------------------------------------------------------
# This software is Copyright (C) 2007, All Rights Reserved
# ----------------------------------------------------------------------------
# This program is protected by local and international copyright laws. Any
# use of this program is subject to the the terms of the license agreement
# included as part of this distribution archive. Any other uses are strictly
# prohibited without the written permission of the Vendor and all
# other rights are reserved.
# -----------------------------------------------------------------------------
# Warning : Modifying this program violates your license agreement!
# -----------------------------------------------------------------------------

package IT::Error;

use strict;

use IT::Globals;

# user defined globals (set by Init call)
use vars qw(@REQUIRED_USER_DEFINED_GLOBALS $ERROR_LOG_FILEPATH $MAX_ERROR_LOG_BYTES);
@REQUIRED_USER_DEFINED_GLOBALS = qw(ERROR_LOG_FILEPATH);
$MAX_ERROR_LOG_BYTES = 50_000;

# library globals
use vars qw($INIT_CALLED);
$INIT_CALLED  = 0;           # indicated whether init() has been called or not

# ----------------------------------------------------------------------------
# Function    : init
# Description : define filepaths and globals required by library
# Usage       : &init({
#                 'ARGUMENT' => "$value",
#               });
#
# Note: Don't call any functions that call &die_unless_init_called()
#       from this function because then we'll get a confusing error about the init
#       function not being called instead of the actual error.
# ----------------------------------------------------------------------------

sub init {
  my $args = shift;
  if (!$args)                     { die("no arguments specified!"); }
  if (ref $args ne 'HASH')        { die("args must be passed by hash ref!"); }

  # error checking
  my($thisSubroutine) = (caller(0))[3];
  foreach (@REQUIRED_USER_DEFINED_GLOBALS) {
    unless (exists $args->{$_}) { &IT::Error::dieAsCaller("required $thisSubroutine argument '$_' not defined"); }
  }

  # set user defined globals
  $ERROR_LOG_FILEPATH  = $args->{'ERROR_LOG_FILEPATH'};
  $MAX_ERROR_LOG_BYTES = $args->{'MAX_ERROR_LOG_BYTES'} if $args->{'MAX_ERROR_LOG_BYTES'};

  # error checking
  if ($MAX_ERROR_LOG_BYTES ne int($MAX_ERROR_LOG_BYTES)) { die "\$MAX_ERROR_LOG_BYTES must be an integer!"; }

  # make sure datafile is writable
  open(ERROR_LOG, ">>$ERROR_LOG_FILEPATH") || die "Can't write to '$ERROR_LOG_FILEPATH' : $!";  #-- skip syntax check --#
  close(ERROR_LOG);

  # set sub globals
  $INIT_CALLED = 1;

}

# ----------------------------------------------------------------------------
# Function    : die_unless_init_called()
# Description : Dies unless &init() has been called.  This is called
#               first by many public function to make sure the init function
#               for the module has been called.
# Usage       : &die_unless_init_called();
# Usage       : &IT::Error::die_unless_init_called();
# ----------------------------------------------------------------------------

sub die_unless_init_called {
  if ($INIT_CALLED) { return; }

  my($subroutine) = (caller(1))[3];
  &IT::Error::dieAsCaller("You must call &IT::Error::init() before calling $subroutine", 2);
}

# ---------------------------------------------------------------------------------
# Function    : dieAsCaller
# Description : die from perspective of the caller showing the filepath and line
#               number of the calling code and not the line number of the die statement.
# Usage       : &IT::Error::dieAsCaller($message, $depth);
# ---------------------------------------------------------------------------------

sub dieAsCaller ($;$) {
  my $error = shift;
  my $depth = shift || 1; # 1 is first caller, 2 is second caller, etc

  my($package, $filename, $line, $subroutine) = caller($depth);

  die "$error at $filename line $line\n";
}

# ----------------------------------------------------------------------------
# Function    : dieOnValidationErrors
# Description : dies if the variables passed don't match the "validation rules".
#               Note: For tight loops where performance is important it's faster
#               to write your own custom error checking code.
# Usage       : &IT::Error::dieOnValidationErrors(
#                 [label, value, validation rules],   # [ varName, varValue, validation rules ]
#                 ["\$var", $var, "allowBlank oneOf(true, false)"],
#               );
# ----------------------------------------------------------------------------

sub dieOnValidationErrors {
  my @tests = @_;
  my $errors;

  # debug
#  my($subroutine, $line) = ((caller(1))[3], (caller(0))[2]);
#  print "dieOnValidationErrors called from $subroutine on line $line\n";

  # run tests
  foreach my $test (@tests) {
    if (ref $test ne 'ARRAY') { die "test must be an array reference!"; }
    my($name, $value, $validationRules) = @$test;
    $errors .= &IT::Validation::validationError($name, $value, $validationRules);
  }

  if ($errors) { &IT::Error::dieAsCaller($errors, 2); }

}

# ----------------------------------------------------------------------------
# Function    : logError
# Description : write errors to a logfile
# Usage       : &IT::Error::logErrorAndDie('error message', 'extra details', $asCallerDepth);
# ----------------------------------------------------------------------------

sub logError {
  my $errorMessage = shift;
  my $errorDetails = shift;
  my $callerDepth  = shift;
  $errorMessage =~ s/\s+$//s;  # removing trailing nextlines
  &die_unless_init_called();

  my $errorlog;

  # load log contents
  if (-f $ERROR_LOG_FILEPATH) {
    my $fh = do { local *FILEHANDLE; *FILEHANDLE }; # create a locally scoped variable
    open($fh, "<$ERROR_LOG_FILEPATH") || die "logError: Can't open '$ERROR_LOG_FILEPATH' ($errorMessage - $errorDetails)";
    read($fh, $errorlog, -s $fh);
    close($fh);
  }

  # add new error to log
  my $timestamp = gmtime() . "(GMT)";
  my($filename)   = (caller(0 + $callerDepth))[1];
  my($subroutine) = (caller(1 + $callerDepth))[3];
  my $line        = (caller(0 + $callerDepth))[2];
#  if (!$subroutine) {  # this was for getting caller details when called from the main block (not in a sub)
#    ($filename, $line, $subroutine) = ((caller(1 + $callerDepth))[1,2], "");
#  }
  $errorlog .= "$timestamp (PID $$) $subroutine at line $line ($filename)\n";
  $errorlog .= "$errorMessage\n";
  $errorlog .= "$errorDetails\n" if $errorDetails;
  $errorlog .= "\n";

  # truncate error log
  while (length $errorlog > $MAX_ERROR_LOG_BYTES) { $errorlog =~ s/^.*?\n\n//s; } # remove line

  # save back error log
  my $fh = do { local *FILEHANDLE; *FILEHANDLE }; # create a locally scoped variable
  open($fh, ">$ERROR_LOG_FILEPATH") || die "logError: Can't write '$ERROR_LOG_FILEPATH' ($errorMessage - $errorDetails)";
  binmode($fh);
  print $fh $errorlog;
  close($fh);

}

# ----------------------------------------------------------------------------
# Function    : logErrorAndDie
# Description : write errors to a logfile and dies.  Extra details
#               are not passed to die.
# Usage       : &IT::Error::logErrorAndDie('error message', 'extra details', $asCallerDepth);
# ----------------------------------------------------------------------------

sub logErrorAndDie {
  my $errorMessage = shift;
  my $errorDetails = shift;
  my $callerDepth  = shift() + 1;

  if ($INIT_CALLED) {
    &logError($errorMessage, $errorDetails, $callerDepth);
  }
  else {  # init not called yet so just die
    my $thisPackage = (caller(0))[0];
    $errorMessage  .= "\nAdditionally &${thisPackage}::init() wasn't called yet so error logging is disabled";
  }

  die $errorMessage;

}

# ----------------------------------------------------------------------------
# end of file
1;

