view release on metacpan or  search on metacpan

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

            $sth->finish;
            return( $this->error( "Error executing the query to check if SQLite has math functions: ", $sth->errstr, "\nSQL query was ", $sth->{Statement} ) );
        }
        my $row = eval{ $sth->fetchrow_arrayref };
        if( $@ )
        {
            $sth->finish;
            return( $this->error( "Error retrieving the value to check if SQLite has math functions: $@", "\nSQL query was ", $sth->{Statement} ) );
        }
        # We check for definedness, which means an error in DBI
        elsif( !defined( $row ) && $sth->errstr )
        {
            $sth->finish;
            return( $this->error( "Error retrieving the value to check if SQLite has math functions: ", $sth->errstr, "\nSQL query was ", $sth->{Statement} ) );
        }
        $sth->finish;
        # Don't assume anything.
        if( $row && ref( $row ) eq 'ARRAY' && $row->[0] )
        {
            $has_math = 1;
        }
    }

    if( $has_math )
    {
        # <https://sqlite.org/lang_mathfunc.html>
        $SQLITE_HAS_MATH_FUNCTIONS = 1;
    }
    else
    {
        # Native math functions are absent or unconfirmed; register Perl UDFs.
        require POSIX;
        $dbh->sqlite_create_function( 'sqrt', 1, sub{ CORE::sqrt( $_[0] ) } );
        $dbh->sqlite_create_function( 'sin',  1, sub{ CORE::sin(  $_[0] ) } );
        $dbh->sqlite_create_function( 'cos',  1, sub{ CORE::cos(  $_[0] ) } );
        $dbh->sqlite_create_function( 'asin', 1, sub{ POSIX::asin( $_[0] ) } );
        $SQLITE_HAS_MATH_FUNCTIONS = 0;
    }
    return(1);
}

# _decode_sql_array() decode the JSON array and returns an array reference. 
sub _decode_sql_array
{
    my $self = shift( @_ );
    die( "\$cldr->_decode_sql_array( \$data )" ) if( @_ != 1 );
    my $data = shift( @_ );
    # No data was provided
    if( !defined( $data ) )
    {
        return;
    }
    # Should not be a reference, but a plain string
    elsif( ref( $data ) )
    {
        die( "\$cldr->_decode_sql_array( \$data )" );
    }

    my $j = $JSON_CLASS->new->relaxed;
    local $@;
    my $decoded = eval
    {
        $j->decode( $data );
    };
    if( $@ )
    {
        warn( "Warning only: error attempting to decode $JSON_CLASS array: $@" );
        $decoded = [];
    }
    return( $decoded );
}

# _decode_sql_arrays() takes an hash reference, or an array of hash reference,
# and decode the array fields of those tuples
sub _decode_sql_arrays
{
    my $self = shift( @_ );
    die( "\$cldr->_decode_sql_arrays( \$array_ref_of_array_fields, \$data )" ) if( @_ != 2 );
    my( $where, $ref ) = @_;
    if( ref( $where ) ne 'ARRAY' )
    {
        die( "\$cldr->_decode_sql_arrays( \$array_ref_of_array_fields, \$data )" );
    }
    # No data was provided
    elsif( !defined( $ref ) )
    {
        return;
    }
    elsif( ref( $ref // '' ) ne 'HASH' && Scalar::Util::reftype( $ref // '' ) ne 'ARRAY' )
    {
        die( "\$cldr->_decode_sql_arrays( \$array_ref_of_array_fields, \$data )" );
    }

    my $j = $JSON_CLASS->new->relaxed;
    local $@;
    if( ref( $ref ) eq 'HASH' )
    {
        foreach my $field ( @$where )
        {
            if( exists( $ref->{ $field } ) &&
                defined( $ref->{ $field } ) &&
                length( $ref->{ $field } ) )
            {
                my $decoded = eval
                {
                    $j->decode( $ref->{ $field } );
                };
                if( $@ )
                {
                    warn( "Warning only: error attempting to decode $JSON_CLASS array in field \"${field}\" for value '", $ref->{ $field }, "': $@" );
                    $ref->{ $field } = [];
                }
                else
                {
                    $ref->{ $field } = $decoded;
                }
            }
        }
    }
    elsif( Scalar::Util::reftype( $ref ) eq 'ARRAY' )
    {
        for( my $i = 0; $i < scalar( @$ref ); $i++ )
        {
            if( ref( $ref->[$i] ) ne 'HASH' )
            {
                warn( "SQL data at offset ${i} is not an HASH reference." );
                next;
            }
            $self->_decode_sql_arrays( $where, $ref->[$i] );
        }
    }
    return( $ref );
}

# Retrieve a cached prepared statement by ID.
# Keyed by db file path so statements survive interpreter-level reuse.
sub _get_cached_statement
{
    my $self = shift( @_ );
    my $id   = shift( @_ );
    die( "No statement ID provided." ) unless( defined( $id ) && length( $id ) );
    my $file = $DB_FILE;
    my $tid  = ( $Config{useithreads} && $INC{'threads.pm'} && threads->can('tid') ) ? threads->tid() : $$;
    $STHS->{ $tid } //= {};
    $STHS->{ $tid }->{ $file } //= {};
    my $sth = $STHS->{ $tid }->{ $file }->{ $id };
    if( defined( $sth ) &&
        Scalar::Util::blessed( $sth ) &&
        $sth->isa( 'DBI::st' ) )
    {
        return( $sth );
    }
    return;
}

# DateTime::Lite::TimeZone->_get_zone_info( $name );
# $tz->_get_zone_info( $name );
sub _get_zone_info
{
    my $self = shift( @_ );
    my $name = shift( @_ );
    local $@;
    # Verify the zone exists and cache its metadata
    my $sth;
    unless( $sth = $self->_get_cached_statement( 'get_zone_info' ) )
    {
        my $dbh = $self->_dbh || return( $self->pass_error );
        # We handle each step of building the query, so we can report on any error with better accuracy.
        my $query = q{SELECT * FROM zones WHERE name = ?};
        $sth = eval
        {
            $dbh->prepare( $query );
        } || return( $self->error( "Error preparing the query to get the timezone information: ", ( $@ || $dbh->errstr ), "\nSQL query was $query" ) );
        $self->_set_cached_statement( get_zone_info => $sth );
    }