view release on metacpan or  search on metacpan

lib/Date/Namedays/Simple.pm  view on Meta::CPAN

package Date::Namedays::Simple;
use strict;

BEGIN {
	use Exporter ();
	use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
	$VERSION     = 0.01;
	@ISA         = qw (Exporter);
	#Give a hoot don't pollute, do not export more than needed by default
	@EXPORT      = qw ();
	@EXPORT_OK   = qw ();
	%EXPORT_TAGS = ();
}

####################################################################################
# Create object - we do nothing with the parameters now (maybe in a later version)
####################################################################################
sub new {
	my ($class, %parameters) = @_;
	my $self = bless ({}, ref ($class) || $class);
	return ($self);
}


###########################################################
# Input: month, day, [year]
# A list of names is returned.
# Year is optional, but if you do not provide it, leap
# years are not taken into consideration!
###########################################################
sub getNames {
        my ($self, $month, $day, $year) = @_;

	# some calendars handle leap-years in a special way... like
	# the Hungarian, which is totally insane
	my $leapyearmonth = 0;
	my $leapyearmonth = 1 if ($year && (not ($year % 4) ) && ($month == 2));	
	# note: this is a VERY lame leap-year calculation here...
	
	if ($leapyearmonth) {
		($month, $day) = $self->leapYear($month, $day)
	}
	
        my $namedays = $self->_getNameDays;
        return @{$namedays->[$month-1]->[$day-1]};
}

############################################################################
# Leap year, default implementation: does nothing.
############################################################################
sub leapYear {
	my ($self, $year, $month, $day) = @_;

	return ($month, $day);	# default: don't change; some override this...
}

############################################################################
# Returns all namedays in an arrayref
############################################################################
sub _getNameDays {
        my $self = shift;
	
	# We simply "cache" namedays data
	return $self->{NAMEDAYS} if ($self->{NAMEDAYS});
                                                                                                  
        my $namedays = [];
        my $in = $self->processNames;
        my (@lines) = split (/\n/, $in);
        foreach my $line (@lines) {
                my ($month, $day, $names) = ($line =~ /^(\d+)\.(\d+)\.(\S+)$/);
                chomp ($names);
                my (@names) = split (/,/, $names);
                $month--;
                $day--;
                $namedays->[$month] = [] if (not $namedays->[$month]);
                $namedays->[$month]->[$day] = \@names;
        }
	
	$self->{NAMEDAYS} = $namedays;	# "cache" for later use
                                                                                                                             
        return $namedays;
}

sub processNames {
	die ("Hi, I am Date::Namedays::Simpler. Sorry, you must provide a 'processNames' sub in subclasses!");
}

########################################### main pod documentation begin ##


=head1 NAME

Date::Namedays::Simple - simple base class for getting namedays for a given date.