view release on metacpan or  search on metacpan

lib/DateTime/Lite/Infinite.pm  view on Meta::CPAN

# representation of positive or negative infinity. The mutating methods
# set(), set_time_zone(), and truncate() are no-ops that return $self.
#
# NOTE: This file intentionally defines multiple packages.
##----------------------------------------------------------------------------
package DateTime::Lite::Infinite;
BEGIN
{
    use v5.10.1;
    use strict;
    use warnings;
    if( $] < 5.013 )
    {
        no strict 'refs';
        unless( defined( &warnings::register_categories ) )
        {
            *warnings::_mkMask = sub
            {
                my $bit  = shift( @_ );
                my $mask = "";
                vec( $mask, $bit, 1 ) = 1;
                return( $mask );
            };

            *warnings::register_categories = sub
            {
                my @names = @_;
                foreach my $name ( @names )
                {
                    if( !defined( $warnings::Bits{ $name } ) )
                    {
                        $warnings::Offsets{ $name }  = $warnings::LAST_BIT;
                        $warnings::Bits{ $name }     = warnings::_mkMask( $warnings::LAST_BIT++ );
                        $warnings::DeadBits{ $name } = warnings::_mkMask( $warnings::LAST_BIT++ );
                        if( length( $warnings::Bits{ $name } ) > length( $warnings::Bits{all} ) )
                        {
                            $warnings::Bits{all}     .= "\x55";
                            $warnings::DeadBits{all} .= "\xaa";
                        }
                    }
                }
            };
        }
    }
    warnings::register_categories( 'DateTime::Lite' );
    use parent qw( DateTime::Lite );
    use vars qw( $VERSION );
    our $VERSION = 'v0.1.0';
};

# Mutating methods are no-ops on infinite objects
foreach my $m ( qw( set set_time_zone truncate ) )
{
    no strict 'refs';
    *{ 'DateTime::Lite::Infinite::' . $m } = sub{ return( $_[0] ) };
}

sub is_finite   { 0 }
sub is_infinite { 1 }

# Override the XS/PP calendar decomposition to just propagate the
# infinity value through without any arithmetic
sub _rd2ymd
{
    return( $_[2] ? ( $_[1] ) x 7 : ( $_[1] ) x 3 );
}

sub _seconds_as_components
{
    return( ( $_[1] ) x 3 );
}

# NOTE: Formatting - all return the infinity string
sub datetime    { return( $_[0]->_infinity_string ) }
sub dmy         { return( $_[0]->iso8601 ) }
sub hms         { return( $_[0]->iso8601 ) }
sub hour_12     { return( $_[0]->_infinity_string ) }
sub hour_12_0   { return( $_[0]->_infinity_string ) }
sub mdy         { return( $_[0]->iso8601 ) }
sub stringify   { return( $_[0]->_infinity_string ) }
sub ymd         { return( $_[0]->iso8601 ) }

sub _infinity_string
{
    return( $_[0]->{utc_rd_days} == DateTime::Lite::INFINITY()
        ? DateTime::Lite::INFINITY() . q{}
        : DateTime::Lite::NEG_INFINITY() . q{} );
}

sub _week_values { return( [ $_[0]->{utc_rd_days}, $_[0]->{utc_rd_days} ] ) }

# Infinite objects are not serialisable in a meaningful way
sub STORABLE_freeze { return }
sub STORABLE_thaw   { return }

1;

# NOTE: DateTime::Lite::Infinite::Future class
package DateTime::Lite::Infinite::Future;
BEGIN
{
    use strict;
    use warnings;
    use parent qw( DateTime::Lite::Infinite );
};


{
    my $Pos;

    sub new
    {
        return( $Pos ) if( defined( $Pos ) );

        require DateTime::Lite::TimeZone;
        $Pos = bless(
        {
            utc_rd_days   => DateTime::Lite::INFINITY(),
            utc_rd_secs   => DateTime::Lite::INFINITY(),
            local_rd_days => DateTime::Lite::INFINITY(),
            local_rd_secs => DateTime::Lite::INFINITY(),