view release on metacpan or  search on metacpan

lib/DB/Object/SQLite.pm  view on Meta::CPAN

    my $self  = shift( @_ );
    my $param = $self->SUPER::_check_connect_param( @_ );
    if( !$param->{database_file} && $param->{database} )
    {
        my( $filename, $path, $ext );
        my $uri = CORE::exists( $param->{uri} ) ? $param->{uri} : '';
        my $db = $param->{database} ? $param->{database} : ( $uri->path_segments )[-1];
        $path = $uri ? $uri->path : $db;
        # $db = Cwd::abs_path( $uri ? $uri->path : $db );
        # $db = File::Spec->rel2abs( $path );
        $db = $self->new_file( $path );
        # If we cannot find the file and it does not end with .sqlite, let's add the extension
        # So the user can provide the database parameter just like database => 'test' or database => './test'
        $db = "$db.sqlite" if( !-e( $db ) && $db !~ /\.sqlite$/i );
        # ( $filename, $path, $ext ) = File::Basename::fileparse( $db, qr/\.[^\.]+$/ );
        ( $filename, $path, $ext ) = $db->baseinfo( qr/\.[^\.]+$/ );
        $param->{database} = $filename;
        $param->{database_file} = $self->{database_file} = $db;
    }
    $param->{host} = 'localhost' if( !length( $param->{host} ) );
    $param->{port} = 0 if( !CORE::exists( $param->{port} ) );
    return( $param );
}

sub _check_default_option
{
    my $self = shift( @_ );
    my $opts = $self->_get_args_as_hash( @_ );
    return( $self->error( "Provided option is not a hash reference." ) ) if( !$self->_is_hash( $opts => 'strict' ) );
    $opts->{sqlite_unicode} = 1 if( !CORE::exists( $opts->{sqlite_unicode} ) );
    return( $opts );
}

sub _connection_options
{
    my $self  = shift( @_ );
    my $param = shift( @_ );
    my @sqlite_params = grep( /^sqlite_/, keys( %$param ) );
    my $opt = $self->SUPER::_connection_options( $param );
    @$opt{ @sqlite_params } = @$param{ @sqlite_params };
    return( $opt );
}

sub _connection_params2hash_driver
{
    my $self = shift( @_ );
    my $opts = $self->_get_args_as_hash( @_ );
    $opts->{sqlite_unicode} = 1 if( !length( $opts->{sqlite_unicode} ) );
    return( $opts );
}

sub _connection_parameters
{
    my $self  = shift( @_ );
    my $param = shift( @_ );
    # Even though login, password, server, host are not used, I was hesitating, but decided to leave them as ok, and ignore them
    # Or maybe should I issue an error when they are provided?
    my $core = [qw( db login passwd host port driver database server opt uri debug cache_connections cache_dir cache_query cache_table unknown_field use_cache )];
    my @sqlite_params = grep( /^sqlite_/, keys( %$param ) );
    # See DBD::SQLite for the list of valid parameters
    # E.g.: sqlite_open_flags sqlite_busy_timeout sqlite_use_immediate_transaction sqlite_see_if_its_a_number sqlite_allow_multiple_statements sqlite_unprepared_statements sqlite_unicode sqlite_allow_multiple_statements sqlite_use_immediate_transacti...
    push( @$core, @sqlite_params );
    return( $core );
}

sub _dbi_connect
{
    my $self = shift( @_ );
    my $dbh  = $self->{dbh} = $self->SUPER::_dbi_connect( @_ );
    # my $func = $self->{_func};
    my $func = $self->{_func};
    foreach my $k ( sort( keys( %$PRIVATE_FUNCTIONS ) ) )
    {
        my $this = $PRIVATE_FUNCTIONS->{ $k };
        my $ref =
        {
        name => $k,
        argc => $this->[0],
        code => $this->[1],
        };
        $func->{ $k } = $ref;
    }
    foreach my $name ( sort( keys( %$func ) ) )
    {
        my $ref = $func->{ $name };
        if( $ref->{_registered_on} )
        {
            next;
        }
        $self->sql_function_register( $ref );
        $ref->{_registered_on} = time();
    }
    return( $dbh );
}

sub _dsn
{
    my $self = shift( @_ );
    my $db = $self->{database_file} || return( $self->error( "No database file was specified." ) );
    # return( $self->error( "Database file \"$db\" does not exist." ) ) if( !-e( $db ) );
    return( $self->error( "Database file \"$db\" is not writable." ) ) if( -e( $db ) && !-w( $db ) );
    my @params = ( sprintf( 'dbi:%s:', $self->{driver} ) );
    push( @params, sprintf( 'dbname=%s', $db ) );
    return( join( ';', @params ) );
}

sub _parse_timestamp
{
    my $self = shift( @_ );
    my $str  = shift( @_ );
    # No value was actually provided
    return if( !length( $str ) );
    # try-catch
    local $@;
    my $tz = eval
    {
        return( DateTime::TimeZone->new( name => 'local' ) );
    };
    if( $@ )
    {
        $tz = DateTime::TimeZone->new( name => 'UTC' );