view release on metacpan or  search on metacpan

lib/Bank/Holidays.pm  view on Meta::CPAN

package Bank::Holidays;

use 5.006001;
use strict;
use warnings;
use HTML::TableExtract;
use LWP::UserAgent;
use DateTime;

our $VERSION = '0.86';

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 = LWP::UserAgent->new();

  $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 $!;
    $content = do { local $/ = <$fh> };
    close $fh;
  }
  else {
    my $url = 'http://www.federalreserve.gov/aboutthefed/k8.htm';

    my $request = HTTP::Request->new( '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 ) = @_;