view release on metacpan or  search on metacpan

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

# NOTE: month_length is autoloaded

sub month_name
{
    my $self = shift( @_ );
    return( $self->{locale}->month_format_wide->[ $self->month_0 ] );
}

sub nanosecond { return( $_[0]->{rd_nanosecs} ) }

sub now
{
    my $class = shift( @_ );
    return( $class->from_epoch( epoch => $class->_core_time, @_ ) );
}

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

sub pass_error
{
    my $self = shift( @_ );
    my $pack = ref( $self ) || $self;
    my $opts = {};
    my( $err, $class, $code );
    no strict 'refs';
    if( scalar( @_ ) )
    {
        # Either an hash defining a new error and this will be passed along to error(); or
        # an hash with a single property: { class => 'Some::ExceptionClass' }
        if( scalar( @_ ) == 1 && ref( $_[0] ) eq 'HASH' )
        {
            $opts = $_[0];
        }
        else
        {
            if( scalar( @_ ) > 1 && ref( $_[-1] ) eq 'HASH' )
            {
                $opts = pop( @_ );
            }
            $err = $_[0];
        }
    }
    $err = $opts->{error} if( !defined( $err ) && CORE::exists( $opts->{error} ) && defined( $opts->{error} ) && CORE::length( $opts->{error} ) );
    # We set $class only if the hash provided is a one-element hash and not an error-defining hash
    $class = $opts->{class} if( CORE::exists( $opts->{class} ) && defined( $opts->{class} ) && CORE::length( $opts->{class} ) );
    $code  = $opts->{code} if( CORE::exists( $opts->{code} ) && defined( $opts->{code} ) && CORE::length( $opts->{code} ) );

    # called with no argument, most likely from the same class to pass on an error 
    # set up earlier by another method; or
    # with an hash containing just one argument class => 'Some::ExceptionClass'
    if( !defined( $err ) && ( !scalar( @_ ) || defined( $class ) ) )
    {
        # $error is a previous erro robject
        my $error = ref( $self ) ? $self->{error} : length( ${ $pack . '::ERROR' } ) ? ${ $pack . '::ERROR' } : undef;
        if( !defined( $error ) )
        {
            warn( "No error object provided and no previous error set either! It seems the previous method call returned a simple undef" );
        }
        else
        {
            $err = ( defined( $class ) ? bless( $error => $class ) : $error );
            $err->code( $code ) if( defined( $code ) );
        }
    }
    elsif( defined( $err ) && 
           Scalar::Util::blessed( $err ) && 
           ( scalar( @_ ) == 1 || 
             ( scalar( @_ ) == 2 && defined( $class ) ) 
           ) )
    {
        $self->{error} = ${ $pack . '::ERROR' } = ( defined( $class ) ? bless( $err => $class ) : $err );
        $self->{error}->code( $code ) if( defined( $code ) && $self->{error}->can( 'code' ) );

        if( $self->{fatal} || ( defined( ${"${pack}\::FATAL_EXCEPTIONS"} ) && ${"${pack}\::FATAL_EXCEPTIONS"} ) )
        {
            die( $self->{error} );
        }
    }
    # If the error provided is not an object, we call error to create one
    else
    {
        return( $self->error( @_ ) );
    }

    if( want( 'OBJECT' ) )
    {
        rreturn( DateTime::Lite::NullObject->new );
    }
    return;
}

sub quarter { $_[0]->{local_c}->{quarter} }

# NOTE: quarter_0 is autoloaded

# NOTE: quarter_abbr is autoloaded

# NOTE: quarter_length is autoloaded

# NOTE: quarter_name is autoloaded

sub rfc3339
{
    my $self = shift( @_ );
    my $str  = $self->datetime( 'T' );
    if( $self->{tz}->is_utc )
    {
        $str .= 'Z';
    }
    else
    {
        $str .= DateTime::Lite::TimeZone->offset_as_string( $self->offset, ':' );
    }
    return( $str );
}

# NOTE: secular_era is autoloaded

sub second { return( shift->{local_c}->{second} ) }

# NOTE: Setters
sub set
{
    my $self = shift( @_ );
    my %p    = @_;

    if( $p{locale} )
    {
        warn( 'You passed a locale to the set() method. Use set_locale() instead.' )
            if( warnings::enabled() );
    }

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

    if( @_ )
    {
        ( $locale, $tz, $formatter ) = @_;
    }
    else
    {
        $tz     = DateTime::Lite::TimeZone->new( name => delete( $s{tz} ) ) ||
            die( DateTime::Lite::TimeZone->error );
        $locale = DateTime::Locale::FromCLDR->new( delete( $s{locale} ) ) ||
            die( DateTime::Locale::FromCLDR->error );
    }

    delete( $s{version} );

    my $object = bless(
    {
        utc_vals => [
            $s{utc_rd_days},
            $s{utc_rd_secs},
            $s{rd_nanosecs},
        ],
        tz => $tz,
    }, 'DateTime::Lite::_Thawed' );

    my %fmt;
    if( defined( $formatter ) && ref( $formatter ) && defined( $$formatter ) )
    {
        %fmt = ( formatter => $$formatter );
    }
    my $new = ( ref( $self ) )->from_object(
        object => $object,
        locale => $locale,
        %fmt,
    ) || die( ref( $self )->error );

    %$self = %$new;
    return( $self );
}

# NOTE: CBOR will call the THAW method with the stored classname as first argument, the constant string CBOR as second argument, and all values returned by FREEZE as remaining arguments.
# NOTE: Storable calls it with a blessed object it created followed with $cloning and any other arguments initially provided by STORABLE_freeze
sub THAW
{
    my( $self, undef, @args ) = @_;
    my $ref = ( CORE::scalar( @args ) == 1 && CORE::ref( $args[0] ) eq 'ARRAY' ) ? CORE::shift( @args ) : \@args;
    my $class = ( CORE::defined( $ref ) && CORE::ref( $ref ) eq 'ARRAY' && CORE::scalar( @$ref ) > 1 ) ? CORE::shift( @$ref ) : ( CORE::ref( $self ) || $self );
    my $hash = CORE::ref( $ref ) eq 'ARRAY' ? CORE::shift( @$ref ) : {};
    my $new;
    # Storable pattern requires to modify the object it created rather than returning a new one
    if( CORE::ref( $self ) )
    {
        foreach( CORE::keys( %$hash ) )
        {
            $self->{ $_ } = CORE::delete( $hash->{ $_ } );
        }
        $new = $self;
    }
    else
    {
        $new = CORE::bless( $hash => $class );
    }
    CORE::return( $new );
}

sub TO_JSON { return( $_[0]->stringify ) }

# NOTE: Private methods (alphabetical)
sub _add_duration
{
    my $self = shift( @_ );
    my $dur  = shift( @_ );

    my %deltas = $dur->deltas;

    if( $deltas{days} )
    {
        $self->{local_rd_days} += $deltas{days};
        $self->{utc_year}      += int( $deltas{days} / 365 ) + 1;
    }

    if( $deltas{months} )
    {
        my( $y, $m, $d ) = (
              $dur->is_preserve_mode
            ? $self->_rd2ymd( $self->{local_rd_days} + 1 )
            : $self->_rd2ymd( $self->{local_rd_days} )
        );

        $d -= 1 if( $dur->is_preserve_mode );

        if( !$dur->is_wrap_mode && $d > 28 )
        {
            $self->{local_rd_days}
                = $self->_ymd2rd( $y, $m + $deltas{months} + 1, 0 );
            my $last_day = ( $self->_rd2ymd( $self->{local_rd_days} ) )[2];
            $self->{local_rd_days} -= $last_day - $d if( $last_day > $d );
        }
        else
        {
            $self->{local_rd_days}
                = $self->_ymd2rd( $y, $m + $deltas{months}, $d );
        }

        $self->{utc_year} += int( $deltas{months} / 12 ) + 1;
    }

    if( $deltas{days} || $deltas{months} )
    {
        $self->_calc_utc_rd;
        $self->_handle_offset_modifier( $self->second );
    }

    if( $deltas{minutes} )
    {
        $self->{utc_rd_secs} += $deltas{minutes} * 60;
        $self->_normalize_tai_seconds(
            $self->{utc_rd_days},
            $self->{utc_rd_secs},
        );
    }