#!/usr/bin/perl -w
package Common::Date;

use strict;
use Carp;

use Date::Simple;
use Data::Dumper;
use Date::Calc qw( Add_Delta_Days Add_Delta_YM );

use Common::Assert;

###
#   Provides a general interface for parsing dates as well as some arithmatic
#   and comparison methods.  This class overloads the following operators: "", <=>, and cmp
#
#   Constructor
#
#   new( $dateString )
#      same as 'new( date => $dateString )'
#
#   new( %args )
#      Valid Args:
#          date     -  Date string to parse
#          type     -  list reference containing a list of parser types to
#                      try.  Using this overrides default parser priorities.
#
#  clone( [$dateObj] )
#      Do a deep copy of a date object.  If a date object is passed the content
#      of $dateObj are stored in the current blessed date object.  If no value
#      is passed a new date object is created and then copy is returned.
#
#  compare( $rvalueDate )
#      Compare date values used for overloading <=> and cmp;
#
#  addDays( $delta )
#      Add $delta days to the current date object
#
#  addMonths( $delta )
#      Add $delta months to the current date object
#
#  addYears( $delta )
#      Add $delta years to the current date object
#
#  Accessors
#
#  asString( $format )
#      return a date string formatted using the format specified.  Formats use
#      the same nomiclature as Date::Simple.
#      default format:  %Y-%M-$d
#
#  monthBegin( $format )
#  monthEnd( $format )
#  quarterBegin( $format )
#  quarterEnd( $format )
#  yearBegin( $format )
#  yearEnd( $format )
#
#  year()
#  month()
#  day()
#
#  pattern()
#      returns the pattern object that matched this string.
#
#  display()
#      display a list of all known parsers and their default priorities.  High
#      priority means that parser will get picked first.
#
#  NOTE:
#
#     Parsers are actually derived Common::Date objects therefore can be instantiated
#  on their own.  This will limit parsing to only the type associated to that object
#  regardless of what is passed in using the 'type' parameter.
#
#  i.e.
#
#  # This date can only parse ISO formatted dates
#  my $isoDate = new Common::Date::ISO( '10/10/2001' )  # will fail, becuase format is 'unknown'.
#
###

use overload (
    '""'  => 'stringify',
    'cmp' => 'compare',
    '<=>' => 'compare'
);

sub stringify {
    my $self = shift;
    return $self->asString();
}

sub compare {
    my $lvalue = shift;
    my $rvalue = shift;

    confess "Missing lvalue" unless ($lvalue);
    confess "Missing rvalue" unless ($rvalue);

    confess "lvalue not a date object" unless ( ref($lvalue) );
    confess "rvalue not a date object" unless ( ref($rvalue) );

    return $lvalue->asString("%s") <=> $rvalue->asString("%s");
}

# Defines what date objects are available
sub _parsers {
    qw(
      Common::Date::Quarter
      Common::Date::Excel
      Common::Date::NumericalYearFirst
      Common::Date::Numerical
      Common::Date::Text
      Common::Date::EUR
      Common::Date::US
      Common::Date::ISO
      Common::Date::Half
      Common::Date::FrenchText
    );
}

sub new {
    my $class = shift;
    my $self = bless {}, $class;

    $self->_init(@_);

    return $self;
}

sub _init {
    my $self = shift;
    my %args;

    if ( @_ == 1 ) {
        $args{date} = shift;
    } else {
        %args = @_;
    }

    my $parser = $self->parse(%args) if (%args);

    return $parser ? $parser : $self;
}

###
#
#  this is the workhorse of this object.  It gathers all the parameters and parsers
#  and then iterates through to see if any of the parsers match.  If they do then
#  store the data in this object.
#
#  This method can take either a single parameter, a date string, or named
#  parameters, date => dateString and type => parserType.
#
###
sub parse {
    my $self = shift;
    my $primaryType;
    my $type;
    my $date;

    # Parse the parameters
    if ( @_ == 1 ) {
        $date = shift;
        $type = $self->type() if ( ref($self) ne 'Common::Date' );
    } else {
        my %args = @_;
        $primaryType = $args{primary_type};
        $type        = ref($self) eq 'Common::Date' ? $args{type} : $self->type();
        $date        = $args{date};
    }

    # Coerse the type parameter into an arrayref if it isn't already one.
    if ($type) {
        $type = [$type] unless ( ref($type) eq 'ARRAY' );
    }

    assert( $date, "Date required" );

    my @parsers = $self->_getParsers( primaryType => $primaryType, types => $type );

    $self->clear();

    # Parse the date!
    foreach my $parser (@parsers) {
        Log->debug( "Using Parser " . ref($parser) );
        if ( $parser->_parseString($date) ) {
            $self->clone($parser);
            return $parser;
        }
    }

    die "Unrecognized date format, '$date'";
}

sub addDays {
    my $self = shift;
    my $delta = shift || die "parameter required";

    my ( $year, $month, $day ) = Add_Delta_Days( $self->year, $self->month, $self->day, $delta );

    die "Failed to add days to date" unless ( $year && $month && $day );

    $self->{_date}  = sprintf( "%4d-%02d-%02d", $year, $month, $day );
    $self->{_month} = $month;
    $self->{_day}   = $day;
    $self->{_year}  = $year;

    return $self;
}

sub addMonths {
    my $self = shift;
    my $delta = shift || die "parameter required";

    my ( $year, $month, $day ) = Add_Delta_YM( $self->year, $self->month, $self->day, 0, $delta );

    die "Failed to add days to date" unless ( $year && $month && $day );

    $self->{_date}  = sprintf( "%4d-%02d-%02d", $year, $month, $day );
    $self->{_month} = $month;
    $self->{_day}   = $day;
    $self->{_year}  = $year;

    return $self;
}

sub addYears {
    my $self = shift;
    my $delta = shift || die "parameter required";

    my ( $year, $month, $day ) = Add_Delta_YM( $self->year, $self->month, $self->day, $delta, 0 );

    die "Failed to add days to date" unless ( $year && $month && $day );

    $self->{_date}  = sprintf( "%4d-%02d-%02d", $year, $month, $day );
    $self->{_month} = $month;
    $self->{_day}   = $day;
    $self->{_year}  = $year;

    return $self;
}

###
#   _getParsers()
#
#   Returns a prioritized list of date parsers to use.  If no types are specified
#   then all known parsers are returned and the list is prioritized by their
#   default priority.
#
#   If a type list is passed in then a list is returned containing only the
#   parsers with types matching those in the list.  The type list is also used
#   to set the parser priority.
#
###
sub _getParsers {
    my $self        = shift;
    my %args        = @_;
    my $primaryType = $args{primaryType};
    my @types       = @{ $args{types} } if ( $args{types} );
    my %parsers;
    my @result;
    my $priorityIndex = @types;
    my %customPriority;
    my @knownTypes;
    my $priority;

    # If we are specifying our own types then we need to create a priority hash
    foreach my $t (@types) {
        $customPriority{$t} = $priorityIndex;
        $priorityIndex--;
    }

    # instantiate all parsers and group them by priority
    foreach my $parser ( $self->_parsers() ) {
        eval "require $parser";
        die $@ if ($@);

        my $p = new $parser;

        my $t = $p->type;

        push( @knownTypes, $t );

        if ( @types == 0 || grep( /^$t$/, @types ) || ( $primaryType && $primaryType eq $t ) ) {

            # Is the primary type, priority should be first
            if ( $primaryType && $primaryType eq $t ) {
                $priority = 9999999;
            }

            # Use default priority
            elsif ( @types == 0 ) {
                $priority = $p->priority();

                # Use the custom priority
            } else {
                $priority = $customPriority{ $p->type };
            }

            $parsers{$priority} = [] unless ( $parsers{$priority} );
            push( @{ $parsers{$priority} }, $p );

            Log->debug("Adding Parser - $parser");
        }
    }

    # Now itterate through all the priorities and return the list.
    foreach my $priority ( sort { $b <=> $a } keys(%parsers) ) {
        foreach my $parser ( @{ $parsers{$priority} } ) {
            push( @result, $parser );
        }
    }

    # Itterate through all the custom types to ensure they are valid names
    foreach my $type (@types) {
        die "Unknown date type '$type'" unless ( grep( /^$type$/, @knownTypes ) );
    }

    return @result;
}

###
#   display
#
#   Display all known parsers and their priority
###
sub display {
    my $self    = shift;
    my @parsers = $self->_getParsers();

    foreach my $parser (@parsers) {
        print $parser->type . " (" . $parser->priority . ")\n";
    }
}

###
#   _parseString( $date )
#
#   Itterate through all the known patterns for this Date object.  If a pattern
#   matches then store the data and return success.
###
sub _parseString {
    my $self = shift;
    my $date = shift || die;

    foreach my $pattern ( @{ $self->_patterns() } ) {
        if ( $pattern->match($date) ) {
            $self->{_month}   = $pattern->month;
            $self->{_year}    = $pattern->year;
            $self->{_pattern} = $pattern;

            # If day has not been defined in the pattern just use 1
            $self->{_day} = $pattern->dayIndex ? $pattern->day : 1;

            $self->_storeDate();

            return 1;
        }
    }

    return undef;
}

###
#   _patterns
#
#   virtual method that returns an array ref of Common::Date::Pattern objects
#   used to match a date.
###
sub _patterns { die "Must be overloaded" }

###
#   _storeDate
#
#   Store a formated date and date object in this object.  We store the date
#   object because this also validates proper date formatting.
###
sub _storeDate {
    my $self = shift;
    my %args = @_;

    assert( $self->month );
    assert( $self->day );
    assert( $self->year );

    $self->{_date} = sprintf( "%04d-%02d-%02d", $self->year, $self->month, $self->day );
    $self->{_dateObj} = new Date::Simple( $self->{_date} )
      || die "Invalid date: $self->{_date}";
}

###
#   clear
#
#   Clear out private data so a new parse can be called.  This is implicitly
#   called by parse.
###
sub clear {
    my $self = shift;

    $self->{_month}   = undef;
    $self->{_day}     = undef;
    $self->{_year}    = undef;
    $self->{_pattern} = undef;
    $self->{_date}    = undef;
    $self->{_dateObj} = undef;
}

###
#   clone
#
#   Deep copy of another Common::Date object
###
sub clone {
    my $self = shift;
    my $copy = shift;

    my $src;
    my $dest;

    if ($copy) {
        $src  = $copy;
        $dest = $self;
    } else {
        $src  = $self;
        $dest = ref($self)->new();
    }

    $dest->{_month}   = $src->month();
    $dest->{_day}     = $src->day();
    $dest->{_year}    = $src->year();
    $dest->{_pattern} = $src->pattern();
    $dest->{_date}    = $src->asString();
    $dest->{_dateObj} = $src->{_dateObj};

    return $dest;
}

###
#   _displayDate( $format )
#
#   display a date string with optional formatting.  Used by accessor methods
###
sub _displayDate {
    my $self   = shift;
    my $date   = shift || return;
    my $format = shift;

    return $date unless ($format);

    my $dateObj = new Date::Simple($date);
    die "Failed to conver date" unless ($dateObj);

    return $dateObj->format($format);
}

###
#   Display Methods
#
#   The following methods return a date string
###

sub asString {
    my $self = shift;
    $self->_displayDate( $self->{_date}, @_ );
}

sub monthBegin {
    my $self = shift;

    assert( $self->month );
    assert( $self->year );

    $self->_displayDate( sprintf( "%04d-%02d-%02d", $self->year, $self->month, 1 ) );
}

sub monthEnd {
    my $self = shift;

    assert( $self->month );
    assert( $self->year );

    my $days = Date::Simple::days_in_month( $self->year, $self->month );
    $self->_displayDate( sprintf( "%04d-%02d-%02d", $self->year, $self->month, $days ) );
}

sub quarterBegin {
    my $self = shift;
    my $quarter;
    my $month;

    assert( $self->month );
    assert( $self->year );

    $quarter = int( $self->month / 3 ) + 1;
    $month   = $quarter * 3 - 2;

    $self->_displayDate( sprintf( "%04d-%02d-%02d", $self->year, $month, 1 ) );
}

sub quarterEnd {
    my $self = shift;
    my $quarter;
    my $month;
    my $days;

    assert( $self->month );
    assert( $self->year );

    $quarter = int( $self->month / 3 ) + 1;
    $month   = $quarter * 3;
    $days    = Date::Simple::days_in_month( $self->year, $month );

    $self->_displayDate( sprintf( "%04d-%02d-%02d", $self->year, $month, $days ) );
}

sub halfBegin {
    my $self = shift;
    my $half;
    my $month;

    assert( $self->month );
    assert( $self->year );

    $month = $self->month <= 6 ? 1 : 7;
    $self->_displayDate( sprintf( "%04d-%02d-%02d", $self->year, $month, 1 ) );
}

sub halfEnd {
    my $self = shift;
    my $half;
    my $month;
    my $days;

    assert( $self->month );
    assert( $self->year );

    $half  = int( $self->month / 6 ) + 1;
    $month = $half * 6;
    $days  = Date::Simple::days_in_month( $self->year, $month );

    $self->_displayDate( sprintf( "%04d-%02d-%02d", $self->year, $month, $days ) );
}

sub yearBegin {
    my $self = shift;

    assert( $self->year );

    $self->_displayDate( sprintf( "%04d-%02d-%02d", $self->year, 1, 1 ) );
}

sub yearEnd {
    my $self = shift;

    assert( $self->year );

    $self->_displayDate( sprintf( "%04d-%02d-%02d", $self->year, 12, 31 ) );
}

sub today {
    my $date = Date::Simple::today();
    return sprintf( "%04d-%02d-%02d", $date->year, $date->month, $date->day );
}

sub now {
    my $class = shift;
    my $date  = Date::Simple::today();

    my $month = $date->month();
    my $year  = $date->year();
    my $day   = $date->day();

    return new Common::Date("$year-$month-$day");
}

###
#   Accessors
###
sub month { shift->{_month} }
sub day   { shift->{_day} }
sub year  { shift->{_year} }

sub pattern { shift->{_pattern} }

1;