view release on metacpan or  search on metacpan

lib/AmberDB/Date.pm  view on Meta::CPAN

    my ( $self, $time ) = @_;
    $time //= time();

    eval { require HTTP::Date; };
    if ($@) {

        # Basic fallback string format if HTTP::Date is missing
        my $d = $self->get_date($time);
        return $d->{str};
    }
    return HTTP::Date::time2str($time);
}

# ------------------------------------------------
# Lists array of day IDs between two date boundaries
# ------------------------------------------------
sub day_range {
    my ( $self, $start, $end ) = @_;
    return unless $start && $end;

    my ( $start_year, $start_month, $start_day ) =
      ( $start =~ /([0-9]{4})([0-9]{2})([0-9]{2})/ );
    my ( $end_year, $end_month, $end_day ) =
      ( $end =~ /([0-9]{4})([0-9]{2})([0-9]{2})/ );

    return unless $start_year && $end_year;

    my @days;

    # If years differ, divide range into yearly sub-calculations
    if ( $start_year != $end_year ) {
        my @calcs    = ( [ $start, $start_year . "1231" ] );
        my $mid_year = $start_year + 1;
        while ( $mid_year < $end_year ) {
            push @calcs, [ $mid_year . "0101", $mid_year . "1231" ];
            $mid_year++;
        }
        push @calcs, [ $end_year . "0101", $end ];

        foreach my $calc (@calcs) {
            push @days, $self->day_range(@$calc);
        }
    }
    else {
        # Days count table per month
        my @months = (
            [ ( 1 .. 31 ) ],
            [ ( 1 .. 28 ) ],
            [ ( 1 .. 31 ) ],
            [ ( 1 .. 30 ) ],
            [ ( 1 .. 31 ) ],
            [ ( 1 .. 30 ) ],
            [ ( 1 .. 31 ) ],
            [ ( 1 .. 31 ) ],
            [ ( 1 .. 30 ) ],
            [ ( 1 .. 31 ) ],
            [ ( 1 .. 30 ) ],
            [ ( 1 .. 31 ) ]
        );

        # Gregorian calendar leap year check
        my $is_leap = ( ( $start_year % 4 == 0 && $start_year % 100 != 0 )
              || ( $start_year % 400 == 0 ) );
        if ($is_leap) {
            push @{ $months[1] }, 29;
        }

        for ( my $i = 0 ; $i < @months ; $i++ ) {
            my $month = $i + 1;
            $month = sprintf "%02d", $month;

            foreach my $day ( @{ $months[$i] } ) {
                $day = sprintf "%02d", $day;
                my $dayid = $start_year . $month . $day;

                next if $dayid < $start;
                last if $dayid > $end;     # Stop iteration once end boundary exceeded
                push @days, $dayid;
            }
        }
    }
    return @days;
}

# ------------------------------------------------
# Calculates ISO week number for given date ID
# ------------------------------------------------
sub dateid2week {
    my ( $self, $dateid ) = @_;

    my $daytime;
    my ( $y, $m, $d, $h, $min, $s ) = ( 0, 0, 0, 0, 0, 0 );

    # secondid
    if ( $dateid =~
        /^([0-9]{4})([0-9]{2})([0-9]{2})([0-9]{2})([0-9]{2})([0-9]{2})/ )
    {
        ( $y, $m, $d, $h, $min, $s ) = ( $1, $2, $3, $4, $5, $6 );
    }

    # minuteid
    elsif ( $dateid =~ /^([0-9]{4})([0-9]{2})([0-9]{2})([0-9]{2})([0-9]{2})/ ) {
        ( $y, $m, $d, $h, $min ) = ( $1, $2, $3, $4, $5 );
    }

    # dayid
    elsif ( $dateid =~ /^([0-9]{4})([0-9]{2})([0-9]{2})/ ) {
        ( $y, $m, $d ) = ( $1, $2, $3 );
    }
    else {
        return;
    }

    # Convert to epoch time using Time::Local
    eval { $daytime = timelocal( $s, $min, $h, $d, ( $m - 1 ), $y ); };
    return if $@;

    my ( $wday, $yday ) = ( localtime($daytime) )[ 6, 7 ];
    my $days  = ( $yday - $wday ) / 7;
    my $yweek = ( $days =~ /([0-9]+)\./ ) ? ( $1 + 2 ) : ( $days + 1 );