Date::Formatter - A simple Date and Time formatting object

  use Date::Formatter;

  # create a Date::Formatter object with the current date and time.
  my $date = Date::Formatter->now();

  # create a formatter routine for this object
  # see formatter mini-language documentation below
  $date->createDateFormatter("(hh):(mm):(ss) (MM)/(DD)/(YYYY)");   

  print $date; # print date in this format -> 12:56:03 4/12/2004

  # get the formatter for use with other objects
  my $formatter = $date->getDateFormatter();

  # create an interval of time
  my $interval = Date::Formatter->createTimeInterval(years => 1, days => 2, minutes => 15);

  # re-use the formater from above
  $interval->setDateFormatter($formatter);

  print $interval; # print date in this format -> 12:56:03 4/12/2004 

  # use overloaded operators
  my $future_date = $date + $interval;

  # sort the dates (again with the overload operator)
  my @sorted_dates = sort { $a <=> $b } ($date, $interval, $future_date);

 "... on most current systems, epochs are represented by a 32 bit signed integer, 
 which only lets you represent datetimes with a range of about 136 years.  On most 
 UNIX systems currently in use, this means that the latest date you can represent 
 right now is sometime in the year 2038, and the earliest is around 1902."

 ------------------------ ------ ------ ------ ------ ------ ------ ------
 File                       stmt branch   cond    sub    pod   time  total
 ------------------------ ------ ------ ------ ------ ------ ------ ------
 Date/Formatter.pm         100.0   95.8   74.5  100.0  100.0  100.0   96.4
 ------------------------ ------ ------ ------ ------ ------ ------ ------
 Total                     100.0   95.8   74.5  100.0  100.0  100.0   96.4
 ------------------------ ------ ------ ------ ------ ------ ------ ------

package Date::Formatter;

use strict;
use warnings;

our $VERSION = '0.09';

use Scalar::Util qw(blessed);

use Time::Local ();
use DateTime::Locale;

## overload operators
use overload (
	'""'  => "toString",	
	'=='  => "equal",
	'!='  => "notEqual",
	'<=>' => "compare",
	'+'   => "add",
	'-'   => "subtract"
	);

### constructor

sub new {
	my ($_class, %date) = @_;
	my $class = ref($_class) || $_class;
	my $date = {};
	bless($date, $class);
	$date->_init(%date);
	return $date;
}


sub now {
    my ( $self, %date ) = @_;
    my $locale = $date{locale} || 'en';
    return $self->new( locale => $locale );
}

sub _init {
	my ($self, %date) = @_;
	$self->{hourType} = 12;
	$self->{abbreviateMonths} = 0;
	$self->{abbreviateDays} = 0;
	$self->{formatter} = undef;
	$self->{internal} = undef;
	$self->{elements} = [];
	$self->{am_or_pm} = undef;
	$self->{gmt_offset_hours} = undef;
	$self->{gmt_offset_minutes}	= undef;

    $self->setLocale( delete $date{locale} );

    if (%date) {      
        # we let Time::Local do the range checking
        # on these values here,.. 
        $date{seconds}      = 0 unless exists $date{seconds};
        $date{minutes}      = 0 unless exists $date{minutes};
        $date{hour}         = 0 unless exists $date{hour};
        $date{year}         = 0 unless exists $date{year};
        $date{day_of_month} = 1 unless exists $date{day_of_month};
        # we accept normal month values
        # instead of zero index months
        if (exists $date{month}) {
            ($date{month} =~ /^\d+$/ && $date{month} >= 1) 
                || die "Insufficient Arguments : 'month' value must be numeric and at least 1";        
            $date{month} -= 1; 
        }
        else {
        	$date{month} = 0; 
        }        
        my $new_time;
        eval {
            $new_time = Time::Local::timelocal(
                            $date{seconds}, $date{minutes}, $date{hour},
                            $date{day_of_month}, $date{month}, $date{year}
                        );
        };
        die "Insufficient Arguments : Could not construct a proper date value : $@" if $@;
        $self->_setTime($new_time);    
    }
    else {
        $self->_setTime(time());
    }
}

sub setLocale {
    my $self = shift;
    my ($locale) = @_;

    $locale ||= 'en';

    $self->{locale} = DateTime::Locale->load( $locale );

    return;
}

## alternate constructor 
# for creating intervals of time.
# --------------------------------------
# this is best used with the overloaded
# versions of the '+' and '-' operator
# to increment and decrement another
# date object.
#
# Accepts the following named arguments:
#  - > years (365 days)
#  - > leap years (366 days)
#  - > months (assumes 30 days)
#  - > weeks
#  - > days
#  - > hours
#  - > minutes
#  - > seconds
#
# NOTE:
# This can also be used to set a time
# sometime past the epoch, but that is
# not terribly useful. Except maybe to
# pass in nothing and get the date of the
# epoch on your current system.
sub createTimeInterval {
	my ($class, %_date) = @_;
	my $time = 0;
	if (exists($_date{years}) && $_date{years}){
		$time += $_date{years} * 365 * 24 * 60 * 60;
	}
	if (exists($_date{leapyears}) && $_date{leapyears}){
		$time += $_date{leapyears} * 366 * 24 * 60 * 60;
	}
	if (exists($_date{months}) && $_date{months}){
		$time += $_date{months} * 30 * 24 * 60 * 60;
	}
	if (exists($_date{weeks}) && $_date{weeks}){
		$time += $_date{weeks} * 7 * 24 * 60 * 60;
	}
	if (exists($_date{days}) && $_date{days}){
		$time += $_date{days} * 24 * 60 * 60;
	}
	if (exists($_date{hours}) && $_date{hours}){
		$time += $_date{hours} * 60 * 60;
	}
	if (exists($_date{minutes}) && $_date{minutes}){
		$time += $_date{minutes} * 60;
	}
	if (exists($_date{seconds}) && $_date{seconds}){
		$time += $_date{seconds};
	}
	# if the are asking for nothing then
	# give them 1 second past the epoch
	$time ||= 1;
	return _setTime($class->new(), $time);
}

# occasionally you will want to refresh 
# the time to be the current time. This 
# would allow a Date object to be used
# over a long period of time
sub refresh {
	my ($self) = @_;
	$self->_init();
	return $self;
}

# creates a formatter subroutine to be used when 
# the date object is printed:
# 	print $date;
# (see below for more documentation)
{

	my %_parser_table = (
		"MM" 	=> \&getNumericMonth,
		"M" 	=> \&getMonth,
		"DD" 	=> \&getDayOfMonth,
		"D" 	=> \&getDayOfWeek,
		"YY" 	=> \&getYear,
		"YYYY" 	=> \&getFullYear,
		"hh" 	=> \&getHours,
		"mm" 	=> \&getMinutes,
		"ss" 	=> \&getSeconds,
		"T" 	=> \&isAMorPM,
		"O"		=> \&getGMTOffset
	);
	
	sub createDateFormatter {
		my ($self, $format, $pattern) = @_;
		my @date_format;
		$pattern ||= qr/\(|\)/;
		my @tokens = split $pattern => $format;
		while (@tokens) {
			my $token = shift(@tokens);
			if (exists $_parser_table{$token}) {
				push @date_format, $_parser_table{$token};
			}
			else {
				push @date_format, sub{ return "$token" };
			}
		}
		$self->{formatter} = sub {
			my ($self) = @_;
			return join "" => map {
				$_->($self);
			} @date_format;
		};
		return $self;
	}	
	
}

sub getDateFormatter {
	my ($self) = @_;
	return $self->{formatter};
}

sub setDateFormatter {
	my ($self, $formatter) = @_;
	(defined($formatter) && ref($formatter) eq "CODE") 
        || die "Insufficient Arguments : bad formatter";
	$self->{formatter} = $formatter;
}

## private
	
# special private subroutine
# to set the internal time of 
# a date object after it is 
# created. This is used by:
# - createTimeInterval
# - add
# - subtract
sub _setTime { 
	my ($date, $new_time) = @_;
	$date->{internal} = $new_time;
	$date->{elements} = [ localtime($new_time) ];
	# must undefine this so that
	# it gets re-generated
	$date->{am_or_pm} = undef;
	my ($gmt_minutes, $gmt_hours) = (gmtime($new_time))[1, 2];
	$date->{gmt_offset_hours} = ($date->{elements}->[2] - $gmt_hours);
	$date->{gmt_offset_minutes} = ($date->{elements}->[1] - $gmt_minutes);	
	return $date;
}

## configuration

# use 12 or 24 hour clock
sub use24HourClock {
	my ($self) = @_;
	$self->{hourType} = 24;	
}

sub use12HourClock {
	my ($self) = @_;
	$self->{hourType} = 12;	
}

# use short or long names for months and days
sub useLongNames {
	my ($self) = @_;
	$self->{abbreviateMonths} = 0;
	$self->{abbreviateDays} = 0;
}

sub useLongMonthNames {
	my ($self) = @_;
	$self->{abbreviateMonths} = 0;
}

sub useLongDayNames {
	my ($self) = @_;
	$self->{abbreviateDays} = 0;
}

# short names are the first 3 letters
sub useShortNames {
	my ($self) = @_;
	$self->{abbreviateMonths} = 1;
	$self->{abbreviateDays} = 1;
}

sub useShortMonthNames {
	my ($self) = @_;
	$self->{abbreviateMonths} = 1;
}

sub useShortDayNames {
	my ($self) = @_;
	$self->{abbreviateDays} = 1;
}


## informational

sub isAMorPM {
	my ($self) = @_;
	return if ($self->{hourType} == 24);
	$self->getHours() unless $self->{am_or_pm};
	return $self->{am_or_pm};
}

sub getSeconds {
	my ($self) = @_;
	return sprintf("%02d", $self->{elements}->[0]);
}

sub getMinutes {
	my ($self) = @_;
	return sprintf("%02d", $self->{elements}->[1]);
}

sub getHours {
	my ($self) = @_;
	if ($self->{hourType} == 12){
		my $hours = $self->{elements}->[2];
		if ($hours == 12){
			$self->{am_or_pm} = "p.m.";
			return 12;
		}
		elsif ($hours == 0) {
			$self->{am_or_pm} = "a.m.";
			return 12;
		}
		elsif ($hours < 12){
			$self->{am_or_pm} = "a.m.";
			return $hours;
		}
		elsif ($hours > 12){
			$self->{am_or_pm} = "p.m.";
			return $hours - 12;
		}
	}
	return $self->{elements}->[2];
}

# GMT offsets

# ... by hours
sub getGMTOffsetHours {
	my ($self) = @_;
	return $self->{gmt_offset_hours};
}	

# ... by minutes
sub getGMTOffsetMinutes {
	my ($self) = @_;
	return $self->{gmt_offset_minutes};
}

# and finally a formatted offset
sub getGMTOffset {
	my ($self) = @_;
	my $gmt_offset = abs($self->{gmt_offset_hours});
	my $sign = "";
	$sign = "-" if ($gmt_offset > $self->{gmt_offset_hours});
	return sprintf("%s%02d00", ($sign, $gmt_offset));
}

sub getDayOfMonth {
	my ($self) = @_;
	return $self->{elements}->[3];
}

sub getMonth {
	my ($self) = @_;
	if ($self->{abbreviateMonths} == 1){
        return $self->{locale}->month_abbreviations->[$self->{elements}[4]];
	}
    return $self->{locale}->month_names->[$self->{elements}[4]];
}

sub getNumericMonth {
	my ($self) = @_;
	return $self->{elements}->[4] + 1;
}

sub getMonthIndex {
	my ($self) = @_;
	return $self->{elements}->[4];
}

sub getFullYear {
	my ($self) = @_;
	return (1900 + $self->{elements}->[5]);
}

sub getYear {
	my ($self) = @_;
	return sprintf("%02d", ($self->{elements}->[5] % 100));
}

sub getDayOfWeek {
	my ($self) = @_;

    my @days;
	if ($self->{abbreviateDays} == 1){
        @days = @{$self->{locale}->day_abbreviations};
	}
    else {
        @days = @{$self->{locale}->day_names};
    }

    # DateTime::Locale has Monday as the first day. This module
    # uses Sunday. So, move the last item to the front, so @days
    # is now Sunday -> Saturday instead of Monday -> Sunday.
    unshift(@days, pop(@days));

	return $days[$self->{elements}->[6]];
}

sub getDayOfWeekIndex {
	my ($self) = @_;
	return $self->{elements}->[6];
}

sub getDayOfYear {
	my ($self) = @_;
	return $self->{elements}->[7];
}

### overloaded interfaces

sub clone {
	my ($self) = @_;
	return $self->unpack($self->pack());
}

## serialization

sub pack {
	my ($self) = @_;
	return $self->{internal};
}

sub unpack {
	# this is an alternate constructor 
	my ($class, $packed_string) = @_;
	my $obj = _setTime($class->new(), $packed_string);

    #Uncomment if you want clones to clone the locale, as well
    #$obj->{locale} = $self->{locale};

    return $obj;
}

## printing

sub toString { 
	# this could be more
	# robust to take advantage of
	# the module configurations
	my ($self) = @_; 
	return $self->{formatter}->($self) if $self->{formatter};
	return scalar localtime($self->{internal}); 
}

# return the unmolested object string
sub stringValue {
	my ($self) = @_;
	return overload::StrVal($self);
}

### overloaded operators

# Addition and Subtraction operators are 
# best used in conjunction with a Data object that
# has been create using the createTimeInterval 
# constructor. 

sub add {
	my ($left, $right) = @_;
	(blessed($right) && $right->isa("Date::Formatter")) 
		|| die "Illegal Operation : Cannot add a date object to a non-date object.";
	return _setTime($left->clone(), $left->{internal} + $right->{internal});
}

# sub addEqual {
# 	my ($left, $right) = @_;
# 	((ref($left) eq "Date::Formatter") && (ref($right) eq "Date::Formatter")) || die "IllegalOperation : IllegalOperation : Cannot add a date object to a non-date object.";
# 	return $left->_setTime($left->{internal} + $right->{internal});
# }

sub subtract {
	my ($left, $right) = @_;
	(blessed($right) && $right->isa("Date::Formatter"))   
		|| die "Illegal Operation : Cannot subtract a date object from a non-date object.";
	return _setTime($left->clone(), $left->{internal} - $right->{internal});
}

# sub subtractEqual {
# 	my ($left, $right) = @_;
# 	((ref($left) eq "Date::Formatter") && (ref($right) eq "Date::Formatter")) || die "IllegalOperation : Cannot subtract a date object from a non-date object.";
# 	return $left->_setTime($left->{internal} - $right->{internal});
# }

# compare two dates
sub compare {
	my ($left, $right) = @_;
	(blessed($right) && $right->isa("Date::Formatter"))  
		|| die "Illegal Operation : Cannot compare a date object to a non-date object.";
	return ($left->{internal} <=> $right->{internal});
}

sub equal {
	my ($left, $right) = @_;
	return ($left->compare($right) == 0) ? 1 : 0;
}

sub notEqual {
	my ($left, $right) = @_;
	return ($left->equal($right)) ? 0 : 1;
}


1;

__END__