File Coverage

blib/lib/Date/Namedays/Simple.pm

Criterion	Covered	Total	%
statement	40	43	93.0
branch	6	8	75.0
condition	4	9	44.4
subroutine	8	9	88.8
pod	0	4	0.0
total	58	73	79.4

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.

=head1 SYNOPSIS

  use Date::Namedays::Simple::Your_Language_Module_Here;

  # create an instance
  # Date::Namedays::Simple is abstract, so must use a subclass
  my $nd = new Date::Namedays::Simple::Hungarian;

  # get (all!) names for the year 2001, 24th of July
  my (@names) = $nd->getNames(7,24,2001);

  # Now simply print them
  my $namestoday = join (',',@names);
  print $namestoday;


=head1 DESCRIPTION

In many countries, people not only celebrate their birthdays annually, but there is also the concept of "nameday".
Calendars in these countries (e.g. Hungary) contain one ore more names for each day - the day on which a person with
the given first name celebrate his/her nameday.

This module is here simply to aid you to get the namedays for a date. You simply supply the year, month and day, and
the corresponding names are returned. It is as simple as that.

This module uses no external modules. It does not export anything - I wanted to keep it as simple as possible.

Please note: THIS MODULE IS ALPHA PHASE! It works, but I need some feedback. (Send feedback!) The methods and their
parameters can change any time!

Note: names are stored in a human readable format. Because of this, they are parsed at runtime. This takes some
time obviously - just don't worry about it, we "cache" that in $self, and actually that's why this module must be
instanteniated, that's why we have instance methods instead of class methods.


Date::Namedays::Simple is an abstract class, it is always subclassed, for example to
Date::Namedays::Simple::Hungarian. Subclasses must implement the "processNames()" method. This method shall return
a string(!) in the following format:

1.1.name1,name2,...,nameN
1.2.name1,name2,...,nameN
...
12.31.name1,name2,...,nameN

Which is more precisely a "\n" separated list of the following lines:

$month.$day.$name1[,$name2,...,$nameN]\n

See Date::Namedays::Simple::Hungarian for example!


=head1 USAGE

 See SYNOPSIS.

=head1 BUGS

None so far... send bugreports!


=head1 SUPPORT

Ask the author. Only bugs concerning this module, please!


=head1 AUTHOR

	Csongor Fagyal
	[e-mail]
	http://www.conceptonline.com/about

=head1 COPYRIGHT

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.


=head1 SEE ALSO

perl(1).

=cut

############################################# main pod documentation end ##


################################################ subroutine header begin ##
#
#=head2 sample_function
#
# Usage     : How to use this function/method
# Purpose   : What it does
# Returns   : What it returns
# Argument  : What it wants to know
# Throws    : Exceptions and other anomolies
# Comments  : This is a sample subroutine header.
#           : It is polite to include more pod and fewer comments.
#
#See Also   :
#
#=cut
#
################################################## subroutine header end ##



1;	# boinggg
__END__