view release on metacpan or  search on metacpan

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

The days of the week are named from the five Basic Elements: sweet,
boom, pungent, prickle and orange.

=cut

my @days = (
    { name => 'Sweetmorn',       abbrev => 'SM', },
    { name => 'Boomtime',        abbrev => 'BT', },
    { name => 'Pungenday',       abbrev => 'PD', },
    { name => 'Prickle-Prickle', abbrev => 'PP', },
    { name => 'Setting Orange',  abbrev => 'SO', },
);

my @excl = (
    'Hail Eris!',
    'All Hail Discordia!',
    'Kallisti!',
    'Fnord.',
    'Or not.',
    'Wibble.',
    'Pzat!',
    q{P'tang!},
    'Frink!',
    'Slack!',
    'Praise "Bob"!',
    'Or kill me.',
    'Grudnuk demand sustenance!',
    'Keep the Lasagna flying!',
    'Umlaut Zebra über alles!',
    'You are what you see.',
    'Or is it?',
    'This statement is false.',
    'Hail Eris, Hack Perl!',
);

=head1 METHODS

=head2 new

Constructs a new I<DateTime::Calendar::Discordian> object.  This class
method requires the parameters I<day>, I<season>, and I<year>.  If
I<day> is given as "St. Tib's Day" (or reasonable facsimile thereof,)
then I<season> is omitted. This function will C<die> if invalid
parameters are given.  For example:

my $dtcd = DateTime::Calendar::Discordian->new(
  day => 8, season => 'Discord', year => 3137, );

The I<second>, I<nanosecond>, and I<locale> parameters are also accepted for
compatability with L<DateTime|DateTime> but nothing is done with them.

=cut

sub new {
    my ( $class, @arguments ) = @_;

    my %args = validate(
        @arguments,
        {
            day => {
                callbacks => {
                    q{between 1 and 73 or St. Tib's Day} => sub {
                        my ( $day, $opts ) = @_;
                        if ( $day =~ $tibsday ) {
                            if ( !defined $opts->{season} ) {
                                return 1;
                            }
                        }
                        elsif ( $day > 0 && $day < 74 ) {
                            return 1;
                        }
                        return;
                    },
                },
            },
            season => {
                default   => undef,
                callbacks => {
                    'valid season name' => sub {
                        my ( $season, $opts ) = @_;
                        if ( defined $season ) {
                            return scalar grep { /((?-x)$season)/imsx }
                              keys %seasons;
                        }
                        return 1;
                    },
                },
            },
            year       => { type    => SCALAR, },
            second     => { default => 0, },
            nanosecond => { default => 0, },
            locale     => {
                type     => SCALAR | OBJECT | UNDEF,
                optional => 1,
            },

        }
    );

    if ( defined $args{season} ) {
        $args{season} = join q{ }, map { ucfirst lc $_ } split q{ },
          $args{season};
    }
    else {
        if ( $args{day} !~ $tibsday ) {
            confess 'missing season';
        }
    }
    if ( $args{day} =~ $tibsday ) {
        $args{day} = q{St. Tib's Day};
    }
    croak q{Not a leap year}
      if $args{day} eq q{St. Tib's Day}
          && !_is_leap_year( $args{year} - 1166 );
    my $self = bless \%args, $class;
    $self->{epoch} = -426_237;
    $self->{fnord} = 5;
    if ( defined $self->{locale} ) {
        if ( !ref $self->{locale} ) {
            $self->{locale} = DateTime::Locale->load( $args{locale} );
        }
    }
    $self->{rd} = $self->_discordian2rd;

    return bless $self, $class;
}

=head2 clone

Returns a copy of the object.

=cut

sub clone {
    my ($object) = @_;
    return bless { %{$object} }, ref $object;
}