view release on metacpan or  search on metacpan

lib/App/Dochazka/REST/Holiday.pm  view on Meta::CPAN

=head2 canon_date_diff

Compute difference (in days) between two canonical dates

=cut

sub canon_date_diff {
    my ( $date, $date1 ) = @_;
    my ( $date_days, $date1_days ) = (
        Date_to_Days( canon_to_ymd( $date ) ),
        Date_to_Days( canon_to_ymd( $date1 ) ),
    );
    return abs( $date_days - $date1_days );
}


=head2 canon_to_ymd

Takes canonical date YYYY-MM-DD and returns $y, $m, $d

=cut

sub canon_to_ymd {
    my ( $date ) = @_;
    return unless $date;

    return ( $date =~ m/(\d+)-(\d+)-(\d+)/ );
}


=head2 holidays_in_daterange

Given a PARAMHASH containing two properties, C<begin> and C<end>, the values of
which are canonicalized dates (possibly produced by the C<split_tsrange()>
function), determine the holidays that fall within this range. The function will
always return a status object. Upon success, the payload will contain a hashref
with the following structure:

{
    '2015-01-01' => '',
    '2015-05-01' => '',
}

The idea is that this hash can be used to quickly look up if a given date is a
holiday.

=cut

sub holidays_in_daterange {
    my ( %ARGS ) = validate( @_, {
        begin => { type => SCALAR },
        end => { type => SCALAR },
    } );

    my $begin_year = _extract_year( $ARGS{begin} );
    my $end_year = _extract_year( $ARGS{end} );

    # transform daterange into an array of hashes containing "begin", "end"
    # in other words: 
    # INPUT: { begin => '1901-06-30', end => '1903-03-15' } 
    # becomes
    # OUTPUT: [
    #     { begin => '1901-06-30', end => '1901-12-31' },
    #     { begin => '1902-01-01', end => '1902-12-31' },
    #     { begin => '1903-01-01', end => '1903-03-15' },
    # ]
    my $daterange_by_year = _daterange_by_year(
        begin_year => $begin_year,
        end_year => $end_year,
        begin_date => $ARGS{begin},
        end_date => $ARGS{end},
    );
    
    my %retval;

    foreach my $year ( sort( keys %{ $daterange_by_year } ) ) {
        my $holidays = holidays( YEAR => $year, FORMAT => '%Y-%m-%d', WEEKENDS => 1 );
        if ( $year eq $begin_year and $year eq $end_year ) {
            my $tmp_holidays = _eliminate_dates( $holidays, $ARGS{begin}, "before" );
            $holidays = _eliminate_dates( $tmp_holidays, $ARGS{end}, "after" );
            map { $retval{$_} = ''; } @$holidays;
        } elsif ( $year eq $begin_year ) {
            map { $retval{$_} = ''; } @{ _eliminate_dates( $holidays, $ARGS{begin}, "before" ) };
        } elsif ( $year eq $end_year ) {
            map { $retval{$_} = ''; } @{ _eliminate_dates( $holidays, $ARGS{end}, "after" ) };
        } else {
            map { $retval{$_} = ''; } @$holidays;
        }
    }

    return \%retval;
}


=head2 is_weekend

Simple function that takes a canonicalized date string in 
the format YYYY-MM-DD and returns a true or false value 
indicating whether or not the date falls on a weekend.

=cut

sub is_weekend {
    my $cdate = shift;  # cdate == Canonicalized Date String YYYY-MM-DD
    my ( $year, $month, $day ) = $cdate =~ m/(\d{4})-(\d{2})-(\d{2})/;
    my $dow = Day_of_Week( $year, $month, $day );
    return ( $dow == 6 or $dow == 7 )
        ? 1
        : 0;
}


=head2 get_tomorrow

Given a canonicalized date string in the format YYYY-MM-DD, return 
the next date (i.e. "tomorrow" from the perspective of the given date).

=cut

sub get_tomorrow {
    my $cdate = shift;  # cdate == Canonicalized Date String YYYY-MM-DD
    my ( $year, $month, $day ) = $cdate =~ m/(\d{4})-(\d{2})-(\d{2})/;