File Coverage

blib/lib/Time/C.pm

Criterion	Covered	Total	%
statement	558	594	93.9
branch	279	428	65.1
condition	28	37	75.6
subroutine	65	65	100.0
pod	29	29	100.0
total	959	1153	83.1

use strict;
use warnings;
package Time::C;
$Time::C::VERSION = '0.024';
# ABSTRACT: Convenient time manipulation.

use overload (
    '""' => sub { shift->string },
    bool => sub { 1 },
    fallback => 1,
);

use Carp qw/ croak /;
use Function::Parameters qw/ :strict /;
use Time::C::Sentinel;
use Time::D;
use Time::P ();
use Time::F ();
use Time::Moment;
use Time::Zone::Olson;



method new ($c: $year =, $month =, $day =, $hour =, $minute =, $second =, $tz =) {
    my $t;
    my %defineds = (
        epoch_d => (defined($year) and defined($month) and defined($day) and defined($hour) and defined($minute) and defined($second)),
        year => defined($year),
        month => defined($month),
        mday => defined($day),
        week => 0,
        wday => 0,
        yday => 0,
        hour => defined($hour),
        minute => defined($minute),
        second => defined($second),
        tz_d => defined($tz),
        offset => 0,
    );

    if (not defined $year) {
        $t = $c->now_utc();
        %$t = ( %$t, %defineds );
        return $t;
    }

    my $tm = Time::Moment->new(year => $year, month => $month // 1, day => $day // 1, hour => $hour // 0, minute => $minute // 0, second => $second // 0, offset => 0);

    if (not defined $tz) { $tz = 'UTC'; }

    if ($tz ne 'UTC' and $tz ne 'GMT') {
        my $offset = _get_offset($tm->epoch, $tz);
        $tm = $tm->with_offset_same_local($offset);
        $offset = _get_offset($tm->epoch, $tz);
        $tm = $tm->with_offset_same_local($offset);
    }

    $t = $c->localtime($tm->epoch, $tz);
    %$t = (%$t, %defineds);
    return $t;
}


method mktime ($c: :$epoch =, :$second =, :$minute =, :$hour =, :$mday =, :$month =, :$wday =, :$week =, :$yday =, :$year =, :$tz =, :$offset =) {

    # Alright, time to try and construct a Time::C object with what we have
    # We'll start with the easiest one: epoch
    # Then go on to creating it from the date bits, and the time bits

    my $t;
    my %defineds = (
        epoch_d => defined($epoch),
        year => defined($year),
        month => defined($month),
        mday => defined($mday),
        week => defined($week),
        wday => defined($wday),
        yday => defined($yday),
        hour => defined($hour),
        minute => defined($minute),
        second => defined($second),
        tz_d => defined($tz),
        offset => defined($offset),
    );

    if (defined $epoch) {
        $t = Time::C->gmtime($epoch);

        if (defined $tz) {
            $t->tz = $tz;
        } elsif (defined $offset) {
            $t->offset = $offset;
        }

        $t->{tz_d} = $defineds{tz_d};

        return $t;
    } elsif (defined $year) { # We have a year at least...
        if (defined $month) {
            if (defined $mday) {
                $t = Time::C->new($year, $month, $mday);
            } else {
                $t = Time::C->new($year, $month);
            }
        } elsif (defined $week) {
            $t = Time::C->new($year);
            $t->day_of_week++ while ($t->week > 1);
            $t = $t->week($week)->day_of_week(1);

            if (defined $wday) { $t->day_of_week = $wday; }
            else { $t->{wday} = 0; }
        } elsif (defined $yday) {
            $t = Time::C->new($year)->day_of_year($yday);
        } else { # we have neither month, week, or day of year!
            $t = Time::C->new($year);
        }

        # Now add the time bits on top...
        if (defined $hour) { $t->hour = $hour; }
        if (defined $minute) { $t->minute = $minute; }
        if (defined $second) { $t->second = $second; }
    } else {
        # If we don't have a year, let's use the current year
        $year = Time::C->now($tz)->tz('UTC', 1)->year;
        if (defined $month) {
            if (defined $mday) {
                $t = Time::C->new($year, $month, $mday);
            } else {
                $t = Time::C->new($year, $month);
            }

            # Now add the time bits on top...
            if (defined $hour) { $t->hour = $hour; }
            if (defined $minute) { $t->minute = $minute; }
            if (defined $second) { $t->second = $second; }
        } elsif (defined $week) {
            $t = Time::C->new($year);
            $t->day_of_week++ while ($t->week > 1);
            $t = $t->week($week)->day_of_week(1);

            if (defined $wday) { $t->day_of_week = $wday; }
            else { $t->{wday} = 0; }

            # Now add the time bits on top...
            if (defined $hour) { $t->hour = $hour; }
            if (defined $minute) { $t->minute = $minute; }
            if (defined $second) { $t->second = $second; }
        } elsif (defined $yday) {
            $t = Time::C->new($year)->day_of_year($yday);

            # Now add the time bits on top...
            if (defined $hour) { $t->hour = $hour; }
            if (defined $minute) { $t->minute = $minute; }
            if (defined $second) { $t->second = $second; }
        } else {
            # We have neither year, month, week, or day of year ...
            # So let's just make a time for today's date
            $t = Time::C->now($tz)->second_of_day(0)->tz('UTC', 1);

            # Mark these as being undefined
            $t->{epoch_d} = $t->{tz_d} = $t->{offset} = $t->{year} =
              $t->{month} = $t->{mday} = $t->{week} = $t->{wday} = $t->{yday} =
              $t->{hour} = $t->{minute} = $t->{second} = 0;

            croak "Could not mktime: No date specified and no time given."
              if not defined $hour and not defined $minute and not defined $second;

            # And add the time bits on top...
            # - if hour not defined, use current hour
            # - if hour and minute not defined, use current minute
            if (defined $hour) { $t->hour = $hour; } else { $t->hour = Time::C->now($tz)->tz('UTC', 1)->hour; }
            if (defined $minute) { $t->minute = $minute; } elsif (not defined $hour) { $t->second_of_day = Time::C->now($tz)->tz('UTC', 1)->second(0)->second_of_day; }
            if (defined $second) { $t->second = $second; }
        }
        $t->{year} = 0;
    }

    # And last, adjust for timezone bits

    if (defined $tz) {
        $t = $t->tz($tz, 1);
    } elsif (defined $offset) {
        $t->_tm = $t->tm->with_offset_same_local($offset);
        $t->offset = $offset;
    }

    return $t;
}


method localtime ($c: $epoch, $tz = $ENV{TZ}) {
    my %defineds = (
        epoch_d => 1,
        year => 1,
        month => 1,
        mday => 1,
        week => 1,
        wday => 1,
        yday => 1,
        hour => 1,
        minute => 1,
        second => 1,
        tz_d => defined($tz),
        offset => 0,
    );
    $tz = 'UTC' unless defined $tz;
    _verify_tz($tz);
    bless {epoch => $epoch, tz => $tz, %defineds}, $c;
}


method gmtime ($c: $epoch) { $c->localtime( $epoch, 'UTC' ); }


method now ($c: $tz = $ENV{TZ}) { $c->localtime( time, $tz ); }


method now_utc ($c:) { $c->localtime( time, 'UTC' ); }


method from_string ($c: $str, :$format = undef, :$locale = 'C', :$strict = 1, :$tz = 'UTC') {
    my %p = _parse($str, $format, $tz, locale => $locale, strict => $strict);

    return $c->mktime(%p);
}


method strptime ($c: $str, $format, :$locale = 'C', :$strict = 1) {
    my %struct;
    if (ref $c) {
        my $t = $c;
        if ($t->{year}) { $struct{year} = $t->year; }
        if ($t->{month}) { $struct{month} = $t->month; }
        if ($t->{mday}) { $struct{mday} = $t->day; }
        if ($t->{week}) { $struct{week} = $t->week; }
        if ($t->{wday}) { $struct{wday} = $t->day_of_week; }
        if ($t->{yday}) { $struct{yday} = $t->day_of_year; }
        if ($t->{hour}) { $struct{hour} = $t->hour; }
        if ($t->{minute}) { $struct{minute} = $t->minute; }
        if ($t->{second}) { $struct{second} = $t->second; }
        if ($t->{tz_d}) { $struct{tz} = $t->{tz}; }
        if ($t->{offset}) { $struct{offset} = $t->offset; }
    }
    %struct = Time::P::strptime($str, $format, locale => $locale, strict => $strict, struct => \%struct);

    if (ref $c) {
        my $t = $c;

        if (defined $struct{tz}) {
            $t->tz = $struct{tz};
        } elsif (defined $struct{offset}) {
            $t->offset = $struct{offset};
        }

        if (defined $struct{epoch}) { return $t->epoch($struct{epoch}); }

        if (defined $struct{year}) { $t->year = $struct{year}; }

        if (defined $struct{month}) {
            $t->month = $struct{month};
            if (defined $struct{mday}) { $t->day = $struct{mday}; }
        } elsif (defined $struct{week}) {
            $t->week = $struct{week};
            if (defined $struct{wday}) { $t->day_of_week = $struct{wday}; }
        } elsif (defined $struct{yday}) {
            $t->day_of_year = $struct{yday};
        }

        if (defined $struct{hour}) { $t->hour = $struct{hour}; }
        if (defined $struct{minute}) { $t->minute = $struct{minute}; }
        if (defined $struct{second}) { $t->second = $struct{second}; }

        return $t;
    } else {
        return $c->mktime(%struct);
    }
}

fun _verify_tz ($tz) {
    _get_offset(time, $tz);
}

my %tz_offset = (
    -720 => 'Etc/GMT+12',
    -660 => 'Etc/GMT+11',
    -600 => 'Etc/GMT+10',
    -540 => 'Etc/GMT+9',
    -480 => 'Etc/GMT+8',
    -420 => 'Etc/GMT+7',
    -360 => 'Etc/GMT+6',
    -300 => 'Etc/GMT+5',
    -240 => 'Etc/GMT+4',
    -180 => 'Etc/GMT+3',
    -120 => 'Etc/GMT+2',
    -60  => 'Etc/GMT+1',
    0    => 'UTC',
    60   => 'Etc/GMT-1',
    120  => 'Etc/GMT-2',
    180  => 'Etc/GMT-3',
    240  => 'Etc/GMT-4',
    300  => 'Etc/GMT-5',
    360  => 'Etc/GMT-6',
    420  => 'Etc/GMT-7',
    480  => 'Etc/GMT-8',
    540  => 'Etc/GMT-9',
    600  => 'Etc/GMT-10',
    660  => 'Etc/GMT-11',
    720  => 'Etc/GMT-12',
    780  => 'Etc/GMT-13',
    840  => 'Etc/GMT-14',
);

fun _get_tz ($offset) {
    return 'UTC' unless $offset;

    return $tz_offset{$offset} if defined $tz_offset{$offset};

    my $min = $offset % 60;
    my $hour = int $offset / 60;
    my $sign = '+';
    if ($hour < 0) { $sign = '-'; $hour = -$hour; }

    return sprintf "%s%02s:%02s", $sign, $hour, $min;
}

fun _parse ($str, $format = undef, $tz = 'UTC', :$locale = 'C', :$strict = 1) {
    if (defined $format) {
        my %struct = ();
        my $e = eval { %struct = Time::P::strptime($str, $format, locale => $locale, strict => $strict); 1; };
        return %struct if $e;

        croak sprintf "Could not parse %s using %s: %s", $str, $format, $@;
    }

    my $tm = eval { Time::Moment->from_string($str); };
    croak sprintf "Could not parse %s.", $str if not defined $tm;

    my $epoch = $tm->epoch;
    my $offset = $tm->offset;

    my @ret = (epoch => $epoch, offset => $offset);
    if ($offset == Time::Zone::Olson->new({timezone => $tz})->local_offset($epoch)) {
        push @ret, tz => $tz;
    }

    return @ret;
}



method epoch ($t: $new_epoch = undef) :lvalue {
    my $epoch = $t->{epoch};

    my $setter = sub {
        $t->{epoch} = $_[0];

        %$t = (%$t, epoch_d => 1, year => 1, yday => 1, month => 1, mday => 1, week => 1, wday => 1, hour => 1,  minute => 1, second => 1, );

        return $t if defined $new_epoch;
        return $_[0];
    };

    return $setter->($new_epoch) if defined $new_epoch;

    sentinel value => $epoch, set => $setter;
}


method tz ($t: $new_tz = undef, $override = 0) :lvalue {
    my $setter = sub {
        _verify_tz($_[0]);

        if ($override) {
            my $l = Time::C->new($t->year, $t->month, $t->day, $t->hour, $t->minute, $t->second, $_[0]);
            $t->{epoch} = $l->epoch;
        }

        $t->{tz} = $_[0];
        $t->{tz_d} = 1;

        return $t if defined $new_tz;
        return $t->{tz};
    };

    return $setter->($new_tz) if defined $new_tz;

    sentinel value => $t->{tz}, set => $setter;
}

fun _get_offset ($epoch, $tz) {
    my $offset = eval { Time::Zone::Olson->new({timezone => $tz})
      ->local_offset($epoch); };

    if (not defined $offset) {
        if ($tz =~ /^([+-])(\d+):(\d+)$/) {
            my ($sign, $hour, $min) = ($1, $2, $3);
            $offset = 60 * $hour + $min;
            $offset = -$offset if $sign eq '-';
        }
    }

    croak sprintf "Unknown timezone %s.", $tz
      if not defined $offset;

    return $offset;
}


method offset ($t: $new_offset = undef) :lvalue {
    my $setter = sub {
        $t->{tz} = _get_tz($_[0]);
        $t->{offset} = 1;

        return $t if defined $new_offset;
        return $_[0];
    };

    return $setter->($new_offset) if defined $new_offset;

    my $offset = _get_offset($t->{epoch}, $t->{tz});

    sentinel value => $offset, set => $setter;
}


method tm ($t: $new_tm = undef) :lvalue {
    my $setter = sub {
        $t->_tm = $_[0];
        $t->epoch = $t->epoch; # update definedness values

        return $t if defined $new_tm;
        return $_[0];
    };

    return $setter->($new_tm) if defined $new_tm;

    sentinel value => $t->_tm(), set => $setter;
}

method _tm ($t: $new_tm = undef) :lvalue {
    $t->{tz} = 'UTC' if not defined $t->{tz};

    my $setter = sub {
        $t->{epoch} = $_[0]->with_offset_same_instant(0)->epoch;

        return $t if defined $new_tm;
        return $_[0];
    };

    return $setter->($new_tm) if defined $new_tm;

    my $tm = Time::Moment->from_epoch($t->{epoch});

    if ($t->{tz} ne 'GMT' and $t->{tz} ne 'UTC') {
        $tm = $tm->with_offset_same_instant($t->offset);
    }

    sentinel value => $tm, set => $setter;
}


# need to parse the @args specially since F::P can't handle the signature
method string ($t: @args) :lvalue {
    my ($new_str, $format, $locale, $strict) = (undef, undef, 'C', 1);
    if (@args % 2) { $new_str = shift @args; }
    my %args = @args;
    $format = delete $args{format} if exists $args{format};
    $locale = delete $args{locale} if exists $args{locale};
    $strict = delete $args{strict} if exists $args{strict};
    croak sprintf "In method string: no such named parameter: %s", sort keys %args if %args;

    $t->{tz} = 'UTC' if not defined $t->{tz};

    my $setter = sub {
        my %struct = _parse($_[0], $format, $t->{tz}, locale => $locale, strict => $strict);

        if (defined $struct{tz}) {
            $t->tz = $struct{tz};
        } elsif (defined $struct{offset}) {
            $t->offset = $struct{offset};
        }

        if (defined $struct{epoch}) { return $t->epoch($struct{epoch}); }

        if (defined $struct{year}) { $t->year = $struct{year}; }

        if (defined $struct{month}) {
            $t->month = $struct{month};
            if (defined $struct{mday}) { $t->day = $struct{mday}; }
        } elsif (defined $struct{week}) {
            $t->week = $struct{week};
            if (defined $struct{wday}) { $t->day_of_week = $struct{wday}; }
        } elsif (defined $struct{yday}) {
            $t->day_of_year = $struct{yday};
        }

        if (defined $struct{hour}) { $t->hour = $struct{hour}; }
        if (defined $struct{minute}) { $t->minute = $struct{minute}; }
        if (defined $struct{second}) { $t->second = $struct{second}; }

        return $t if defined $new_str;
        return $_[0];
    };

    return $setter->($new_str) if defined $new_str;

    my $str;
    if (defined $format) {
        $str = Time::F::strftime($t, $format, locale => $locale);
    } else {
        $str = $t->tm->to_string;
    }

    sentinel value => $str, set => $setter;
}


method strftime ($t: @args) :lvalue { $t->string(@args); }


method year ($t: $new_year = undef) :lvalue {
    my $tm = $t->tm();

    my $setter = sub {
        my $ret = ($t->_tm = $tm->with_year($_[0]))->year;
        $t->{year} = 1;

        return $t if defined $new_year;
        return $ret;
    };

    return $setter->($new_year) if defined $new_year;

    sentinel value => $tm->year, set => $setter;
}


method quarter ($t: $new_quarter = undef) :lvalue {
    my $tm = $t->tm();

    my $setter = sub {
        my $ret = ($t->_tm = $tm->plus_months(3*$_[0] - $tm->month))->quarter;
        $t->{month} = 1;

        return $t if defined $new_quarter;
        return $ret;
    };

    return $setter->($new_quarter) if defined $new_quarter;

    sentinel value => $tm->quarter, set => $setter;
}


method month ($t: $new_month = undef) :lvalue {
    my $tm = $t->tm();

    my $setter = sub {
        my $ret = ($t->_tm = $tm->plus_months($_[0] - $tm->month))->month;
        $t->{month} = 1;

        return $t if defined $new_month;
        return $ret;
    };

    return $setter->($new_month) if defined $new_month;

    sentinel value => $tm->month, set => $setter;
}


method week ($t: $new_week = undef) :lvalue {
    my $tm = $t->tm();

    my $setter = sub {
        my $ret = ($t->_tm = $tm->plus_weeks($_[0] - $tm->week))->week;
        $t->{week} = 1;

        return $t if defined $new_week;
        return $ret;
    };

    return $setter->($new_week) if defined $new_week;

    sentinel value => $tm->week, set => $setter;
}


method day ($t: $new_day = undef) :lvalue { $t->day_of_month(@_) }


method day_of_month ($t: $new_day = undef) :lvalue {
    my $tm = $t->tm();

    my $setter = sub {
        my $ret = ($t->_tm = $tm->plus_days($_[0] - $tm->day_of_month))->day_of_month;
        $t->{mday} = 1;

        return $t if defined $new_day;
        return $ret;
    };

    return $setter->($new_day) if defined $new_day;

    sentinel value => $tm->day_of_month, set => $setter;
}


method day_of_year ($t: $new_day = undef) :lvalue {
    my $tm = $t->tm();

    my $setter = sub {
        my $ret = ($t->_tm = $tm->plus_days($_[0] - $tm->day_of_year))->day_of_year;
        $t->{yday} = 1;

        return $t if defined $new_day;
        return $ret;
    };

    return $setter->($new_day) if defined $new_day;

    sentinel value => $tm->day_of_year, set => $setter;
}


method day_of_quarter ($t: $new_day = undef) :lvalue {
    my $tm = $t->tm();

    my $setter = sub {
        my $ret = ($t->_tm = $tm->plus_days($_[0] - $tm->day_of_quarter))->day_of_quarter;
        $t->{mday} = 1;

        return $t if defined $new_day;
        return $ret;
    };

    return $setter->($new_day) if defined $new_day;

    sentinel value => $tm->day_of_quarter, set => $setter;
}


method day_of_week ($t: $new_day = undef) :lvalue {
    my $tm = $t->tm();

    my $setter = sub {
        my $ret = ($t->_tm = $tm->plus_days($_[0] - $tm->day_of_week))->day_of_week;
        $t->{wday} = 1;

        return $t if defined $new_day;
        return $ret;
    };

    return $setter->($new_day) if defined $new_day;

    sentinel value => $tm->day_of_week, set => $setter;
}


method hour ($t: $new_hour = undef) :lvalue {
    my $tm = $t->tm();

    my $setter = sub {
        my $ret = ($t->_tm = $tm->plus_hours($_[0] - $tm->hour))->hour;
        $t->{hour} = 1;

        return $t if defined $new_hour;
        return $ret;
    };

    return $setter->($new_hour) if defined $new_hour;

    sentinel value => $tm->hour, set => $setter;
}


method minute ($t: $new_minute = undef) :lvalue {
    my $tm = $t->tm();

    my $setter = sub {
        my $ret = ($t->_tm = $tm->plus_minutes($_[0] - $tm->minute))->minute;
        $t->{minute} = 1;

        return $t if defined $new_minute;
        return $ret;
    };

    return $setter->($new_minute) if defined $new_minute;

    sentinel value => $tm->minute, set => $setter;
}


method second ($t: $new_second = undef) :lvalue {
    my $tm = $t->tm();

    my $setter = sub {
        my $ret = ($t->_tm = $tm->plus_seconds($_[0] - $tm->second))->second;
        $t->{second} = 1;

        return $t if defined $new_second;
        return $ret;
    };

    return $setter->($new_second) if defined $new_second;

    sentinel value => $tm->second, set => $setter;
}


method second_of_day ($t: $new_second = undef) :lvalue {
    my $tm = $t->tm();

    my $setter = sub {
        my $ret = ($t->_tm = $tm->plus_seconds($_[0] - $tm->second_of_day))->second_of_day;
        $t->{second} = $t->{minute} = $t->{hour} = 1;

        return $t if defined $new_second;
        return $ret;
    };

    return $setter->($new_second) if defined $new_second;

    sentinel value => $tm->second_of_day, set => $setter;
}



method diff ($t: $t2) {
    my $epoch =
      ref $t2 ?
        $t2->can('epoch') ?
          $t2->epoch :
          croak "Object with no ->epoch method passed (". ref $t2 .")." :
        $t2;
    return Time::D->new($t->epoch, $epoch);
}


method clone($t:) {
    my $c = ref $t;

    my $t2 = { %$t };
    bless $t2, $c;
}

1;

__END__