view release on metacpan or  search on metacpan

lib/DateTime/Calendar/FrenchRevolutionary.pm  view on Meta::CPAN

# -*- encoding: utf-8; indent-tabs-mode: nil -*-
#
# Perl DateTime extension for converting to/from the French Revolutionary calendar
# Copyright (c) 2003, 2004, 2010, 2011, 2012, 2014, 2016, 2019, 2021 Jean Forget. All rights reserved.
#
# See the license in the embedded documentation below.
#

package DateTime::Calendar::FrenchRevolutionary;

use utf8;
use strict;
use warnings;

use vars qw($VERSION);
$VERSION = '0.17';

use Params::Validate qw(validate SCALAR BOOLEAN OBJECT);
use Roman;
use DateTime;
use DateTime::Calendar::FrenchRevolutionary::Locale;

my $BasicValidate =
    { year   => { type => SCALAR },
      month  => { type => SCALAR, default => 1,
                  callbacks =>
                  { 'is between 1 and 13' =>
                    sub { $_[0] >= 1 && $_[0] <= 13 }
                  },
                },
      day    => { type => SCALAR, default => 1,
                  callbacks =>
                  { 'is between 1 and 30' =>
                    sub { $_[0] >= 1 && $_[0] <= 30 },
                  },
                },
      hour   => { type => SCALAR, default => 0,
                  callbacks =>
                  { 'is between 0 and 9' =>
                    sub { $_[0] >= 0 && $_[0] <= 9 },
                  },
                },
      minute => { type => SCALAR, default => 0,
                  callbacks =>
                  { 'is between 0 and 99' =>
                    sub { $_[0] >= 0 && $_[0] <= 99 },
                  },
                },
      second => { type => SCALAR, default => 0,
                  callbacks =>
                  { 'is between 0 and 99' =>
                    sub { $_[0] >= 0 && $_[0] <= 99 },
                  },
                },
      abt_hour   => { type => SCALAR, default => 0,
                  callbacks =>
                  { 'is between 0 and 23' =>
                    sub { $_[0] >= 0 && $_[0] <= 23 },
                  },
                },
      abt_minute => { type => SCALAR, default => 0,
                  callbacks =>
                  { 'is between 0 and 59' =>
                    sub { $_[0] >= 0 && $_[0] <= 59 },
                  },
                },
      abt_second => { type => SCALAR, default => 0,
                  callbacks =>
                  { 'is between 0 and 61' =>
                    sub { $_[0] >= 0 && $_[0] <= 61 },
                  },
                },
      nanosecond => { type => SCALAR, default => 0,
                      callbacks =>
                      { 'cannot be negative' =>
                        sub { $_[0] >= 0 },
                      }
                    },
      locale    => { type => SCALAR | OBJECT,
                      callbacks =>
                      { "only 'fr', 'en', 'es' and 'it' possible" =>
                        sub { ($_[0] eq 'fr') or ($_[0] eq 'en')
                                              or ($_[0] eq 'es')
                                              or ($_[0] eq 'it')
                                              or ref($_[0]) =~ /(?:en|es|fr|it)$/ },
                      },
                     default => DefaultLocale() },
    };

my $NewValidate =
    { %$BasicValidate,
      time_zone => { type => SCALAR | OBJECT,
                      callbacks =>
                      { "only 'floating' possible" =>
                        sub { ($_[0] eq 'floating') or ref($_[0]) and $_[0]->is_floating },
                      },
                     default => 'floating' },
    };
my $Lastday_validate = { %$BasicValidate };
delete $Lastday_validate->{day};

# Constructors
sub new {
    my $class = shift;
    my %args = validate( @_, $NewValidate );

    my $self = {};

    $self->{tz} = DateTime::TimeZone->new(name => 'floating');
    if ( ref $args{locale} )
      { $self->{locale} = $args{locale} }
    else
      { $self->{locale} = DateTime::Calendar::FrenchRevolutionary::Locale->load( $args{locale} ) }

    $self->{local_rd_days} = $class->_ymd2rd(@args{qw(year month day)});
    my $abtsecs = $class->_time_as_abt_seconds(@args{qw(abt_hour abt_minute abt_second)});
    my $decsecs = $class->_time_as_seconds(@args{qw(hour minute second)});
    warn("You cannot specify both 24x60x60 time and 10x100x100 time when initializing a date")
        if $^W && $abtsecs && $decsecs;
    # We prefer decimal time over Anglo-Babylonian time when initializing a date
    $self->{local_rd_secs} = $decsecs ? $decsecs : $abtsecs;
    $self->{rd_nano} =  $args{nanosecond};

    bless $self, $class;
    $self->_calc_local_components;
    $self->_calc_utc_rd;

    return $self;
}

sub from_epoch {
  my $class = shift;
  my %args = validate( @_,
                         { epoch => { type => SCALAR },
                          locale => { type => SCALAR | OBJECT,
                                      default => $class->DefaultLocale },

                         }
                       );

  my $date = DateTime->from_epoch(%args);
  return $class->from_object(object => $date);
}

# use scalar time in case someone's loaded Time::Piece
sub now { shift->from_epoch(epoch => (scalar time), @_) }

sub from_object {
  my $class = shift;
  my %args = validate(@_,
                         { object => { type => OBJECT,
                                       can => 'utc_rd_values',
                                     },