File Coverage

blib/lib/Mojar/Cron/Date.pm

Criterion	Covered	Total	%
statement	37	64	57.8
branch	7	28	25.0
condition	6	20	30.0
subroutine	12	27	44.4
pod	15	19	78.9
total	77	158	48.7

package Mojar::Cron::Date;
use Mojo::Base -strict;

our $VERSION = 0.021;

use Carp qw(croak);
use POSIX qw(strftime);
use Scalar::Util qw(blessed);

use overload
  '""'  => sub { ${$_[0]} },
  '<=>' => sub { (${$_[0]} cmp $_[1]) * ($_[2] ? -1 : 1) },
  fallback => 1;

sub new {
  my $proto = shift;
  my $class = ref $proto || $proto;
  my $payload = @_ ? shift : ref $proto ? $$proto : $class->today;
  bless \$payload => $class;
}

sub today {
  my ($d, $m , $y) = (localtime)[3, 4, 5];
  return shift->new(sprintf '%04u-%02u-%02u', $y + 1900, $m + 1, $d);
}

sub current {
  my ($d, $m , $y) = (gmtime)[3, 4, 5];
  return shift->new(sprintf '%04u-%02u-%02u', $y + 1900, $m + 1, $d);
}

sub roll {
  my ($self, $days) = @_;
  croak 'Not a class method' unless ref $self;
  croak "Bad date format ($$self)" unless $$self =~ /^(\d{4})-(\d\d)-(\d\d)\b/a;
  $$self = strftime '%Y-%m-%d', 0, 0, 12, $3 + ($days // 0), $2 - 1, $1 - 1900;
  return $self;
}

sub roll_back { shift->roll(-(shift // 0)) }

sub after { shift->new->roll(shift) }

sub before { shift->new->roll(-(shift // 0)) }

sub next { shift->new->roll(1) }

sub previous { shift->new->roll(-1) }

sub tomorrow { shift->today->roll(1) }

sub yesterday { shift->today->roll(-1) }

sub format {
  my ($self, $format, $date) = @_;
  $date ||= ref $self ? $$self : croak 'Missing required date';
  croak "Bad date format ($date)" unless $date =~ /^(\d{4})-(\d\d)-(\d\d)\b/a;
  die "Unsupported platform ($^O)" unless $^O eq 'linux';
  strftime($format || '%Y-%m-%d', 0, 0, 0, $3, $2 - 1, $1 - 1900);
}

sub dow { shift->format('%u', @_) }

sub yearweek { shift->format('%G%V', @_) }

sub yearweekday { shift->format('%GW%V%u', @_) }

sub is_weekend {
  my $self = shift;
  my $dow = $self->dow(shift);
  $dow == 6 or $dow == 7;
}

sub roll_to {
  my ($self, $dow) = @_;
  croak 'Missing required day-of-the-week' unless defined $dow;
  my $day = $self->dow;
  $self->roll(($dow - $day) % 7);
}

sub epoch_days {
  my ($self) = @_;
  croak "Bad date format ($$self)" unless $$self =~ /^(\d{4})-(\d\d)-(\d\d)\b/a;
  die "Unsupported platform ($^O)" unless $^O eq 'linux';
  return _epoch_days($1, $2, $3);
}

sub sleeps {
  my ($self, $other) = @_;
  (blessed $other and $other->isa('Mojar::Cron::Date'))
    ? $other->epoch_days - $self->epoch_days
    : ref $other
      ? croak sprintf('Invalid type (%s)', ref $other)
      : $other - $self->epoch_days;
}

# Determine base value for epoch
my $Epoch = 0;  # starting point, affects base value
$Epoch = _epoch_days(1970, 1, 1);  # set base value
my %Cache = ();  # reset cache after above calculation

sub _epoch_days {
  # Args: ($year, $1-based-month, $day-of-month)
  # Borrowed from Time::Local...
  # Only expected to be correct on linux
  $_[2] + ($Cache{pack ss => @_[0, 1]} ||= do {
    my $month = ($_[1] + 9) % 12;
    my $year  = $_[0] - int($month / 10);

    365 * $year
    + int($year / 4) - int($year / 100) + int($year / 400)
    + int(($month * 306 + 5) / 10)
    - $Epoch;
  })
}

1;
__END__