package Bank::Holidays; use 5.006001; use strict; use warnings; use HTML::TableExtract; use LWP::Simple; use DateTime; require Exporter; our @ISA = qw(Exporter); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. # This allows declaration use Bank::Holidays ':all'; # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK # will save memory. our %EXPORT_TAGS = ( 'all' => [ qw( is_holiday reserve_holidays ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw( ); our $VERSION = '0.56'; sub new { my ( $package, %params ) = @_; my $param; $param->{dt} = $params{dt} || DateTime->now; $param->{holidays} = reserve_holidays(); bless $param, $package; } sub reserve_holidays() { my $te = HTML::TableExtract->new(); $te->parse(get("http://www.federalreserve.gov/releases/k8/default.htm")); my $months = { 'January' => 1, 'February' => 2, 'March' => 3, 'April' => 4, 'May' => 5, 'June' => 6, 'July' => 7, 'August' => 8, 'September'=> 9, 'October' => 10, 'November' => 11, 'December' => 12 }; my $holidays; foreach my $ts ( $te->tables) { next if ($ts->coords)[0] != 1; my @colyears; foreach my $row ( $ts->rows ) { next unless @$row; map { s/\r|\n//g if $_ } @$row; my $colcount = 0; foreach my $col ( @$row ) { if ( $col ) { if ( $col =~ /(\d{4})/ ) { $colyears[$colcount] = $1; } elsif ( $col =~ /(\w+)\s(\d{2})(\d|)$/ ) { push @{$holidays->{$colyears[$colcount]}->{$months->{$1}}}, { day => $2, satflag => $3 }; } } $colcount++; } } } return $holidays; } sub is_holiday { my ( $param, %opts ) = @_; if ( $opts{date} ) { $param->{dt} = $opts{date}; } if ( $opts{Tomorrow} ) { $param->{dt}->add(days => 1); } elsif ( $opts{Yesterday} ) { $param->{dt}->subtract( days => 1 ); } return 1 if $param->{dt}->dow == 7; foreach my $holiday ( @{$param->{holidays}->{$param->{dt}->year}->{int($param->{dt}->month)}} ) { return 1 if int($param->{dt}->day) == $holiday->{day}; } return undef; } # Preloaded methods go here. 1; __END__ # Below is stub documentation for your module. You'd better edit it! =head1 NAME Bank::Holidays - Perl extension for determining Federal Reserve holidays. 2006 - 2010 =head1 SYNOPSIS use Bank::Holidays; # Using the date => reference you can specify any date you like. my $bank = Bank::Holidays->new( date => DateTime->now ); # or any datetime object # Check yesterday to see if it was a holiday print "Yesterday "; $bank->is_holiday( Yesterday => 1 ) ? print "is " : print "is not"; print " a holiday"; # Check to see if today is a holiday; print "Today "; $bank->is_holiday ? print "is" : print "is not"; print " a holiday\n"; # Check to see if tomorrow is a holiday. print "Tomorrow "; $bank->is_holiday( Tomorrow => 1 ) ? print "is" : print "is not"; print " a holiday\n"; =head1 DESCRIPTION Bank::Holidays reads a page from the Federal Reserve's website that contains holidays until 2010. However should the FR's site change this code may not work. This code is very useful for determining days that a valid banking transaction can occur, remembering that Sunday is never a banking day. =head2 methods new( [ date => dt->object ] ) Defaults to today if undefines. is_holiday( [ Yesterday|Tomorrow => 1 ] ) To determine what day to check default is current date in date object. =head1 AUTHOR Tyler Hardison, Ethardison@bayfed.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2006 by Tyler Hardison This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.3 or, at your option, any later version of Perl 5 you may have available. =cut