DateTime::Calendar::FrenchRevolutionary - Dates in the French Revolutionary Calendar

  use DateTime::Calendar::FrenchRevolutionary;

  $dt = DateTime::Calendar::FrenchRevolutionary->new( year  => 8,
                                         month =>  2,
                                         day   => 18,
                                       );

  # convert FrenchRevolutionary->Gregorian...

  $dtgreg = DateTime->from_object( object => $dt );

  # ... and back again

  $dtrev = DateTime::Calendar::FrenchRevolutionary->from_object( object => $dtgreg );

package DateTime::Calendar::FrenchRevolutionary;

use strict;

use vars qw($VERSION);

$VERSION = '0.08';

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' and 'en' possible" =>
                        sub { ($_[0] eq 'fr') or ($_[0] eq 'en') or ref($_[0]) =~ /(?:en|fr)$/ },
                      },
                     default => 'fr' },
    };

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');
    $args{locale} = delete $args{language} if exists $args{language};
    $args{locale} = $class->DefaultLocale unless defined $args{locale};
    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',
                                     },
                           locale => { type => SCALAR | OBJECT,
                                      default => $class->DefaultLocale },
                         },
                       );

  my $object = delete $args{object};
  $object = $object->clone->set_time_zone('floating')
      if $object->can('set_time_zone');

  my ($rd_days, $rd_secs, $rd_nano) = $object->utc_rd_values;

  my %p;
  @p{ qw(year  month   day) }     = $class->_rd2ymd($rd_days);
  # ABT seconds preferred over decimal seconds, because of precision loss
  @p{ qw(abt_hour  abt_minute  abt_second) }  = $class->_abt_seconds_as_components($rd_secs);
  # nanoseconds are copied, never converted ABT to decimal or reverse
  $p{nanosecond} = $rd_nano || 0;
  #@p{ qw(hour minute second) } = $class->_seconds_as_components($rd_secs);

  my $new = $class->new(%p, %args, time_zone => 'floating');

  return $new;
}

sub last_day_of_month {
    my $class = shift;
    my %p = validate( @_, $Lastday_validate);
    my $day = $p{month} <= 12 ? 30 : $class->_is_leap_year($p{year}) ? 6 : 5;
    return $class->new(%p, day => $day);
}

sub clone { bless { %{ $_[0] } }, ref $_[0] }

# Many of the same parameters as new() but all of them are optional,
# and there are no defaults.
my $SetValidate =
    { map { my %copy = %{ $BasicValidate->{$_} };
            delete $copy{default};
            $copy{optional} = 1;
            $_ => \%copy }
      keys %$BasicValidate };
sub set
{
    my $self = shift;
    my %p = validate( @_, $SetValidate );

    my %old_p =
        ( map { $_ => $self->$_() }
          qw( year month day hour minute second nanosecond locale )
        );

    my $new_dt = (ref $self)->new( %old_p, %p );

    %$self = %$new_dt;

    return $self;
}

sub set_time_zone { } # do nothing, only 'floating' allowed

# Internal functions
use constant REV_BEGINNING => 654415; # RD value for 1 Vendémiaire I in the Revolutionary calendar
use constant NORMAL_YEAR    => 365;
use constant LEAP_YEAR      => 366;
use constant FOUR_YEARS     =>  4 * NORMAL_YEAR + 1; # one leap year every four years
use constant CENTURY        => 25 * FOUR_YEARS - 1;  # centuries aren't leap years...
use constant FOUR_CENTURIES =>  4 * CENTURY + 1;     # ...except every four centuries that are.
use constant FOUR_MILLENIA  => 10 * FOUR_CENTURIES - 1; # ...except every four millenia that are not.

# number of days between the start of the revolutionary calendar, and the
# beginning of year n - 1 as long as the equinox rule is in effect
my @YEARS_BEGINS=    (0, 365, 730, 1096, 1461, 1826, 2191, 2557, 2922, 3287, 3652,
		   4018, 4383, 4748, 5113, 5479, 5844);
sub _is_leap_year {
    my ($self, $year) = @_;

    # Autumn equinox from I to XIX
    return 1 if ($year == 3) or ($year == 7) or ($year == 11) or ($year == 15);
    return 0 if ($year < 20);

    # Romme rule from XX on
    return 0 if $year %    4; # not a multiple of 4 -> normal year
    return 1 if $year %  100; # a multiple of 4 but not of 100 is a leap year
    return 0 if $year %  400; # a multiple of 100 but not of 400 is a normal year
    return 1 if $year % 4000; # a multiple of 400 but not of 4000 is leap
    return 0; # a multiple of 4000 is a normal year
}

sub _calc_utc_rd {
  my $self = shift;

  delete $self->{utc_c};

  if ($self->{tz}->is_utc)
    {
      $self->{utc_rd_days} = $self->{local_rd_days};
      $self->{utc_rd_secs} = $self->{local_rd_secs};
      return;
    }

  $self->{utc_rd_days} = $self->{local_rd_days};
  $self->{utc_rd_secs} = $self->{local_rd_secs} - $self->_offset_from_local_time;
  _normalize_seconds($self->{utc_rd_days}, $self->{utc_rd_secs}, $self->{rd_nano});
}

sub _calc_local_rd {
  my $self = shift;

  delete $self->{local_c};

  # We must short circuit for UTC times or else we could end up with
  # loops between DateTime.pm and DateTime::TimeZone
  if ($self->{tz}->is_utc)
    {
      $self->{local_rd_days} = $self->{utc_rd_days};
      $self->{local_rd_secs} = $self->{utc_rd_secs};
    }
   else
    {
      $self->{local_rd_days} = $self->{utc_rd_days};
      $self->{local_rd_secs} = $self->{utc_rd_secs} + $self->offset;
      _normalize_seconds($self->{local_rd_days}, $self->{local_rd_secs});
    }

    $self->_calc_local_components;
}

sub _normalize_seconds {
  my ($d, $s) = @_;
  my $adj;
  if ($s < 0)
    { $adj = int(($s - 86399) / 86400) }
  else
    { $adj = int($s / 86400) }
  $_[0] += $adj;
  $_[1] -= $adj * 86400;
}

sub _calc_local_components {
  my $self = shift;
  @{ $self->{local_c} }{ qw(year month day day_of_decade day_of_year) } 
        = $self->_rd2ymd($self->{local_rd_days}, 1);
  @{ $self->{local_c} }{ qw(abt_hour abt_minute abt_second) }
        = $self->_abt_seconds_as_components($self->{local_rd_secs});
  @{ $self->{local_c} }{ qw(hour minute second) }
        = $self->_seconds_as_components($self->{local_rd_secs});
}

sub _calc_utc_components {
  my $self = shift;
  @{ $self->{utc_c} }{ qw(year month day) } = $self->_rd2ymd($self->{utc_rd_days});
  @{ $self->{utc_c} }{ qw(abt_hour abt_minute abt_second) }
          = $self->_abt_seconds_as_components($self->{utc_rd_secs});
  @{ $self->{utc_c} }{ qw(hour minute second) } 
          = $self->_seconds_as_components($self->{utc_rd_secs});
}

sub _ymd2rd {
    my ($self, $y, $m, $d) = @_;
    my $rd = REV_BEGINNING - 1; # minus 1 for the zeroth Vendémiaire
    $y --;  #get years *before* this year.  Makes math easier.  :)
    # first, convert year into days. . .
    if ($y < 0 || $y >= 16) # Romme rule in effect, or nearly so
      {
        my $x = int($y/4000);
        --$x if $y <= 0;
	$rd += $x * FOUR_MILLENIA;
	$y  %= 4000;
	$rd += int($y/400)* FOUR_CENTURIES;
	$y  %= 400;
	$rd += int($y/100)* CENTURY;
	$y  %= 100;
	$rd += int($y/4)* FOUR_YEARS;
	$y  %= 4;
	$rd += $y * NORMAL_YEAR;
      }
    else # table look-up for the programmer-hostile equinox rule
      {	$rd += $YEARS_BEGINS[$y] }

    # now, month into days.
    $rd += 30 * ($m - 1) + $d;
    return $rd;
}

sub _rd2ymd {
    my ($self, $rd, $extra) = @_;

    my $doy;
    my $y;
    # note:  years and days are initially days *before* today, rather than
    # today's date.  This is because of fenceposts.  :)
    $doy =  $rd - REV_BEGINNING;
    if ($doy >= 0 && $doy < $YEARS_BEGINS[16])
      {
       	$y = scalar grep { $_ <= $doy } @YEARS_BEGINS;
	$doy -= $YEARS_BEGINS[$y - 1];
	$doy++;
      }
    else
      {
	#$doy --;
	my $x;
	$x    = int ($doy / FOUR_MILLENIA);
        --$x  if $doy < 0; # So pre-1792 dates will give something that look about right
        $y   += $x * 4000;
	$doy -= $x * FOUR_MILLENIA;

	$x    = int ($doy / FOUR_CENTURIES);
        $y   += $x * 400;
	$doy -= $x * FOUR_CENTURIES;

	$x    = int ($doy / CENTURY);
        $x    = 3 if $x == 4; # last day of the 400-year period; see comment below
        $y   += $x * 100;
	$doy -= $x * CENTURY;

	$x    = int ($doy / FOUR_YEARS);
        $y   += $x * 4;
	$doy -= $x * FOUR_YEARS;

	$x    = int ($doy / NORMAL_YEAR);
        # The division above divides the 4-year period, 1461 days,
        # into 5 parts: 365, 365, 365, 365 and 1. This mathematically sound operation
        # is wrong with respect to the calendar, which needs to divide
        # into 4 parts: 365, 365, 365 and 366. Therefore the adjustment below.
        $x    = 3 if $x == 4; # last day of the 4-year period
        $y   += $x;
	$doy -= $x * NORMAL_YEAR;

        ++$y; # because of 0-based mathematics vs 1-based chronology
        ++$doy;
      }
    my $d  = $doy % 30 || 30;
    my $m = ($doy - $d) / 30 + 1;
    if ($extra)
      {
        # day_of_decade, day_of_year
        my $dod = ($d % 10) || 10;
        return $y, $m, $d, $dod, $doy;
      }
    return $y, $m, $d;
}

# Aliases provided for compatibility with DateTime; if DateTime switches
# over to _ymd2rd and _rd2ymd, these will be removed eventually.
*_greg2rd = \&_ymd2rd;
*_rd2greg = \&_rd2ymd;

#
# Accessors
#
sub year    { $_[0]->{local_c}{year} }

sub month   { $_[0]->{local_c}{month} }
*mon = \&month;

sub month_0 { $_[0]->{local_c}{month} - 1 };
*mon_0 = \&month_0;

sub month_name {
    my $self = shift;
    return $self->{locale}->month_name($self);
    #return $months[$self->month_0]
}

sub month_abbr {
    my $self = shift;
    return $self->{locale}->month_abbreviation($self);
    #return $months_short[$self->month_0]
}

sub day_of_month { $_[0]->{local_c}{day} }
*day  = \&day_of_month;
*mday = \&day_of_month;

sub day_of_month_0 { $_[0]->{local_c}{day} - 1 }
*day_0  = \&day_of_month_0;
*mday_0 = \&day_of_month_0;

sub day_of_decade { $_[0]->{local_c}{day} % 10 || 10 }
*dod         = \&day_of_decade;
*dow         = \&day_of_decade;
*wday        = \&day_of_decade;
*day_of_week = \&day_of_decade;

sub day_of_decade_0 { ($_[0]->{local_c}{day} - 1) % 10 }
*dod_0         = \&day_of_decade_0;
*dow_0         = \&day_of_decade_0;
*wday_0        = \&day_of_decade_0;
*day_of_week_0 = \&day_of_decade_0;

sub day_name {
    my $self = shift;
    return $self->{locale}->day_name($self);
    #return $decade_days[$self->day_of_decade_0];
}

sub day_abbr {
    my $self = shift;
    return $self->{locale}->day_abbreviation($self);
    #return $decade_days_short[$self->day_of_decade_0];
}

sub day_of_year { $_[0]->{local_c}{day_of_year} }
*doy = \&day_of_year;

sub day_of_year_0 { $_[0]->{local_c}{day_of_year} - 1 }
*doy_0 = \&day_of_year_0;

sub feast_short {
  my ($dt) = @_;
  return $dt->{locale}->feast_short($dt);
}
*feast = \&feast_short;

sub _raw_feast {
  my ($dt) = @_;
  return $dt->{locale}->_raw_feast($dt);
}

sub feast_long {
  my ($dt) = @_;
  return $dt->{locale}->feast_long($dt);
}

sub feast_caps {
  my ($dt) = @_;
  return $dt->{locale}->feast_caps($dt);
}

sub ymd {
    my ($self, $sep) = @_;
    $sep = '-' unless defined $sep;
    return sprintf("%0.4d%s%0.2d%s%0.2d",
                   $self->year, $sep,
                   $self->{local_c}{month}, $sep,
                   $self->{local_c}{day});
}
*date = \&ymd;

sub mdy {
    my ($self, $sep) = @_;
    $sep = '-' unless defined $sep;
    return sprintf("%0.2d%s%0.2d%s%0.4d",
                   $self->{local_c}{month}, $sep,
                   $self->{local_c}{day},   $sep,
                   $self->year);
}

sub dmy {
  my ($self, $sep) = @_;
  $sep = '-' unless defined $sep;
  return sprintf("%0.2d%s%0.2d%s%0.4d",
                 $self->{local_c}{day},   $sep,
                 $self->{local_c}{month}, $sep,
                 $self->year);
}

# Anglo-Babylonian (or sexagesimal) time
sub abt_hour   { $_[0]->{local_c}{abt_hour} }
sub abt_minute { $_[0]->{local_c}{abt_minute} } *abt_min = \&abt_minute;
sub abt_second { $_[0]->{local_c}{abt_second} } *abt_sec = \&abt_second;
sub abt_hms {
  my ($self, $sep) = @_;
  $sep = ':' unless defined $sep;
  return sprintf("%0.2d%s%0.2d%s%0.2d",
                    $self->{local_c}{abt_hour},   $sep,
                    $self->{local_c}{abt_minute}, $sep,
                    $self->{local_c}{abt_second});
}

sub nanosecond { $_[0]->{rd_nano} }

# Decimal time
sub hour   { $_[0]->{local_c}{hour} }
sub minute { $_[0]->{local_c}{minute} } *min = \&minute;
sub second { $_[0]->{local_c}{second} } *sec = \&second;

sub hms {
    my ($self, $sep) = @_;
    $sep = ':' unless defined $sep;
    return sprintf("%0.1d%s%0.2d%s%0.2d",
                    $self->{local_c}{hour},   $sep,
                    $self->{local_c}{minute}, $sep,
                    $self->{local_c}{second} );
}
# don't want to override CORE::time()
*DateTime::Calendar::FrenchRevolutionary::time = \&hms;

sub iso8601 {
  my $self = shift;
  return join 'T', $self->ymd, $self->hms(':');
}
*datetime = \&iso8601;

sub is_leap_year { $_[0]->_is_leap_year($_[0]->year) }

sub decade_number {
  my $self = shift;
  return 3 * $self->month + int(($self->day - 1) / 10) - 2;
}
*week_number = \&decade_number;

sub decade {
  my $self = shift;
  return ($self->year, $self->decade_number);
}
*week = \&decade;

#sub time_zone { $_[0]->{tz} }

sub offset { $_[0]->{tz}->offset_for_datetime($_[0]) }
sub _offset_from_local_time { $_[0]->{tz}->offset_for_local_datetime($_[0]) }

#sub is_dst { $_[0]->{tz}->is_dst_for_datetime($_[0]) }

#sub time_zone_short_name { $_[0]->{tz}->short_name_for_datetime($_[0]) }

sub locale { $_[0]->{locale} }

sub utc_rd_values { @{ $_[0] }{ 'utc_rd_days', 'utc_rd_secs', 'rd_nano' } }

# Anglo-Babylonian time
sub   utc_rd_as_abt_seconds    { ($_[0]->{utc_rd_days}   * 86400) + $_[0]->{utc_rd_secs} }
sub local_rd_as_abt_seconds    { ($_[0]->{local_rd_days} * 86400) + $_[0]->{local_rd_secs} }
sub    _time_as_abt_seconds    { $_[1] * 3600 + $_[2] * 60 + $_[3] }
sub _abt_seconds_as_components { int($_[1] / 3600), int($_[1] % 3600 / 60), $_[1] % 60 }

# Decimal time
sub _time_as_seconds { .864 * ($_[1] * 10000 + $_[2] * 100 + $_[3]) }
sub _seconds_as_components { 
  my $sec = $_[1] / .864; 
  int($sec / 10000), int($sec % 10000 / 100), $sec % 100 
}

# RD 1 is JD 1,721,424.5 - a simple offset
sub jd {
  my $self = shift;
  my $jd = $self->{utc_rd_days} + 1_721_424.5;
  return $jd + ($self->{utc_rd_secs} / 86400);
}

sub mjd { $_[0]->jd - 2_400_000.5 }

my %formats = (
        'a' => sub { $_[0]->day_abbr }
      , 'A' => sub { $_[0]->day_name }
      , 'b' => sub { $_[0]->month_abbr }
      , 'B' => sub { $_[0]->month_name }
      , 'c' => sub { $_[0]->strftime( $_[0]->{locale}->default_datetime_format ) }
      , 'C' => sub { int($_[0]->year / 100) }
      , 'd' => sub { sprintf '%02d', $_[0]->day_of_month }
      , 'D' => sub { $_[0]->strftime('%m/%d/%y') }
      , 'e' => sub { sprintf('%2d', $_[0]->day_of_month) }
      , 'f' => sub { sprintf('%2d', $_[0]->month) }
      , 'F' => sub { $_[0]->ymd('-') }
      , 'g' => sub { substr($_[0]->year, -2) }
      , 'G' => sub { sprintf '%04d', $_[0]->year }
      , 'h' => sub { $_[0]->month_abbr }
      , 'H' => sub { sprintf('%d', $_[0]->hour) }
      , 'I' => sub { my $h = $_[0]->hour || 10; sprintf('%d', $h) }
      , 'j' => sub { sprintf '%03d', $_[0]->day_of_year }
      , 'k' => sub { sprintf('%2d', $_[0]->hour) }
      , 'l' => sub { my $h = $_[0]->hour || 10; sprintf('%2d', $h) }
      , 'L' => sub { sprintf '%04d', $_[0]->year }
      , 'm' => sub { sprintf '%02d', $_[0]->month }
      , 'M' => sub { sprintf '%02d', $_[0]->minute }
      , 'n' => sub { "\n" } # should this be OS-sensitive?
      , 'p' => sub {    $_[0]->{locale}->am_pm($_[0]) }
      , 'P' => sub { lc $_[0]->{locale}->am_pm($_[0]) }
#      , 'p' => sub { $_[0]->hour < 5 ? 'AM' : 'PM' }
#      , 'P' => sub { $_[0]->hour < 5 ? 'am' : 'pm' }
      , 'r' => sub { $_[0]->strftime('%I:%M:%S %p') }
      , 'R' => sub { $_[0]->strftime('%H:%M') }
      , 's' => sub { $_[0]->epoch }
      , 'S' => sub { sprintf('%02d', $_[0]->second) }
      , 't' => sub { "\t" }
      , 'T' => sub { $_[0]->strftime('%H:%M:%S') }
      , 'u' => sub { sprintf '%2d', $_[0]->day_of_decade },
      , 'U' => sub { $_[0]->decade_number }
      , 'V' => sub { $_[0]->decade_number }
      , 'w' => sub { $_[0]->day_of_decade % 10 }
      , 'W' => sub { $_[0]->decade_number }
      , 'y' => sub { sprintf('%02d', substr( $_[0]->year, -2 )) }
      , 'Y' => sub { sprintf '%04d', $_[0]->year }
      , 'z' => sub { DateTime::TimeZone::offset_as_string( $_[0]->offset ) }
      , 'Z' => sub { $_[0]->{tz}->short_name_for_datetime($_[0]) }
      , '+' => sub { '+' }
      , '%' => sub { '%' }
      , 'EY' => sub { Roman $_[0]->year }
      , 'Ey' => sub { roman $_[0]->year }
      , '*'  => sub { $_[0]->feast_long }
      , 'Ej' => sub { $_[0]->feast_long }
      , 'EJ' => sub { $_[0]->feast_caps }
      , 'Oj' => sub { $_[0]->feast_short }

    );

$formats{h} = $formats{b};

sub strftime {
  my $self = shift;
  # make a copy or caller's scalars get munged
  my @formats = @_;

  my @r;
  foreach my $f (@formats)
    {
      # regex from DateTime from Date::Format - thanks Graham and Dave!
      # but there is a twist: 3-char format specifiers such as '%Ey' are
      # allowed. All 3-char specifiers begin with a '%E' or '%O' prefix.
      # At the same time, if the user wants %Em or %Om, which do not exist, it defaults to %m
      # And if the user asks for %E!,
      # it defaults to E! because neither %E! nor %! exist.
      $f =~ s/
	        	        %([EO]?([*%a-zA-Z]))
                            | %{(\w+)}
                          /
                            $3 ? ($self->can($3) ? $self->$3() : "\%{$3}")
                                  : ($formats{$1} ? $formats{$1}->($self)
                                                          : $formats{$2} ? $formats{$2}->($self) : $1)
                          /sgex;
      return $f unless wantarray;
      push @r, $f;
    }
  return @r;
}

sub epoch {
  my $self = shift;
  my $greg = DateTime->from_object(object => $self);
  return $greg->epoch;
}

sub DefaultLocale {
  'fr'
}

#my %events = ();
sub on_date {
  my ($dt, $lan) = @_;
  my $locale;

  if (defined $lan)
    { $locale = DateTime::Calendar::FrenchRevolutionary::Locale->load( $lan )}
  else
    { $locale = $dt->{locale} }
  return $locale->on_date($dt);

}

# A module must return a true value. Traditionally, a module returns 1.
# But this module is a revolutionary one, so it discards all old traditions.
"Liberté, égalité, fraternité
ou la mort !";

__END__