#!/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::Date;


use strict;
use Time::Local;

# user defined globals (set by Init call)
use vars qw(@REQUIRED_USER_DEFINED_GLOBALS $SHORT_MONTH_NAMES $FULL_MONTH_NAMES $SHORT_WEEKDAY_NAMES $FULL_WEEKDAY_NAMES $SHORT_AMPM_NAMES);
use vars qw($FULL_AMPM_NAMES $ORDINALS $TIME_FORMAT $DATE_FORMAT $DATETIME_FORMAT $INIT_CALLED);
@REQUIRED_USER_DEFINED_GLOBALS = ('SHORT_MONTH_NAMES','FULL_MONTH_NAMES','SHORT_WEEKDAY_NAMES','FULL_WEEKDAY_NAMES',
                                     'SHORT_AMPM_NAMES','FULL_AMPM_NAMES','ORDINALS',
                                     'TIME_FORMAT','DATE_FORMAT','DATETIME_FORMAT',);
$INIT_CALLED  = 0;    # indicated whether init() has been called or not



# ----------------------------------------------------------------------------
# Function    : init
# Description : define filepaths and globals required by library
# Usage       : &IT::Date::init({
#                 'SHORT_MONTH_NAMES'   => [qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)],
#                 'FULL_MONTH_NAMES'    => [qw(January February March April May June July August September October November December)],
#                 'SHORT_WEEKDAY_NAMES' => [qw(Sun Mon Tue Wed Thu Fri Sat)],
#                 'FULL_WEEKDAY_NAMES'  => [qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday)],
#                 'SHORT_AMPM_NAMES'    => [qw(A P)],
#                 'FULL_AMPM_NAMES'     => [qw(AM PM)],
#                 'ORDINALS'            => [qw(0th 1st 2nd 3rd 4th 5th 6th 7th 8th 9th 10th 11th 12th 13th 14th 15th 16th 17th 18th 19th 20th 21st 22nd 23rd 24th 25th 26th 27th 28th 29th 30th 31st)],
#                 'TIME_FORMAT' => 'h:mm:ss tt',                     # let users define this in the application!
#                 'format' => 'MMM ddd, yyyy',                  # let users define this in the application!
#                 'DATETIME_FORMAT' => 'MMM ddd, yyyy - h:mm:ss tt', # let users define this in the application!
#               });
#
# 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
  $SHORT_MONTH_NAMES    = $args->{'SHORT_MONTH_NAMES'};
  $FULL_MONTH_NAMES     = $args->{'FULL_MONTH_NAMES'};
  $SHORT_WEEKDAY_NAMES  = $args->{'SHORT_WEEKDAY_NAMES'};
  $FULL_WEEKDAY_NAMES   = $args->{'FULL_WEEKDAY_NAMES'};
  $SHORT_AMPM_NAMES     = $args->{'SHORT_AMPM_NAMES'};
  $FULL_AMPM_NAMES      = $args->{'FULL_AMPM_NAMES'};
  $ORDINALS             = $args->{'ORDINALS'};
  $TIME_FORMAT          = $args->{'TIME_FORMAT'};
  $DATE_FORMAT          = $args->{'DATE_FORMAT'};
  $DATETIME_FORMAT      = $args->{'DATETIME_FORMAT'};

  # error checking
  unless (@$SHORT_MONTH_NAMES   == 12) { &IT::Error::dieAsCaller("SHORT_MONTH_NAMES must contain 12 values!"); }
  unless (@$FULL_MONTH_NAMES    == 12) { &IT::Error::dieAsCaller("FULL_MONTH_NAMES must contain 12 values!"); }
  unless (@$SHORT_WEEKDAY_NAMES == 7)  { &IT::Error::dieAsCaller("SHORT_WEEKDAY_NAMES must contain 7 values!"); }
  unless (@$FULL_WEEKDAY_NAMES  == 7)  { &IT::Error::dieAsCaller("FULL_WEEKDAY_NAMES must contain 7 values!"); }
  unless (@$SHORT_AMPM_NAMES    == 2)  { &IT::Error::dieAsCaller("SHORT_AMPM_NAMES must contain 2 values!"); }
  unless (@$FULL_AMPM_NAMES     == 2)  { &IT::Error::dieAsCaller("FULL_AMPM_NAMES must contain 2 values!"); }
  unless (@$ORDINALS            == 31) { &IT::Error::dieAsCaller("ORDINALS must contain 31 values (1-31)!"); }
  unless ($DATE_FORMAT)                { &IT::Error::dieAsCaller("DATE_FORMAT isn't defined!"); }

  # 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();
# ----------------------------------------------------------------------------

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

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

}


# ---------------------------------------------------------------------------------
# Function    : formatDate
# Description : Format epoch time as gmtime string
# Usage       : my $dateString = &IT::Date::formatDate($formatString, $epochTime);
#
# The format string can contains the following notations:
#
#              notation        description                        example
# Year         yy              2 digit year                       05
#              yyyy            4 digit year                       2005
# Month        MMMM            Full month name                    January
#              MMM             Short month name                   Jan
#              MM              Month number (zero padded)         01
#              M               Month number                       1
# Weekday      wwww            Full weekday name                  Tuesday
#              www             Short weekday name                 Tue
# Day          ddd             Ornate day of month                2nd
#              dd              Day of month (zero padded)         02
#              d               Day of month                       2
# 24 Hour      HH              Hour of day (24h, zero padded)     03
#              H               Hour of day (24h)                  3
# 12 Hour      hh              Hour of day (12h, zero padded)     04
#              h               Hour of day (12h)                  4
#              tt              AM or PM                           AM
#              t               AM or PM (short form)              A
# Minute       mm              Minute of hour (zero padded)       05
#              m               Minute of hour                     5
# Second       ss              Second of minute (zero padded)     06
#              s               Second of minute                   6
# Epoch        epoch           Seconds since epoch (1970)         1062201058
# Escape*      \               Don't format next character        (i.e. "\Mon\t\h: MMM" would generate "Month: Feb")
# Backslash    \\              a backslash character              \
# User Defined default         default date string (user defined) Jan 1st, 2004 - 14:52
#
# *Since many common letters are used in format options, if you wish to use any of
# those letters as words you'll need to tell the program to ignore them by using a
# backslash before them.
# ---------------------------------------------------------------------------------

sub formatDate {
  &_die_unless_init_called();
  my $formatString = shift;
  my $time         = shift;

  # error checking
  &IT::Error::dieOnValidationErrors(
    ["\$formatString", $formatString, "notRef"],
    ["\$time",         $time,         "positiveInt"],
  );

  my($sec,$min,$hour24,$monthDay,$monthIndex,$yearsSince1900,$weekdayIndex,$yday,$isdst) = gmtime($time);
  my $year = 1900 + $yearsSince1900;
  my $isPM = ($hour24 >= 12);

  ### set notation values
  my %notation;
  $notation{'yy'}    = sprintf '%02d', $year % 100;
  $notation{'yyyy'}  = $year;
  $notation{'M'}     = $monthIndex + 1;
  $notation{'MM'}    = sprintf '%02d', $notation{'M'};
  $notation{'MMM'}   = $SHORT_MONTH_NAMES->[$monthIndex];
  $notation{'MMMM'}  = $FULL_MONTH_NAMES->[$monthIndex];
  $notation{'www'}   = $SHORT_WEEKDAY_NAMES->[$weekdayIndex];
  $notation{'wwww'}  = $FULL_WEEKDAY_NAMES->[$weekdayIndex];
  $notation{'d'}     = $monthDay;
  $notation{'dd'}    = sprintf '%02d', $notation{'d'};
  $notation{'ddd'}   = $ORDINALS->[ $monthDay - 1 ];
  $notation{'H'}     = $hour24;
  $notation{'HH'}    = sprintf '%02d', $notation{'H'};
  $notation{'h'}     = $hour24 % 12 || 12;
  $notation{'hh'}    = sprintf '%02d', $notation{'h'};
  $notation{'t'}     = $isPM ? $SHORT_AMPM_NAMES->[1] : $SHORT_AMPM_NAMES->[0];
  $notation{'tt'}    = $isPM ? $FULL_AMPM_NAMES->[1]  : $FULL_AMPM_NAMES->[0];
  $notation{'ttt'}    = $isPM ? 1 : 0;
  $notation{'m'}     = $min;
  $notation{'mm'}    = sprintf '%02d', $notation{'m'};
  $notation{'s'}     = $sec;
  $notation{'ss'}    = sprintf '%02d', $notation{'s'};
  $notation{'epoch'} = $time;
  $notation{'\\'}    = '\\';

  ### Create dateString from formatString

  my $dateString = '';
  while (1) {
    # In scalar context, each execution of m//g finds the next match, returning
    # true if it matches, and false if there is no further match.  A failed match
    # normally resets the search position to the beginning of the string, but you
    # can avoid that by adding the /c modifier (e.g. m//gc).
    #
    # /c   Do not reset search position on a failed match when /g is in effect.
    # \G   Zero-width assertion that matches the exact position where the previous m//g, if any, left off.
    #      (This prevents your regexp from jumping further ahead to match something).
    # See m// under 'perldoc perlop' for more details

    # match longer strings first so we don't mistake them as shorter strings (eg: yyyy contains yy)
    if    ($formatString =~ /\G(?:yyyy)/gcs)    { $dateString .= $notation{'yyyy'}; }
    elsif ($formatString =~ /\G(?:yy)/gcs)      { $dateString .= $notation{'yy'}; }
    elsif ($formatString =~ /\G(?:wwww)/gcs)    { $dateString .= $notation{'wwww'}; }
    elsif ($formatString =~ /\G(?:www)/gcs)     { $dateString .= $notation{'www'}; }
    elsif ($formatString =~ /\G(?:time_only)/gcs) { $dateString .= &formatDate($TIME_FORMAT, $time); }
    elsif ($formatString =~ /\G(?:ttt)/gcs)     { $dateString .= $notation{'ttt'}; }
    elsif ($formatString =~ /\G(?:tt)/gcs)      { $dateString .= $notation{'tt'}; }
    elsif ($formatString =~ /\G(?:t)/gcs)       { $dateString .= $notation{'t'}; }
    elsif ($formatString =~ /\G(?:ss)/gcs)      { $dateString .= $notation{'ss'}; }
    elsif ($formatString =~ /\G(?:s)/gcs)       { $dateString .= $notation{'s'}; }
    elsif ($formatString =~ /\G(?:MMMM)/gcs)    { $dateString .= $notation{'MMMM'}; }
    elsif ($formatString =~ /\G(?:MMM)/gcs)     { $dateString .= $notation{'MMM'}; }
    elsif ($formatString =~ /\G(?:MM)/gcs)      { $dateString .= $notation{'MM'}; }
    elsif ($formatString =~ /\G(?:M)/gcs)       { $dateString .= $notation{'M'}; }
    elsif ($formatString =~ /\G(?:mm)/gcs)      { $dateString .= $notation{'mm'}; }
    elsif ($formatString =~ /\G(?:m)/gcs)       { $dateString .= $notation{'m'}; }
    elsif ($formatString =~ /\G(?:HH)/gcs)      { $dateString .= $notation{'HH'}; }
    elsif ($formatString =~ /\G(?:H)/gcs)       { $dateString .= $notation{'H'}; }
    elsif ($formatString =~ /\G(?:hh)/gcs)      { $dateString .= $notation{'hh'}; }
    elsif ($formatString =~ /\G(?:h)/gcs)       { $dateString .= $notation{'h'}; }
    elsif ($formatString =~ /\G(?:epoch)/gcs)   { $dateString .= $notation{'epoch'}; }
    elsif ($formatString =~ /\G(?:date_only)/gcs) { $dateString .= &formatDate($DATE_FORMAT, $time); }
    elsif ($formatString =~ /\G(?:date_and_time)/gcs) { $dateString .= &formatDate($DATETIME_FORMAT, $time); }
    elsif ($formatString =~ /\G(?:ddd)/gcs)     { $dateString .= $notation{'ddd'}; }
    elsif ($formatString =~ /\G(?:dd)/gcs)      { $dateString .= $notation{'dd'}; }
    elsif ($formatString =~ /\G(?:d)/gcs)       { $dateString .= $notation{'d'}; }
    elsif ($formatString =~ /\G\\(.)/gcs)       { $dateString .= $1; } # backslashed character
    elsif ($formatString =~ /\G(.)/gcs)         { $dateString .= $1; } # any other character (includes trailing backslash with nothing following)
    elsif ($formatString =~ /\G\z/gcs)          { last; }              # end of formatString
    else { die "error parsing format string '$formatString', got '$dateString'\n"; }
  }

  return $dateString;

}

# ------------------------------------------------------------------------
# Function    : convert12HourTo24Hour
# Description : covert 12 hour time to 24 hour time
# Usage       : my $hour24 = &IT::Date::convert12HourTo24Hour($hour12, $isPM);
# ------------------------------------------------------------------------

sub convert12HourTo24Hour {
  my $hour12 = shift;
  my $isPM   = shift;
  my $isAM   = !$isPM;

  # error checking
  if ($hour12 < 1 || $hour12 > 12) { die "12 hour value must be between 1 and 12! (not '$hour12')"; }

  # get 24 hour time
  my $hour24;
  if    ($isAM && $hour12 == 12) { $hour24 = 0; }
  elsif ($isAM)                  { $hour24 = $hour12; }
  elsif ($isPM && $hour12 == 12) { $hour24 = 12; }
  elsif ($isPM)                  { $hour24 = $hour12 + 12; }

  return $hour24;
}

# ------------------------------------------------------------------------
# Function    : convert24HourTo12Hour
# Description : covert 24 hour time to 12 hour time
# Usage       : my($hour12, $isPM) = &IT::Date::convert24HourTo12Hour($hour24);
# ------------------------------------------------------------------------

sub convert24HourTo12Hour {
  my $hour24 = shift;

  # error checking
  if ($hour24 < 0 || $hour24 > 24) { die "24 hour value must be between 0 and 24!"; }

  # get 12 hour time
  my($hour12, $isPM);
  if    ($hour24 == 0)  { $hour12 = 12;           $isPM = 0; }
  elsif ($hour24 <= 11) { $hour12 = $hour24;      $isPM = 0; }
  elsif ($hour24 == 12) { $hour12 = 12;           $isPM = 1; }
  elsif ($hour24 <= 23) { $hour12 = $hour24 - 12; $isPM = 1; }
  elsif ($hour24 == 24) { $hour12 = 12;           $isPM = 0; }

  if (wantarray) { return($hour12, $isPM) }
  else           { return($hour12); }
}

# ------------------------------------------------------------------------
# Function    : limitDayToMonthEnd
# Description : limiting the month day to the last day in the month.  So
#               feb 31 would return either 28 or 29 (depending on if it
#               was a leap year or not).  Month is 1-12.
# Usage       : $day = &IT::Date::limitDayToMonthEnd($year, $month, $day);
# ------------------------------------------------------------------------

sub limitDayToMonthEnd {
  my ($year, $month, $day) = @_;
  if ($year < 1000) { die "year must be in 4 digit format!"; }

  my $daysInMonth = &IT::Date::getDaysInMonth($year, $month);

  if ($day > $daysInMonth)  { return $daysInMonth; }
  else                      { return $day; }
}

# ------------------------------------------------------------------------------
# Function    : getDaysInMonth
# Description : $year must be 4 digits, $month is 1-12
# Usage       : my $daysInMonth = &IT::Date::getDaysInMonth($year, $month);
# ------------------------------------------------------------------------------

sub getDaysInMonth {
  my $year = shift;
  my $mon  = shift;

  # get days in month
  my $daysInMonth;
  if ($mon == 2) {                        # feb may or may not have a leap year
    if (&isLeapYear($year)) { $daysInMonth = 29; }
    else                    { $daysInMonth = 28; }
  }
  elsif ($mon == 4 || $mon == 6 || $mon == 9 || $mon == 11) { # april, june, october, and november all have 30 days
    $daysInMonth = 30;
  }
  else {
    $daysInMonth = 31;                   # and the rest have 31
  }

  return $daysInMonth;
}

# ------------------------------------------------------------------------------
# Function    : isLeapYear
# Description :
# Usage       : my $isLeapYear = &IT::Date::isLeapYear($year);
# ------------------------------------------------------------------------------

sub isLeapYear {
  my $year = shift;
  my $isLeapYear = 0;

  if (($year % 4 == 0) &&                             # year is a leap year if divisible by four
      (!($year % 100 == 0) || ($year % 400 == 0))) {  # and (not divisible by 100 or is divisible by 400)
    $isLeapYear = 1;
  }

  return $isLeapYear;
}

# ------------------------------------------------------------------------------
# Function    : getEpochTimeFromDateValues
# Description :
# Usage       : my $time = &IT::Date::getEpochTimeFromDateValues($year, $mon, $day, $hour, $min, $sec, $amPmOr24);
# Usage       : my $time = &IT::Date::getEpochTimeFromDateValues($year, $mon, $day);
# ------------------------------------------------------------------------------

sub getEpochTimeFromDateValues {
  my $year     = shift || die "no year specified!";    # eg: 2006
  my $mon      = shift || die "no month specified!";   # valid values: 1 - 12
  my $day      = shift || die "no day specified!";     # valid values: 1 - 31
  my $hour     = shift || 0;
  my $min      = shift || 0;
  my $sec      = shift || 0;
  my $amPmOr24 = shift || 24;

  # error checking
  if (length $year != 4)            { die "year must be 4 digits (was $year)!"; }
  if ($mon < 1 || $mon > 12)        { die "month must be between 1 and 12 (was $mon)!"; }
  if ($day < 1 || $day > 31)        { die "day must be between 1 and 31 (was $day)!"; }
  if ($amPmOr24 !~ /^(am|pm|24)$/i) { die "amPmOr24 must be 'am', 'pm' or '24' (was $amPmOr24)!"; }

  # fix invalid month day
  $day = &IT::Date::limitDayToMonthEnd($year, $mon, $day);

  # get 24 hour value
  my $hour24;
  my $isPM   = ($amPmOr24 =~ /^pm$/i);
  my $is24   = ($amPmOr24 == '24');
  if (!$is24) {
    my $hour12 = $hour;
    $hour24 = &IT::Date::convert12HourTo24Hour($hour, $isPM);
  }
  else {
    $hour24 = $hour;
  }

  # get epoch time
  my $epochTime = eval { timegm($sec, $min, $hour24, $day, $mon-1, $year-1900); };
  if ($@) { die("invalid date (timegm error: $@)"); }

  return $epochTime;
}

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

