view release on metacpan or  search on metacpan

lib/DateTime/Event/NameDay.pm  view on Meta::CPAN

package DateTime::Event::NameDay;

use strict;

use vars qw ($VERSION);

$VERSION = '0.02';

use Carp;
use Params::Validate qw( validate SCALAR OBJECT HASHREF );

use DateTime;
use DateTime::Set;
use DateTime::Calendar::Christian;


my %namedays = ();


sub new {
    my $class = shift;
    my %p = validate( @_,
		      { country   => { type      => SCALAR,
				       default   => undef,
				       # Leave the heavy validation to set
				     },
			date_args => { type      => HASHREF,
				       default   => {},
				     },
		       },
		      );
    my $self = { };
    bless $self, $class;
    $self->set( %p );

    return $self;
}

sub set {
    my $self = shift;

    my %p = validate( @_,
                      { country   => { type      => SCALAR,
				       optional  => 1,
				       callbacks => 
				           {'known day mapping' => \&_check_country }
				     },
			date_args => { type      => HASHREF,
				       default   => {},
				     },
		      }
		      );

    if (defined $p{country}) {
	$self->{country} = lc $p{country};
    }

    if (defined $p{date_args}) {
	$self->{date_args} = $p{date_args};
    }

    return $self;
}

sub country {
    my ($self) = @_;
    return undef unless ref $self;
    return $self->{country};
}


sub date_args {
    my ($self) = @_;
    return {} unless ref $self;
    return $self->{date_args};
}

sub get_daynames
{
    my $self = shift;
    my %p = validate( @_,
                      { country => { type      => SCALAR,
				     optional  => 1,
				     callbacks => 
				           {'known day mapping' => \&_check_country }
				     },
			date    => { type      => OBJECT,
				     can       => 'utc_rd_values',
				     },
		      }
		      );

    # Work out our country
    my $country = lc $p{country};
    if (not defined $country) {
	$country = $self->country();

	croak "Unable to determine the correct country"
	    unless defined $country;
    }

    # Get the namedays for the given date
    # - Find our section
    my $nameday_info = 
	$self->_init_nameday_country(namedays => \%namedays,
				     country  => $country);

    # - Convert to the Julian calendar
    my $adj_dt = DateTime::Calendar::Christian->from_object
	(object      => $p{date},
	 reform_date => $nameday_info->{reform_date},
	 %{ $self->date_args() },
	 );
    
    # - Get the appropriate nameday based on month number and day
    my $names = $nameday_info->{names}{ $adj_dt->month() }{ $adj_dt->day() };
    my @names = defined $names ? @$names : ();

    return @names;
}

sub get_namedays {
    my $self = shift;
    my %p = validate( @_,
                      { country => { type      => SCALAR,
				     optional  => 1,
				     callbacks => 
				           {'known day mapping' => \&_check_country }
				     },
			date_args => { type      => HASHREF,
				       default   => undef,
				     },
			name    => { type      => SCALAR,
				     },
		      }
		      );

    # Work out our country
    my $country = lc $p{country};
    if (not defined $country) {
	$country = $self->country();

	croak "Unable to determine the correct country"
	    unless defined $country;
    }

    # Work out the date args
    my $date_args = $p{date_args};
    if (not defined $date_args) {
	$date_args = ref $self ? $self->date_args() : {};
    }

    # Get the canonical name
    my $name = _clean_name( $p{name} );

    # Find the month and day for the given name
    my $nameday_info = 
	$self->_init_nameday_country(namedays => \%namedays,
				     country  => $country);
    croak "Unknown name '$p{name}' for country '$p{country}'"
	unless exists $nameday_info->{reverse_names}{$name};
    my ($month, $day) = @{ $nameday_info->{reverse_names}{$name} };

    # Build a set of all of the days that the given name is for
    my $set = DateTime::Set->from_recurrence
	(next => 
	     sub { _make_recurrence($_[0], $nameday_info->{reform_date},
					   $month, $day, 1, $date_args);
	     },
	 previous => 
	     sub { _make_recurrence($_[0], $nameday_info->{reform_date},
					   $month, $day, -1, $date_args);
	     },
	 );

    return $set;
}

sub _make_recurrence {
    my ($last, $reform_date, $month, $day, $direction, $date_args) = @_;

    my $dt = DateTime::Calendar::Christian->from_object
	(object      => $last,
	 reform_date => $reform_date,
	 %$date_args,
	 );
    $dt->truncate(to => 'day');