package Calendar::List;

use strict;
use warnings;

use vars qw($VERSION @ISA %EXPORT_TAGS @EXPORT_OK @EXPORT);
$VERSION = '0.22';

#----------------------------------------------------------------------------

=head1 NAME

Calendar::List - A module for creating date lists

=head1 SYNOPSIS

  use Calendar::List;

  # basic usage
  my %hash = calendar_list('DD-MM-YYYY' => 'DD MONTH, YYYY' );
  my @list = calendar_list('MM-DD-YYYY');
  my $html = calendar_selectbox('DD-MM-YYYY' => 'DAY DDEXT MONTH, YYYY');

  # using the hash
  my %hash01 = (
  	'options'   => 10,
  	'exclude'   => { 'weekend' => 1 },
  	'start'     => '01-05-2003',
  );

  my %hash02 = (
  	'options'   => 10,
  	'exclude'   => { 'holidays' => \@holidays },
  	'start'     => '01-05-2003',
  );

  my %hash03 = (
  	'exclude'   => { 'monday' => 1,
                     'tuesday' => 1,
                     'wednesday' => 1 },
  	'start'     => '01-05-2003',
  	'end'       => '10-05-2003',
  	'name'      => 'MyDates',
  	'selected'  => '04-05-2003',
  );

  my %hash = calendar_list('DD-MM-YYYY' => 'DDEXT MONTH YYYY', \%hash01);
  my @list = calendar_list('DD-MM-YYYY', \%hash02);
  my $html = calendar_selectbox('DD-MM-YYYY',\%hash03);

=head1 DESCRIPTION

The module is intended to be used to return a simple list, hash or scalar
of calendar dates. This is achieved by two functions, calendar_list and
calendar_selectbox. The former allows a return of a list of dates and a
hash of dates, whereas the later returns a scalar containing a HTML code
snippet for use as a HTML Form field select box.

=head1 EXPORT

  calendar_list,
  calendar_selectbox

=cut

#----------------------------------------------------------------------------

#############################################################################
#Export Settings															#
#############################################################################

require Exporter;

@ISA = qw(Exporter);

%EXPORT_TAGS = ( 'all' => [ qw(
	calendar_list
	calendar_selectbox
) ] );

@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
@EXPORT    = ( @{ $EXPORT_TAGS{'all'} } );

#############################################################################
#Library Modules															#
#############################################################################

use Calendar::Functions qw(:all);
use Clone qw(clone);
use Tie::IxHash;

#############################################################################
#Variables
#############################################################################

# prime our print out names
my @dotw = qw( Sunday Monday Tuesday Wednesday Thursday Friday Saturday );

# THE DEFAULTS
my $Format		= 'DD-MM-YYYY';
my @order		= qw( day month year );

my %Defaults = (
	maxcount => 30,
	selectname => 'calendar',
	selected => [],
	startdate => undef,
	enddate => undef,
	start => [1,1,1970],
	end => [31,12,2037],
	exclude => [ 0,0,0,0,0,0,0,0 ],
    holidays => {},
);

my (%Settings);

#----------------------------------------------------------------------------

#############################################################################
#Interface Functions														#
#############################################################################

=head1 FUNCTIONS

=over 4

=item calendar_list([DATEFORMAT] [,DATEFORMAT] [,OPTIONSHASH])

Returns a list in an array context or a hash reference in any other context.
All paramters are optional, one or two date formats can be specified for the
date formats returned in the list/hash. A hash of user defined settings can
also be passed into the function. See below for further details.

Note that a second date format is not required when returning a list. A
single date format when returning a hash reference, will be used in both
key and value portions.

=cut

sub calendar_list {
	my $wantarray = (@_ < 2 || ref($_[1]) eq 'HASH') ? 1 : 0;
	my ($fmt1,$fmt2,$hash) = _thelist(@_);
	return _callist($fmt1,$fmt2,$hash,$wantarray);
}

=item calendar_selectbox([DATEFORMAT] [,DATEFORMAT] [,OPTIONSHASH])

Returns a scalar containing a HTML string. The HTML snippet consists of an
HTML form field select box. All paramters are optional, one or two date
formats can be specified for the date formats returned in the value
attribute and data portion. A hash of user defined settings can
also be passed into the function. See below for further details.

Note that a single date format will be used in both value attribute and
data portions.

=cut

sub calendar_selectbox {
	my ($fmt1,$fmt2,$hash) = _thelist(@_);
	return _calselect($fmt1,$fmt2,$hash);
}

#############################################################################
#Internal Functions															#
#############################################################################

# name:	_thelist
# args: format string 1 .... optional
# 		format string 2 .... optional
# 		settings hash ...... optional
# retv: undef if invalid settings, otherwise a hash of dates, keyed by
#		an incremental counter.
# desc:	The heart of the engine. Arranges the parameters passed to the
#		the interface function, calls for the settings to be decided,
#		them creates the main hash table of dates.
#		Stops when either the end date is reached, or the maximum number
#		of entries have been found.

sub _thelist {
	my $format1 = shift	unless(ref($_[0]) eq 'HASH');
	my $format2 = shift	unless(ref($_[0]) eq 'HASH');
	my $usrhash = shift	    if(ref($_[0]) eq 'HASH');
	$format1 = $Format	unless($format1);
	$format2 = $format1	unless($format2);

	return	if _setargs($usrhash,$format1);

    $Settings{nowdate} = $Settings{startdate};

	my $optcount = 0;	# our option counter
	my %DateHash;
	tie(%DateHash, 'Tie::IxHash');

    while($optcount < $Settings{maxcount}) {

        my ($nowday,$nowmon,$nowyear,$nowdow) = decode_date($Settings{nowdate});

        # ignore days we're not interested in
        unless($Settings{exclude}->[$nowdow]) {

            my $fdate = sprintf "%02d-%02d-%04d", $nowday,$nowmon,$nowyear;
            unless($Settings{exclude}->[7] && $Settings{holidays} && $Settings{holidays}->{$fdate}) {
                # store date
                $DateHash{$optcount++} = [decode_date($Settings{nowdate})];
            }
        }

	    # stop if reached end date
		last    if(compare_dates($Settings{nowdate},$Settings{enddate}) == 0);

        # increment
        $Settings{nowdate} = add_day($Settings{nowdate});

	}

	return $format1,$format2,\%DateHash;
}

# name:	_callist
# args: format string 1 .... optional
# 		format string 2 .... optional
# 		settings hash ...... optional
# retv: undef if invalid settings, otherwise an array if zero or one
#		date format provided, in ascending order, or a hash if two
#		date formats.
# desc:	The cream on top. Takes the hash provided by _thelist and uses
#		it to create a formatted array or hash.

sub _callist {
	my ($fmt1,$fmt2,$hash,$wantarray) = @_;
	return	unless($hash);

	my (@returns,%returns);
	tie(%returns, 'Tie::IxHash');

	foreach my $key (sort {$a <=> $b} keys %$hash) {
		my $date1 = format_date($fmt1,@{$hash->{$key}});
		if($wantarray) {
			push @returns, $date1;
		} else {
			my $date2 = format_date($fmt2,@{$hash->{$key}});
			$returns{$date1} = $date2;
		}
	}

#print STDERR "\n\n===[".scalar(each %returns)."]===\n\n";
	return @returns	if($wantarray);
#use Data::Dumper qw(DumperX);
#open  FH, ">>trace.log" or die "cannot open file:$!\n";
#print FH "STORED:\n".DumperX(\%returns)."\n";
#close FH;
#exit;
#	while(my (@temp) = each %returns) {
#		push @returns, @temp;
#	}

#	map { push @returns, $_->[0],$_->[1] } each %returns;
#	return @returns;
	return %returns;
}


# name:	_calselect
# args: format string 1 .... optional
# 		format string 2 .... optional
# 		settings hash ...... optional
# retv: undef if invalid settings, otherwise a hash of dates, keyed by
#		an incremental counter.
# desc:	The cream on top. Takes the hash provided by _thelist and uses
#		it to create a HTML select box form field, making use of any
#		user defined settings.

sub _calselect {
	my ($fmt1,$fmt2,$hash) = @_;
	return	unless($hash);

	# open SELECT tag
	my $select = "<select name='$Settings{selectname}'>\n";

	# add an OPTION elements
	foreach my $key (sort {$a <=> $b} keys %$hash) {
		my $selected = 0;

		# check whether this option has been selected
		$selected = 1
			if(	@{$Settings{selected}} &&
				$hash->{$key}->[0] == $Settings{selected}->[0] &&
				$hash->{$key}->[1] == $Settings{selected}->[1] &&
				$hash->{$key}->[2] == $Settings{selected}->[2]);

		# format date strings
		my $date1 = format_date($fmt1,@{$hash->{$key}});
		my $date2 = format_date($fmt2,@{$hash->{$key}});

		# create the option
		$select .= "<option value='$date1'";
		$select .= ' SELECTED'	if($selected);
		$select .= ">$date2</option>\n";
	}

	# close SELECT tag
	$select .= "</select>\n";
	return $select;
}

# name:	_setargs
# args: settings hash ...... optional
# retv: 1 to indicate any bad settings, otherwise undef.
# desc:	Sets defaults, then deciphers user defined settings.

sub _setargs {
	my $hash = shift;
	my $format1 = shift;

	# set the current date
	my @now = localtime();
	my @today = ( $now[3], $now[4]+1, $now[5]+1900 );

	%Settings = ();
	%Settings = %{ clone(\%Defaults) };
	$Settings{startdate} = encode_date(@today);

	# if no user hash table provided, lets go
	return	unless($hash);


	# store excluded days
	if($hash->{'exclude'}) {
		my $hash2 = $hash->{'exclude'};
		foreach my $inx (0..6) {
			my $key = lc($dotw[$inx]);
			$Settings{exclude}->[$inx] = 1	if $hash2->{"$key"};
		}

		# check for weekend setting
		if($hash2->{'weekend'}) {
			$Settings{exclude}->[0] = 1;
			$Settings{exclude}->[6] = 1;
		}

		# check for weekday setting
		if($hash2->{'weekday'}) {
			foreach my $inx (1..5) { $Settings{exclude}->[$inx] = 1; }
		}

		# check for holiday setting
		if($hash2->{'holidays'}) {
			$Settings{exclude}->[7] = 1;
			%{$Settings{holidays}} = map {$_ => 1} @{$hash2->{'holidays'}};
		}

		# ensure we aren't wasting time
		my $count = 0;
		foreach my $inx (0..6) { $count++	if($Settings{exclude}->[$inx]) }
		die "all days ignore\n"	if($count == 7);
	}


	# store selected date
	if($hash->{'select'}) {
		my @dates = ($hash->{'select'} =~ /(\d+)/g);
		$Settings{selected} = \@dates;
	}


	# store start date
	if($hash->{'start'}) {
		my @dates = ($hash->{'start'} =~ /(\d+)/g);
		$Settings{startdate} = encode_date(@dates);
	}


	# store end date
	if($hash->{'end'}) {
		$Settings{maxcount}=9999;
		my @dates = ($hash->{'end'} =~ /(\d+)/g);
		$Settings{enddate} = encode_date(@dates);

		# check whether we have a bad start/end dates
		return 1	if(compare_dates($Settings{enddate},$Settings{startdate}) < 0);
	}


	# store user defined values
	$Settings{maxcount}		= $hash->{'options'}	if($hash->{'options'});
	$Settings{selectname}	= $hash->{'name'}		if($hash->{'name'});

	return 0;
}

1;

__END__

#----------------------------------------------------------------------------

=back

=head1 DATE FORMATS

=over 4

=item Parameters

The date formatted parameters passed to the two exported functions can take
many different formats. If a single array is required then only one date
format string is required.

Each format string can have the following components:

  DD
  MM
  YYYY
  DAY
  MONTH
  DDEXT
  DMY
  MDY
  YMD
  MABV
  DABV
  EPOCH

The first three are translated into the numerical day/month/year strings.
The DAY format is translated into the day of the week name, and MONTH
is the month name. DDEXT is the day with the appropriate suffix, eg 1st,
22nd or 13th. DMY, MDY and YMD default to '13-09-1965' (DMY) style strings.
MABV and DABV provide 3 letter abbreviations of MONTH and DAY respectively.

EPOCH is translated into the number od seconds since the system epoch. Note
that the Time::Piece module must be installed to use this format.

=item Options

In the optional hash that can be passed to either function, it should be
noted that all 3 date formatted strings MUST be in the format 'DD-MM-YYYY'.

=back

=head1 OPTIONAL SETTINGS

An optional hash of settings can be passed as the last parameter to each
external function, which consists of user defined limitations. Each
setting will effect the contents of the returned lists. This may lead to
conflicts, which will result in an undefined reference being returned.

=over 4

=item options

The maximum number of items to be returned in the list.

=item name

Used by calendar_selectbox. Names the select box form field.

=item select

Used by calendar_selectbox. Predefines the selected entry in a select box.

=item exclude

The exclude key allows the user to defined which days they wish to exclude
from the returned list. This can either consist of individual days or the
added flexibility of 'weekend' and 'weekday' to exclude a traditional
group of days. Full list is:

  weekday
  monday
  tuesday
  wednesday
  thursday
  friday
  weekend
  saturday
  sunday

=item start

References a start date in the format DD-MM-YYYY.

=item end

References an end date in the format DD-MM-YYYY. Note that if an end
date has been set alongside a setting for the maximum number of options,
the limit will be defined by which one is reached first.

=back

=head1 DATE MODULES

Internal to the Calendar::Functions module, there is some date comparison
code. As a consequence, this requires some date modules that can handle a
wide range of dates. There are three modules which are tested for you,
these are, in order of preference, Date::ICal, DateTime and Time::Local.

Each module has the ability to handle dates, although only Time::Local exists
in the core release of Perl. Unfortunately Time::Local is limited by the
Operating System. On a 32bit machine this limit means dates before the epoch
(1st January, 1970) and after the rollover (January 2038) will not be
represented. If this date range is well within your scope, then you can safely
allow the module to use Time::Local. However, should you require a date range
that exceedes this range, then it is recommend that you install one of the two
other modules.

=head1 SEE ALSO

  Calendar::Functions

  Clone
  Date::ICal
  DateTime
  Time::Local
  Time::Piece

  The Calendar FAQ at http://www.tondering.dk/claus/calendar.html

=head1 BUGS, PATCHES & FIXES

There are no known bugs at the time of this release. However, if you spot a
bug or are experiencing difficulties that are not explained within the POD
documentation, please submit a bug to the RT system (see link below). However,
it would help greatly if you are able to pinpoint problems or even supply a
patch.

Fixes are dependant upon their severity and my availablity. Should a fix not
be forthcoming, please feel free to (politely) remind me by sending an email
to barbie@cpan.org .

RT: http://rt.cpan.org/Public/Dist/Display.html?Name=Calendar-List

=head1 AUTHOR

  Barbie, <barbie@cpan.org>
  for Miss Barbell Productions <http://www.missbarbell.co.uk>.

=head1 THANKS TO

Dave Cross, E<lt>dave at dave.orgE<gt> for creating Calendar::Simple, the
newbie poster on a technical message board who inspired me to write the
original code and Richard Clamp E<lt>richardc at unixbeard.co.ukE<gt>
for testing the beta versions.

=head1 COPYRIGHT AND LICENSE

    Copyright © 2003-2009 Barbie for Miss Barbell Productions.

    This library is free software; you can redistribute it and/or modify it under
    the same terms as Perl itself, using the Artistic License.

The full text of the licenses can be found in the Artistic file included with
this distribution, or in perlartistic file as part of Perl installation, in
the 5.8.1 release or later.

=cut