view release on metacpan or  search on metacpan

lib/Mojar/Cron/Datetime.pm  view on Meta::CPAN

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

our $VERSION = 0.101;

use Carp qw(carp croak);
use Mojar::ClassShare 'have';
use Mojar::Cron::Util qw(balance life_to_zero normalise_local normalise_utc
    time_to_zero zero_to_time utc_to_ts local_to_ts);
use POSIX 'strftime';

our @TimeFields = qw(sec min hour day month year);

# Normal maxima (soft limits)
%Mojar::Cron::Datetime::Max = (
  sec  => 59,
  min  => 59,
  hour => 23,
  day => 30,
  month  => 11,
  weekday => 6
);
@Mojar::Cron::Datetime::Max =
    @Mojar::Cron::Datetime::Max{qw(sec min hour day month weekday)};

# Class attributes
# (not usable on objects)

# Constructors

sub new {
  my $class = shift;
  my $self;
  if (ref $class) {
    # Clone
    $self = [ @$class ];
    $class = ref $class;
    carp sprintf 'Useless arguments to new (%s)', join ',', @_ if @_;
  }
  elsif (@_ == 0) {
    # Zero member
    $self = [0,0,0, 0,0,0];
  }
  elsif (@_ == 1) {
    # Pre-generated
    croak "Non-ref argument to new ($self)" unless ref($self = shift);
  }
  else {
    $self = [ @_ ];
  }
  bless $self => $class;
  return $self->normalise;  # Calculate weekday etc
}

sub from_string {
  my ($class, $iso_date) = @_;
  $class = ref $class || $class;
  if ($iso_date
      =~ /^(\d{4})-(\d{2})-(\d{2})(?:T|\s)(\d{2}):(\d{2}):(\d{2})Z?$/) {
    return $class->new(life_to_zero($6, $5, $4, $3, $2, $1));
  }
  croak "Failed to parse datetime string ($iso_date)";
}

sub from_timestamp {
  my ($class, $timestamp, $is_local) = @_;
  $class = ref $class || $class;
  my @parts = $is_local ? localtime $timestamp
                        : gmtime $timestamp;
  return $class->new( time_to_zero @parts );
}

sub now { shift->from_timestamp(time, @_) }

# Public methods

sub copy {
  my ($self, $original) = @_;
  return unless ref $original;
  return $self->clone(@_) unless ref $self;
  @$self = @$original;
  return $self;
}

sub reset_parts {
  my ($self, $end) = @_;
  $$self[$_] = 0 for 0 .. $end;
  return $self;
}

sub weekday {
  my $self = shift;
  return +($self->normalise(@$self))[6];
}

sub normalise {
  my $self = shift;
  my @parts = @_ ? @_ : @$self;
  @parts = time_to_zero normalise_utc zero_to_time @parts;
  return @parts if @_;  # operating on argument

  @$self = @parts;  # operating on invocant
  return $self;
}

sub to_timestamp {
  my ($self, $is_local) = @_;
  return $is_local ? local_to_ts zero_to_time @$self
                   : utc_to_ts zero_to_time @$self;
}