File Coverage

blib/lib/Bank/Holidays.pm

Criterion	Covered	Total	%
statement	64	73	87.6
branch	23	34	67.6
condition	2	6	33.3
subroutine	9	9	100.0
pod	0	3	0.0
total	98	125	78.4

package Bank::Holidays;

use 5.006001;
use strict;
use warnings;
use HTML::TableExtract;
use LWP::UserAgent;
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.81';

sub new {
  my ( $package, %params ) = @_;

  my $param;
  $param->{dt} =
    $params{dt}
    ? $params{dt}
    : $params{date}
        ? $params{date}
        : DateTime->now;
  $param->{holidays} = reserve_holidays();
  bless $param, $package;
}

sub reserve_holidays() {
  my $te = HTML::TableExtract->new();

  my $ua = new LWP::UserAgent;

  $ua->timeout(120);

  my $home = $ENV{HOME} || $ENV{LOCALAPPDATA};

  unless ( -d $home . "/.bankholidays" ) {
    mkdir( $home . "/.bankholidays" );
  }

  my $cache = $home . "/.bankholidays/frbholidays.html";

  # Cache the content from the FRB since holdays are unlikely to
  # change from day to day (or year to year)

  my $content;

  if ( -f $cache && ( time() - ( stat($cache) )[9] ) < 86400 ) {
    open( my $fh, "<", $cache ) or die $!;
    local $/ = undef;
    $content = <$fh>;
    close $fh;
  }
  else {
    my $url = 'http://www.federalreserve.gov/aboutthefed/k8.htm';

    my $request = new HTTP::Request( 'GET', $url );

    my $response = $ua->request($request);

    $content = $response->content();

    open( my $fh, ">", $cache ) or die $!;
    print $fh $content;
    close $fh;
  }

  $te->parse($content);

  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 ) != 2;
    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{1,2})(\*?)/ ) {
            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__