# -*- perl -*-
##----------------------------------------------------------------------------
## Database Object Interface - ~/lib/DB/Object/SQLite.pm
## Version v1.1.3
## Copyright(c) 2024 DEGUEST Pte. Ltd.
## Author: Jacques Deguest <jack@deguest.jp>
## Created 2017/07/19
## Modified 2024/09/04
## All rights reserved
##
##
## This program is free software; you can redistribute it and/or modify it
## under the same terms as Perl itself.
##----------------------------------------------------------------------------
# This is the subclassable module for driver specific ones.
package DB::Object::SQLite;
BEGIN
{
use strict;
use warnings;
use vars qw(
$VERSION $CACHE_QUERIES $CACHE_SIZE $CONNECT_VIA $DB_ERRSTR $ERROR $DEBUG
$USE_BIND $USE_CACHE $MOD_PERL @DBH
$PLACEHOLDER_REGEXP $DATATYPES_DICT $TABLE_CACHE
);
use DBI qw( :sql_types );
eval { require DBD::SQLite; };
die( $@ ) if( $@ );
use parent qw( DB::Object );
use POSIX ();
use DateTime;
use DateTime::TimeZone;
use DateTime::Format::Strptime;
use Module::Generic::File qw( sys_tmpdir );
our $TABLE_CACHE = {};
# <https://metacpan.org/pod/DBD::SQLite::Constants>
# <https://www.sqlite.org/datatype3.html>
# <https://metacpan.org/pod/DBD::SQLite::Constants#datatypes-(fundamental_datatypes)>
# NULL, INTEGER, REAL, TEXT, BLOB
# Check DBD::SQLite::Constants
our $DATATYPES_DICT =
{
blob => {
constant => '',
name => 'SQLITE_BLOB',
re => qr/^BLOB/,
type => 'blob'
},
bool => {
alias => [qw( boolean date datetime decimal numeric )],
constant => '',
name => 'SQLITE_NULL',
re => qr/^(NUMERIC|DECIMAL\(\d+,\d+\)|BOOLEAN|DATETIME|DATE)/,
type => 'bool'
},
float => {
alias => [qw( double real ), 'double precision', ],
constant => '',
name => 'SQLITE_FLOAT',
re => qr/^(REAL|DOUBLE|DOUBLE\s+PRECISION|FLOAT)/,
type => 'float'
},
integer => {
alias => [qw( int tinyint smallint mediumint bigint int2 int8 ), 'unsigned big int' ],
constant => '',
name => 'SQLITE_INTEGER',
re => qr/^(INT|INTEGER|TINYINT|SMALLINT|MEDIUMINT|BIGINT|UNSIGNED\s+BIG\s+INT|INT2|INT8)/,
type => 'integer',
},
# Data type text is only available from version 1.71 onward
};
if( $DBD::SQLite::VERSION >= 1.071 )
{
$DATATYPES_DICT->{text} =
{
alias => [qw( character clob nchar nvarchar varchar ), 'native character', 'varying character' ],
constant => '',
name => 'SQLITE_TEXT',
re => qr/^(CHARACTER\(\d+\)|VARCHAR\(\d+\)|VARYING\s+CHARACTER\(\d+\)|NCHAR\(\d+\)|NATIVE\s+CHARACTER\(\d+\)|NVARCHAR\(\d+\)|TEXT|CLOB)/,
type => 'text'
};
}
our $PLACEHOLDER_REGEXP = qr/\?(?<index>\d+)/;
our $VERSION = 'v1.1.3';
};
use strict;
use warnings;
# require DB::Object::SQLite::Statement;
# require DB::Object::SQLite::Tables;
our $DB_ERRSTR = '';
our $DEBUG = 0;
our $CACHE_QUERIES = [];
our $CACHE_SIZE = 10;
# The purpose of this cache is to store table object and avoid the penalty of reloading the structure of a table for every object generated.
# Thus CACHE_TABLE is in no way an exhaustive list of existing table, but existing table object.
our $CACHE_TABLE = {};
our $USE_BIND = 0;
our $USE_CACHE = 0;
our $MOD_PERL = 0;
our @DBH = ();
if( $INC{ 'Apache/DBI.pm' } &&
substr( $ENV{GATEWAY_INTERFACE}|| '', 0, 8 ) eq 'CGI-Perl' )
{
$CONNECT_VIA = "Apache::DBI::connect";
$MOD_PERL++;
}
# Actually the one in DB::Object is used, because DBD::SQLite has no datatype constants of its own
# our $DATATYPES = {};
our $PRIVATE_FUNCTIONS =
{
ceiling =>[1, \&_ceiling],
concat =>[-1, \&_concat],
curdate =>[0, \&_curdate],
curtime =>[0, \&_curtime],
dayname =>[1, \&_dayname],
dayofmonth =>[1, \&_dayofmonth],
dayofweek =>[1, \&_dayofweek],
dayofyear =>[1, \&_dayofyear],
distance_miles =>[4, \&_distance_miles],
# from_days =>[-1, \&_from_days],
from_unixtime =>[1, \&_from_unixtime],
hour =>[1, \&_hour],
lcase =>[1, \&_lcase],
left =>[2, \&_left],
locate =>[2, \&_locate],
log10 =>[1, \&_log10],
minute =>[1, \&_minute],
month =>[1, \&_month],
monthname =>[1, \&_monthname],
number_format =>[4, \&_number_format],
power =>[2, \&_power],
quarter =>[1, \&_quarter],
rand =>[0, \&_rand],
regexp =>[2, \&_regexp],
replace =>[3, \&_replace],
right =>[2, \&_right],
second =>[1, \&_second],
space =>[1, \&_space],
sprintf =>[-1, \&_sprintf],
to_days =>[1, \&_to_days],
# truncate =>[-1, \&_truncate],
ucase =>[1, \&_ucase],
unix_timestamp =>[1, \&_unix_timestamp],
week =>[1, \&_week],
weekday =>[1, \&_weekday],
year =>[1, \&_year],
};
# See compile_options method
# This is very useful to know which features can be used
our $COMPILE_OPTIONS = [];
foreach my $type ( keys( %$DATATYPES_DICT ) )
{
if( CORE::exists( $DATATYPES_DICT->{ $type }->{alias} ) &&
ref( $DATATYPES_DICT->{ $type }->{alias} ) eq 'ARRAY' &&
scalar( @{$DATATYPES_DICT->{ $type }->{alias}} ) )
{
foreach my $alias ( @{$DATATYPES_DICT->{ $type }->{alias}} )
{
next if( CORE::exists( $DATATYPES_DICT->{ $alias } ) );
$DATATYPES_DICT->{ $alias } = $DATATYPES_DICT->{ $type };
}
}
}
foreach my $type ( keys( %$DATATYPES_DICT ) )
{
my $c = $DATATYPES_DICT->{ $type }->{name};
my $code = \&{"DBD::SQLite::Constants::${c}"};
my $val = eval
{
$code->();
};
if( $@ )
{
warn( "Datatype \"DBD::SQLite::Constants::${c}\" is not defined in DBD::SQLite version $DBD::SQLite::VERSION: $@" );
delete( $DATATYPES_DICT->{ $type } );
}
else
{
$DATATYPES_DICT->{ $type }->{constant} = $val;
}
}
sub init
{
my $self = shift( @_ );
$self->SUPER::init( @_ );
$self->{driver} = 'SQLite';
$self->{_func} = {};
return( $self );
}
# Get/set alias
# sub alias
# sub as_string
# sub avoid
sub attribute($;$@)
{
my $self = shift( @_ );
# $h->{AttributeName} = ...; # set/write
# ... = $h->{AttributeName}; # get/read
# 1 means that the attribute may be modified
# 0 mneas that the attribute may only be read
my $name = shift( @_ ) if( @_ == 1 );
my %arg = ( @_ );
my %attr =
(
ActiveKids => 0,
AutoCommit => 1,
AutoInactiveDestroy => 1,
CachedKids => 0,
ChildHandles => 0,
ChopBlanks => 1,
CursorName => 0,
Driver => 0,
ErrCount => 1,
Executed => 0,
FetchHashKeyName => 1,
HandleError => 1,
HandleSetErr => 1,
InactiveDestroy => 1,
Kids => 0,
NAME => 0,
NULLABLE => 0,
NUM_OF_FIELDS => 0,
NUM_OF_PARAMS => 0,
# Current database name
Name => 0,
PRECISION => 0,
PrintError => 1,
PrintWarn => 1,
Profile => 1,
RaiseError => 1,
RowCacheSize => 0,
RowsInCache => 0,
SCALE => 0,
ShowErrorStatement => 1,
Statement => 0,
TYPE => 0,
Taint => 1,
TaintIn => 1,
TaintOut => 1,
TraceLevel => 1,
Type => 1,
Username => 0,
Warn => 1,
# Not used
# LongReadLen => 1,
# LongTruncOk => 1,
# CompatMode => 1,
# If you set this to true, "do" method will process multiple statements at one go.
# This may be handy, but with performance penalty. See above for details.
sqlite_allow_multiple_statements => 1,
# If you set this to true, DBD::SQLite tries to see if the bind values are number or
# not, and does not quote if they are numbers.
sqlite_see_if_its_a_number => 1,
sqlite_unicode => 1,
# Returns an unprepared part of the statement you pass to "prepare". Typically this
# contains nothing but white spaces after a semicolon.
sqlite_unprepared_statements => 0,
# If you set this to true, DBD::SQLite tries to issue a "begin immediate transaction"
# (instead of "begin transaction") when necessary.
sqlite_use_immediate_transaction => 1,
sqlite_version => 0,
);
# Only those attribute exist
# Using an a non existing attribute produce an exception, so we better avoid
if( $name )
{
return( $self->{dbh}->{ $name } ) if( exists( $attr{ $name } ) );
}
else
{
my $value;
while( ( $name, $value ) = each( %arg ) )
{
# We intend to modifiy the value of an attribute
# we are allowed to modify this value if it is true
if( exists( $attr{ $name } ) &&
defined( $value ) &&
$attr{ $name } )
{
$self->{dbh}->{ $name } = $value;
}
}
}
}
# sub available_drivers(@)
sub begin_work($;$@)
{
my $self = shift( @_ );
$self->{transaction} = 1;
return( $self->{dbh}->begin_work( @_ ) );
}
# This method is common to DB::Object and DB::Object::Statement
# sub bind
# sub cache
sub can_update_delete_limit { return( shift->has_compile_option( 'ENABLE_UPDATE_DELETE_LIMIT' ) ); }
# sub check_driver(@;$@)
sub commit($;$@)
{
my $self = shift( @_ );
$self->{transaction} = 0;
return( $self->{dbh}->commit( @_ ) );
}
sub compile_options
{
my $self = shift( @_ );
return( [ @$COMPILE_OPTIONS ] ) if( scalar( @$COMPILE_OPTIONS ) );
my $system_tmpdir = sys_tmpdir();
my $compile_options_cache_file = $system_tmpdir->join( 'sql_sqlite_compile_options.cfg' );
my @options = ();
# if( -e( $compile_options_cache_file ) && !-z( $compile_options_cache_file ) )
if( $compile_options_cache_file->exists && !$compile_options_cache_file->is_empty )
{
# my $fh = IO::File->new( "<$compile_options_cache_file" ) || return( $self->error( "Unable to read the sqlite compile options cache file \"$compile_options_cache_file\": $!" ) );
my $fh = $compile_options_cache_file->open( '<' ) || return( $self->error( "Unable to read the sqlite compile options cache file \"$compile_options_cache_file\": ", $compile_options_cache_file->error ) );
my @all = $fh->getlines;
# Remove any comments
@options = grep( !/^#/, @all );
$fh->close;
if( scalar( @options ) )
{
$COMPILE_OPTIONS = \@options;
# Return a copy only to be safe
return( [ @options ] );
}
}
# If the cache file does not yet exists or there is no options, we do the query
my $dbh = $self->{dbh} || return( $self->error( "No active database handler available. You can only call this method once a database connection has been made." ) );
my $all = $self->do( "PRAGMA compile_options" )->fetchall_arrayref;
@options = map( $_->[0], @$all );
# my $fh = IO::File->new( ">$compile_options_cache_file" ) || return( $self->error( "Unable to write to sqlite compile options cache file \"$compile_options_cache_file\": $!" ) );
my $fh = $compile_options_cache_file->open( '>' ) || return( $self->error( "Unable to write to sqlite compile options cache file \"$compile_options_cache_file\": ", $compile_options_cache_file->error ) );
$fh->autoflush(1);
$fh->print( join( "\n", @options ), "\n" ) || return( $self->error( "Unable to write to the sqlite compile options cache file \"$compile_options_cache_file\": $!" ) );
$fh->close;
$COMPILE_OPTIONS = \@options;
return( \@options );
}
# Inherited by DB::Object, however, DB::Object::connect() will call our subroutine
# _dbi_connect which format in a particular way the dsn.
sub connect
{
my $that = shift( @_ );
my $param = $that->_connection_params2hash( @_ ) || return;
$param->{driver} = 'SQLite';
$param->{sqlite_unicode} = 1;
return( $that->SUPER::connect( $param ) );
}
# NOTE: sub constant_to_datatype is inherited
# sub copy
# sub create_table($;%)
# See DB::Object
# sub data_sources($;\%)
# sub data_type
# sub database
sub database_file
{
return( shift->{database_file} );
}
sub databases
{
my $self = shift( @_ );
# return( $self->error( "Not connected to PostgreSQL server yet. Issue $dbh->connect first." ) ) if( !$self->{dbh} );
my $dbh;
# If there is no connection yet, then create one using the postgres login.
# There should not be a live user and database just to check what databases there are.
if( !$self->{dbh} )
{
# try-catch
local $@;
$dbh = eval
{
$self->connect( @_ );
};
if( $@ )
{
return( $self->error( "Error trying to connect to the SQLite database file: $@" ) );
}
$dbh or return( $self->pass_error );
}
else
{
$dbh = $self;
}
my $temp = $dbh->do( 'PRAGMA database_list' )->fetchall_arrayref( {} );
my @dbases = map( $_->{name}, @$temp );
return( @dbases );
}
# NOTE: sub datatype_dict is inherited
# NOTE: sub datatype_to_constant is inherited
# NOTE: sub datatypes is in inherited
sub func
{
my $self = shift( @_ );
my $table = shift( @_ );
# e.g. table_attributes to get the detail information on table columns
my $func_name = shift( @_ );
# Returns:
# NAME attribute name
# TYPE attribute type
# SIZE attribute size (-1 for variable size)
# NULLABLE flag nullable
# DEFAULT default value
# CONSTRAINT constraint
# PRIMARY_KEY flag is_primary_key
# REMARKS attribute description
return( $self->{dbh}->func( $table, $func_name ) );
}
# <https://metacpan.org/pod/DBD::SQLite::Constants#datatypes-(fundamental_datatypes)>
# <https://www.sqlite.org/datatype3.html>
# In SQLite, there are only 4 types:
# SQLITE_INTEGER
# SQLITE_FLOAT
# SQLITE_BLOB
# SQLITE_NULL
sub get_sql_type
{
my $self = shift( @_ );
my $type = shift( @_ ) || return( $self->error( "No sql type was provided to get its constant." ) );
$type = lc( $type );
if( CORE::exists( $DATATYPES_DICT->{ $type } ) &&
$type ne $DATATYPES_DICT->{ $type }->{type} )
{
$type = $DATATYPES_DICT->{ $type }->{type};
}
my $const;
if( substr( $type, 0, 7 ) eq 'sqlite_' )
{
$const = $self->{dbh}->can( "DBD::SQLite::\U${type}\E" );
}
else
{
$const = $self->{dbh}->can( "DBD::SQLite::SQLITE_\U${type}\E" );
}
return( '' ) if( !defined( $const ) );
return( $const->() );
}
sub having
{
my $self = shift( @_ );
my $q = $self->_reset_query;
return( $q->having( @_ ) );
}
# https://www.sqlite.org/compile.html
sub has_compile_option
{
my $self = shift( @_ );
my $opt = shift( @_ ) || return( $self->error( "No compile option was provided to check" ) );
$opt = uc( $opt );
my $all = $self->compile_options;
my @found = grep( /^$opt/, @$all );
return( $found[0] ) if( scalar( @found ) );
return( '' );
}
sub last_insert_id
{
my $self = shift( @_ );
my $table = shift( @_ ) || $self->{table};
return( $self->{dbh}->last_insert_id( undef, undef, $table, undef ) );
}
sub lock { return( shift->error( "Table lock is unsupported in SQLite." ) ); }
sub pragma
{
my $self = shfit( @_ );
my $key2val =
{
foreign_keys => [ qw( ON OFF ) ],
journal_mode => [ qw( DELETE TRUNCATE ) ],
legacy_file_format => [ qw( ON OFF ) ],
reverse_unordered_selects => [ qw( ON OFF ) ],
synchronous => [ qw( ON OFF ) ],
# To avoid corruption after BEGIN starts, DBD uses BEGIN IMMEDIATE. Default is TRUE
sqlite_use_immediate_transaction => [ qw( 1 0 ) ],
cache_size => qr/^\d+$/
};
}
sub query_object { return( shift->_set_get_object( 'query_object', 'DB::Object::SQLite::Query', @_ ) ); }
# https://www.sqlite.org/lang_replace.html
# https://www.sqlite.org/lang_conflict.html
# REPLACE is an alias for INSERT OR REPLACE
# https://www.sqlite.org/lang_insert.html
sub replace
{
my $self = shift( @_ );
my $data = shift( @_ ) if( @_ == 1 && ref( $_[ 0 ] ) );
my @arg = @_;
my %arg = ();
my $select = '';
if( !%arg && $data && $self->_is_hash( $data => 'strict' ) )
{
%arg = %$data;
}
elsif( $data && ref( $data ) eq 'DB::Object::Statement' )
{
$select = $data->as_string();
}
%arg = @arg if( @arg );
my $table = $self->{table} ||
return( $self->error( "No table was provided to replace data." ) );
my $structure = $self->structure || return( $self->pass_error );
my $null = $self->null();
my @avoid = ();
foreach my $field ( keys( %$structure ) )
{
# It is useless to insert a blank data in a field whose default value is NULL.
# Especially since a test on a NULL field may be made specifically.
push( @avoid, $field ) if( !CORE::exists( $arg{ $field } ) && $null->{ $field } );
}
my $db_data = $self->getdefault({
table => $table,
arg => \@arg,
avoid => \@avoid
});
my( $fields, $values ) = $db_data->format_statement();
$self->_reset_query();
delete( $self->{query_reset} );
$self->{binded_values} = $db_data->{binded_values};
my $query = $self->{query} = $select ? "REPLACE INTO $table $select" : "REPLACE INTO $table ($fields) VALUES($values)";
# Everything meaningfull lies within the object
# If no bind should be done _save_bind does nothing
$self->_save_bind();
# Query string should lie within the object
# _cache_this sends back an object no matter what or unde() if an error occurs
my $sth = $self->_cache_this();
# STOP! No need to go further
if( !defined( $sth ) )
{
return( $self->error( "Error while preparing query to replace data into table '$table':\n$query", $self->errstr() ) );
}
if( !defined( wantarray() ) )
{
$sth->execute() ||
return( $self->error( "Error while executing query to replace data to table '$table':\n$query" ) );
}
return( $sth );
}
sub register_function
{
my $self = shift( @_ );
return( $self->error( "I was expecting an hash reference of parameters as only argument." ) ) if( !$self->_is_hash( $_[0] => 'strict' ) );
my $opts = shift( @_ );
return( $self->error( "Parameter 'code' to register the private function must be a code reference." ) ) if( ref( $opts->{code} ) ne 'CODE' );
$opts->{flags} = [] if( !CORE::exists( $opts->{flags} ) );
return( $self->error( "Parameter 'flags' must be an array reference." ) ) if( !$self->_is_array( $opts->{flags} ) );
$opts->{argc} = -1 if( !CORE::exists( $opts->{argc} ) );
return( $self->error( "No name was provided for this private function." ) ) if( !CORE::exists( $opts->{name} ) );
my $name = $opts->{name};
return( $self->error( "Name provided for this private function \"$name\" contains illegal characters. Only alphabetical and numerical characters and underscore allowed with name starting with a letter." ) ) if( $name !~ /^[a-zA-Z][a-zA-Z0-9\_]+$/ );
my $funcs = $self->{func};
$funcs->{ lc( $opts->{name} ) } = $opts;
$self->sql_function_register( $opts ) if( $self->{dbh} );
return( $opts );
}
sub remove_function
{
my $self = shift( @_ );
my $name = shift( @_ ) || return( $self->error( "No private function was provided to be removed." ) );
my $funcs = $self->{func};
$name = lc( $name );
return( 0 ) if( !CORE::exists( $funcs->{ $name } ) );
return( CORE::delete( $funcs->{ $name } ) );
}
sub returning
{
my $self = shift( @_ );
my $q = $self->_reset_query;
return( $q->returning( @_ ) );
}
sub rollback
{
return( shift->{dbh}->rollback() );
}
sub sql_function_register
{
my $self = shift( @_ );
my $opts = shift( @_ ) || return( $self->error( "No private function hash reference provided." ) );
my $dbh = $self->{dbh} || return( $self->error( "No active database handler available." ) );
$opts->{flags} = [] if( !exists( $opts->{flags} ) || ref( $opts->{flags} ) ne 'ARRAY' );
my $flag;
my $eval = join( '|', @{$opts->{flags}} );
$flag = eval( $eval );
my $code = $opts->{code};
if( defined( $flag ) )
{
$dbh->sqlite_create_function( $opts->{name}, $opts->{argc}, sub{ my @arg = @_; unshift( @arg, $self ); $code->( @arg ); }, $flag );
}
else
{
$dbh->sqlite_create_function( $opts->{name}, $opts->{argc}, sub{ my @arg = @_; unshift( @arg, $self ); $code->( @arg ); } );
}
$opts->{_registered_on} = time();
}
# http://www.sqlite.org/c3ref/c_status_malloc_count.html
sub stat
{
my $self = shift( @_ );
my $opt = $self->_get_args_as_hash( @_ );
my $ref = $opt->{reset} ? DBD::SQLite::sqlite_status( 0 ) : DBD::SQLite::sqlite_status();
if( $opt->{type} )
{
return( exists( $ref->{ $opt->{type} } ) ? $ref->{ $opt->{type} } : undef() );
}
else
{
return( wantarray() ? () : undef() ) if( !%$ref );
return( wantarray() ? %$ref : $ref );
}
}
# sub table_exists
# {
# my $self = shift( @_ );
# my $table = shift( @_ ) ||
# return( $self->error( "You must provide a table name to access the table methods." ) );
# my $cache_tables = $self->cache_tables;
# my $tables_in_cache = $cache_tables->get({
# host => 'localhost',
# driver => $self->driver,
# port => 0,
# database => $self->database,
# });
# foreach my $ref ( @$tables_in_cache )
# {
# return( 1 ) if( $ref->{name} eq $table );
# }
# # We did not find it, so let's try by checking directly the database
# my $def = $self->table_info( $table ) || return;
# return(0) if( !scalar( @$def ) );
# return(1);
# }
sub table_info
{
my $self = shift( @_ );
my $table = shift( @_ ) ||
return( $self->error( "You must provide a table name to access the table methods." ) );
my $opts = $self->_get_args_as_hash( @_ );
my $sql = <<'EOT';
SELECT
name
,type
FROM sqlite_master
WHERE type IN ('table', 'view') AND name = ?
EOT
my $dbh = $self->{dbh} || return( $self->error( "Could not find database handler." ) );
my $sth = $dbh->prepare_cached( $sql ) || return( $self->error( "An error occured while preparing query to check if table \"$table\" exists in database \"", $self->database, "\": ", $dbh->errstr ) );
$sth->execute( $table ) || return( $self->error( "An error occured while executing query to check if table \"$table\" exists in database \"", $self->database, "\: ", $sth->errstr ) );
my $all = $sth->fetchall_arrayref( {} );
$sth->finish;
return( {} ) if( !scalar( @$all ) );
return( $all->[0] );
}
sub tables
{
my $self = shift( @_ );
my $db = shift( @_ ) || $self->{database};
my $all = $self->tables_info || return;
my @tables = map( $_->{name}, @$all );
# return( wantarray() ? () : undef() ) if( !@tables );
# return( wantarray() ? @tables : \@tables );
return( \@tables );
}
sub tables_info
{
my $self = shift( @_ );
my $db = shift( @_ ) || $self->{database};
# Parameters are: ?, schema, table, and type
# my $sth = $self->{dbh}->table_info( undef, undef, $table, "TABLE,VIEW" );
# The original query was fetched by connecting to Postgres with psql -E and executing the command \z
# This revised query will fetch only tables, views, materialised view and foreign tables, but will avoid the mysterious view called sequence_setvals
# https://stackoverflow.com/questions/82875/how-to-list-the-tables-in-a-sqlite-database-file-that-was-opened-with-attach
my $query = <<SQL;
SELECT name FROM sqlite_master
WHERE type IN ('table','view') AND name NOT LIKE 'sqlite_%'
UNION ALL
SELECT name FROM sqlite_temp_master
WHERE type IN ('table','view')
ORDER BY 1
SQL
my $dbh = $self->{dbh} || return( $self->error( "Could not find database handler." ) );
my $sth = $dbh->prepare_cached( $query ) || return( $self->error( sprintf( "Error while preparing query $query: %s", $dbh->errstr ) ) );
$sth->execute() || return( $self->error( sprintf( "Error while executing query $query: %s", $sth->errstr ) ) );
my $all = $sth->fetchall_arrayref( {} );
return( $all );
}
sub trace { return( shift->error( "Trace is unsupported on SQLite." ) ); }
sub unlock { return( shift->error( "unlock() does not work with SQLite." ) ); }
sub variables
{
return( shift->error( "variables is currently unsupported in Postgres" ) );
}
# https://www.sqlite.org/versionnumbers.html
sub version
{
my $self = shift( @_ );
# If we already have the information, let's use our cache instead of making a query
return( $self->{_db_version} ) if( length( $self->{_db_version} ) );
my $sql = 'SELECT sqlite_version()';
my $sth = $self->do( $sql ) || return( $self->error( "Unable to issue the sql statement '$sql' to get the server version: ", $self->errstr ) );
my $ver = $sth->fetchrow;
$sth->finish;
# We cache it
$self->{_db_version} = version->parse( $ver );
return( $ver );
}
sub _check_connect_param
{
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( !length( $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_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_table unknown_field )];
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_transaction
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' );
}
my $error = 0;
my $opt =
{
pattern => '%Y-%m-%d %T',
locale => 'en_GB',
time_zone => $tz->name,
on_error => sub{ $error++ },
};
# 2019-06-19 23:23:57.000000000+0900
# From PostgreSQL: 2019-06-20 11:02:36.306917+09
# ISO 8601: 2019-06-20T11:08:27
if( $str =~ /(\d{4})[-|\/](\d{1,2})[-|\/](\d{1,2})(?:[[:blank:]]+|T)(\d{1,2}:\d{1,2}:\d{1,2})(?:\.\d+)?((?:\+|\-)\d{2,4})?/ )
{
my( $date, $time, $zone ) = ( "$1-$2-$3", $4, $5 );
if( !length( $zone ) )
{
my $dt = DateTime->now( time_zone => $tz );
my $offset = $dt->offset;
# e.g. 9 or possibly 9.5
my $offset_hour = ( $offset / 3600 );
# e.g. 9.5 => 0.5 * 60 = 30
my $offset_min = ( $offset_hour - CORE::int( $offset_hour ) ) * 60;
$zone = sprintf( '%+03d%02d', $offset_hour, $offset_min );
}
$date =~ tr/\//-/;
$zone .= '00' if( length( $zone ) == 3 );
$str = "$date $time$zone";
$opt->{pattern} = '%Y-%m-%d %T%z';
}
# From SQLite: 2019-06-20 02:03:14
# From MySQL: 2019-06-20 11:04:01
elsif( $str =~ /(\d{4})[-|\/](\d{1,2})[-|\/](\d{1,2})(?:[[:blank:]]+|T)(\d{1,2}:\d{1,2}:\d{1,2})/ )
{
my( $date, $time ) = ( "$1-$2-$3", $4 );
my $dt = DateTime->now( time_zone => $tz );
my $offset = $dt->offset;
# e.g. 9 or possibly 9.5
my $offset_hour = ( $offset / 3600 );
# e.g. 9.5 => 0.5 * 60 = 30
my $offset_min = ( $offset_hour - CORE::int( $offset_hour ) ) * 60;
my $offset_str = sprintf( '%+03d%02d', $offset_hour, $offset_min );
$date =~ tr/\//-/;
$str = "$date $time$offset_str";
$opt->{pattern} = '%Y-%m-%d %T%z';
}
elsif( $str =~ /^(\d{4})[-|\/](\d{1,2})[-|\/](\d{1,2})$/ )
{
$str = "$1-$2-$3";
$opt->{pattern} = '%Y-%m-%d';
}
my $strp = DateTime::Format::Strptime->new( %$opt );
my $dt = $strp->parse_datetime( $str );
return( $dt );
}
# Private function
sub _ceiling
{
my $self = shift( @_ );
my @args = @_;
return( POSIX::ceil( $args[0] ) );
}
sub _concat
{
my $self = shift( @_ );
my @args = @_;
return( join( '', @args ) );
}
sub _curdate
{
my $self = shift( @_ );
my @args = @_;
# try-catch
local $@;
my $tz = eval
{
return( DateTime::TimeZone->new( name => 'local' ) );
};
if( $@ )
{
$tz = DateTime::TimeZone->new( name => 'UTC' );
}
my $d = DateTime->from_epoch( epoch => time(), time_zone => $tz->name );
return( $d->ymd( '-' ) );
}
sub _curtime
{
my $self = shift( @_ );
my @args = @_;
# try-catch
local $@;
my $tz = eval
{
return( DateTime::TimeZone->new( name => 'local' ) );
};
if( $@ )
{
$tz = DateTime::TimeZone->new( name => 'UTC' );
}
my $d = DateTime->now( time_zone => $tz->name );
return( $d->hms( ':' ) );
}
# e.g. Monday
sub _dayname
{
my $self = shift( @_ );
my @args = @_;
my $dt = $self->_parse_timestamp( $args[0] ) || return;
return( $dt->day_name );
}
# E.g.: 17
sub _dayofmonth
{
my $self = shift( @_ );
my @args = @_;
my $dt = $self->_parse_timestamp( $args[0] ) || return;
return( $dt->day );
}
# timestamp, [integer] 1 to 7
sub _dayofweek
{
my $self = shift( @_ );
my @args = @_;
my $dt = $self->_parse_timestamp( $args[0] ) || return;
return( $dt->day_of_week );
}
# E.g.: 170
sub _dayofyear
{
my $self = shift( @_ );
my @args = @_;
my $dt = $self->_parse_timestamp( $args[0] ) || return;
return( $dt->day_of_year );
}
# http://stackoverflow.com/questions/10034636/postgres-longitude-longitude-query
sub _distance_miles
{
my $self = shift( @_ );
my @args = @_;
my( $lat1, $lon1, $lat2, $lon2 ) = @args;
my $x = 69.1 * ( $lat2 - $lat1 );
my $y = 69.1 * ( $lon2 - $lon1 ) * cos( $lat1 / 57.3 );
return( sqrt( $x * $x + $y * $y ) );
}
sub _from_days
{
my $self = shift( @_ );
my @args = @_;
my $from_days = $args[0];
# try-catch
local $@;
my $tz = eval
{
return( DateTime::TimeZone->new( name => 'local' ) );
};
if( $@ )
{
$tz = DateTime::TimeZone->new( name => 'UTC' );
}
my $origin = DateTime->new(
year => 0,
month => 1,
day => 1,
hour => 0,
minute => 0,
second => 0,
time_zone => $tz,
);
my $epoch = DateTime->from_epoch( epoch => 0, time_zone => $tz );
# https://stackoverflow.com/questions/821423/how-can-i-calculate-the-number-of-days-between-two-dates-in-perl#7111718
my $epoch_days = $epoch->delta_days( $origin )->delta_days();
my $days_since_epoch = $from_days - int( $epoch_days );
my $dt = DateTime->from_epoch( epoch => ( $days_since_epoch * 86400 ), time_zone => $tz );
return( $dt );
}
sub _from_unixtime
{
my $self = shift( @_ );
my @args = @_;
return if( $args[0] !~ /^\d+$/ );
# try-catch
local $@;
my $tz = eval
{
return( DateTime::TimeZone->new( name => 'local' ) );
};
if( $@ )
{
$tz = DateTime::TimeZone->new( name => 'UTC' );
}
my $dt = DateTime->from_epoch( epoch => $args[0], time_zone => $tz->name );
return( $dt->strftime( '%Y-%m-%d %T%z' ) );
}
sub _hour
{
my $self = shift( @_ );
my @args = @_;
my $dt = $self->_parse_timestamp( $args[0] ) || return;
return( $dt->hour );
}
sub _lcase
{
my $self = shift( @_ );
my @args = @_;
return( lc( $args[0] ) );
}
sub _left
{
my $self = shift( @_ );
my @args = @_;
return( $args[0] ) if( $args[1] !~ /^\d+$/ );
return( substr( $args[0], 0, $args[1] ) );
}
sub _locate
{
my $self = shift( @_ );
my @args = @_;
return( CORE::index( $args[0], $args[1] ) );
}
sub _log10
{
my $self = shift( @_ );
my @args = @_;
return( log( $args[0] ) / log( 10 ) );
}
sub _minute
{
my $self = shift( @_ );
my @args = @_;
my $dt = $self->_parse_timestamp( $args[0] ) || return;
return( $dt->minute );
}
sub _month
{
my $self = shift( @_ );
my @args = @_;
my $dt = $self->_parse_timestamp( $args[0] ) || return;
return( $dt->month );
}
sub _monthname
{
my $self = shift( @_ );
my @args = @_;
my $dt = $self->_parse_timestamp( $args[0] ) || return;
return( $dt->month_name );
}
sub _number_format
{
my $self = shift( @_ );
my @args = @_;
my( $num, $tho, $dec, $prec ) = @args;
$self->_load_class( 'Module::Generic::Number' ) || return( $self->pass_error );
my $fmt = Module::Generic::Number->new( $num );
# 1 means with trailing zeros
return( $fmt->format(
thousand => $tho,
decimal => $dec,
precision => $prec,
decimal_fill => 1,
));
}
sub _placeholder_regexp { return( $PLACEHOLDER_REGEXP ) }
sub _power
{
my $self = shift( @_ );
my @args = @_;
return( CORE::exp( $args[ 1 ] * CORE::log( $args[ 0 ] ) ) );
}
sub _quarter
{
my $self = shift( @_ );
my @args = @_;
my $dt = $self->_parse_timestamp( $args[0] ) || return;
return( $dt->quarter );
}
sub _rand
{
my $self = shift( @_ );
my @args = @_;
return( CORE::rand() );
}
sub _regexp
{
my $self = shift( @_ );
my @args = @_;
my( $re, $what ) = @args;
return( $what =~ /$re/ );
}
sub _replace
{
my $self = shift( @_ );
my @args = @_;
my( $str, $from, $to ) = @args;
$str =~ s/($from)/$to/gs;
return( $str );
}
sub _right
{
my $self = shift( @_ );
my @args = @_;
return( CORE::substr( $args[0], CORE::length( $args[0] ) - $args[1] ) );
}
sub _second
{
my $self = shift( @_ );
my @args = @_;
my $dt = $self->_parse_timestamp( $args[0] ) || return;
return( $dt->second );
}
sub _space
{
my $self = shift( @_ );
my @args = @_;
return( ' ' x CORE::int( $args[0] ) );
}
sub _sprintf
{
my $self = shift( @_ );
my @args = @_;
for( my $i = 0; $i < scalar( @args ); $i++ )
{
$args[$i] =~ s/'/\\'/g;
}
my $eval = "CORE::sprintf( '" . join( "', '", @args ) . "' )";
my $res = eval( $eval );
# return( CORE::sprintf( @args ) );
return( $res );
}
sub _to_days
{
my $self = shift( @_ );
my @args = @_;
my $dt = $self->_parse_timestamp( $args[0] ) || return;
# try-catch
local $@;
my $tz = eval
{
return( DateTime::TimeZone->new( name => 'local' ) );
};
if( $@ )
{
$tz = DateTime::TimeZone->new( name => 'UTC' );
}
my $origin = DateTime->new(
year => 0,
month => 1,
day => 1,
hour => 0,
minute => 0,
second => 0,
time_zone => $tz->name,
);
# https://stackoverflow.com/questions/821423/how-can-i-calculate-the-number-of-days-between-two-dates-in-perl#7111718
my $days = $dt->delta_days( $origin )->delta_days();
return( $days );
}
# sub _truncate
# {
# my $self = shift( @_ );
# my @args = @_;
# return if( $args[1] !~ /^\-?\d+$/ );
# return( CORE::substr( $args[0], 0, $args[1] ) );
# }
sub _ucase
{
my $self = shift( @_ );
my @args = @_;
return( uc( $args[0] ) );
}
sub _unix_timestamp
{
my $self = shift( @_ );
my @args = @_;
my $dt = $self->_parse_timestamp( $args[0] ) || return;
return( $dt->epoch );
}
sub _week
{
my $self = shift( @_ );
my @args = @_;
my $dt = $self->_parse_timestamp( $args[0] ) || return;
return( $dt->week_number );
}
sub _weekday
{
my $self = shift( @_ );
my @args = @_;
my $dt = $self->_parse_timestamp( $args[0] ) || return;
return( $dt->day_of_week );
}
sub _year
{
my $self = shift( @_ );
my @args = @_;
my $dt = $self->_parse_timestamp( $args[0] ) || return;
return( $dt->year );
}
DESTROY
{
my $self = shift( @_ );
my $class = ref( $self ) || $self;
if( $self->{sth} )
{
# print( STDERR "DESTROY(): Terminating sth '$self' for query:\n$self->{ 'query' }\n" ) if( $DEBUG );
$self->{sth}->finish();
}
elsif( $self->{dbh} && $class =~ /^AI\:\:DB\:\:Postgres$/ )
{
local( $SIG{__WARN__} ) = sub { };
# $self->{dbh}->disconnect();
# if( $DEBUG )
# {
# my( $pack, $file, $line, $sub ) = ( caller( 0 ) )[ 0, 1, 2, 3 ];
# my( $pack2, $file2, $line2, $sub2 ) = ( caller( 1 ) ) [ 0, 1, 2, 3 ];
# print( STDERR "DESTROY database handle ($self) [$self->{ 'query' }]\ncalled within sub '$sub' ($sub2) from package '$pack' ($pack2) in file '$file' ($file2) at line '$line' ($line2).\n" );
# }
$self->disconnect();
}
my $locks = $self->{_locks};
if( $locks && $self->_is_array( $locks ) )
{
foreach my $name ( @$locks )
{
$self->unlock( $name );
}
}
}
1;
# NOTE: POD
__END__
=encoding utf8
=head1 NAME
DB::Object::SQLite - DB Object SQLite Driver
=head1 SYNOPSIS
use DB::Object;
my $dbh = DB::Object->connect({
driver => 'SQLite',
conf_file => 'db-settings.json',
database => 'webstore',
host => 'localhost',
login => 'store-admin',
schema => 'auth',
debug => 3,
}) || bailout( "Unable to connect to sql server on host localhost: ", DB::Object->error );
# Legacy regular query
my $sth = $dbh->prepare( "SELECT login,name FROM login WHERE login='jack'" ) ||
die( $dbh->errstr() );
$sth->execute() || die( $sth->errstr() );
my $ref = $sth->fetchrow_hashref();
$sth->finish();
# Get a list of databases;
my @databases = $dbh->databases;
# Doesn't exist? Create it:
my $dbh2 = $dbh->create_db( 'webstore' );
# Load some sql into it
my $rv = $dbh2->do( $sql ) || die( $dbh->error );
# Check a table exists
$dbh->table_exists( 'customers' ) || die( "Cannot find the customers table!\n" );
# Get list of tables, as array reference:
my $tables = $dbh->tables;
my $cust = $dbh->customers || die( "Cannot get customers object." );
$cust->where( email => 'john@example.org' );
my $str = $cust->delete->as_string;
# Becomes: DELETE FROM customers WHERE email='john\@example.org'
# Do some insert with transaction
$dbh->begin_work;
# Making some other inserts and updates here...
my $cust_sth_ins = $cust->insert(
first_name => 'Paul',
last_name => 'Goldman',
email => 'paul@example.org',
active => 0,
) || do
{
# Rollback everything since the begin_work
$dbh->rollback;
die( "Error while create query to add data to table customers: " . $cust->error );
};
$result = $cust_sth_ins->as_string;
# INSERT INTO customers (first_name, last_name, email, active) VALUES('Paul', 'Goldman', 'paul\@example.org', '0')
$dbh->commit;
# Get the last used insert id
my $id = $dbh->last_insert_id();
$cust->where( email => 'john@example.org' );
$cust->order( 'last_name' );
$cust->having( email => qr/\@example/ );
$cust->limit( 10 );
my $cust_sth_sel = $cust->select || die( "An error occurred while creating a query to select data frm table customers: " . $cust->error );
# Becomes:
# SELECT id, first_name, last_name, email, created, modified, active, created::ABSTIME::INTEGER AS created_unixtime, modified::ABSTIME::INTEGER AS modified_unixtime, CONCAT(first_name, ' ', last_name) AS name FROM customers WHERE email='john\@example.org' HAVING email ~ '\@example' ORDER BY last_name LIMIT 10
$cust->reset;
$cust->where( email => 'john@example.org' );
my $cust_sth_upd = $cust->update( active => 0 )
# Would become:
# UPDATE ONLY customers SET active='0' WHERE email='john\@example.org'
# Lets' dump the result of our query
# First to STDERR
$login->where( "login='jack'" );
$login->select->dump();
# Now dump the result to a file
$login->select->dump( "my_file.txt" );
=head1 VERSION
v1.1.3
=head1 DESCRIPTION
This package inherits from L<DB::Object>, so any method not here, but there you can use.
L<DB::Object::SQLite> is a SQL API much alike L<DBD::SQLite>.
So why use a private module instead of using that great L<DBD::SQLite> package?
At first, I started to inherit from C<DBI> to conform to C<perlmod> perl
manual page and to general perl coding guidlines. It became very quickly a
real hassle. Barely impossible to inherit, difficulty to handle error, too
much dependent from an API that change its behaviour with new versions.
In short, I wanted a better, more accurate control over the SQL connection.
So, L<DB::Object::SQLite> acts as a convenient, modifiable wrapper that provide the
programmer with an intuitive, user-friendly and hassle free interface.
=head1 CONSTRUCTOR
=head2 new
Create a new instance of L<DB::Object::SQLite>. Nothing much to say.
=head2 connect
Same as L<DB::Object/connect>, only specific to SQLite.
See L</_connection_params2hash>
=head1 METHODS
=head2 alias
This is inherited from L<DB::Object/alias>
=head2 as_string
This is inherited from L<DB::Object/as_string>
=head2 avoid
This is inherited from L<DB::Object/avoid>
=head2 attribute
Sets or get the value of database connection parameters.
If only one argument is provided, returns its value.
If multiple arguments in a form of pair => value are provided, it sets the corresponding database parameters.
The authorised parameters are:
=over 4
=item * C<ActiveKids>
Is read-only.
=item * C<AutoCommit>
Can be changed.
=item * C<AutoInactiveDestroy>
Can be changed.
=item * C<CachedKids>
Is read-only.
=item * C<ChildHandles>
Is read-only.
=item * C<ChopBlanks>
Can be changed.
=item * C<CursorName>
Is read-only.
=item * C<Driver>
Is read-only.
=item * C<ErrCount>
Can be changed.
=item * C<Executed>
Is read-only.
=item * C<FetchHashKeyName>
Can be changed.
=item * C<HandleError>
Can be changed.
=item * C<HandleSetErr>
Can be changed.
=item * C<InactiveDestroy>
Can be changed.
=item * C<Kids>
Is read-only.
=item * C<NAME>
Is read-only.
=item * C<NULLABLE>
Is read-only.
=item * C<NUM_OF_FIELDS>
Is read-only.
=item * C<NUM_OF_PARAMS>
Is read-only.
=item * C<Name>
Is read-only.
=item * C<PRECISION>
Is read-only.
=item * C<PrintError>
Can be changed.
=item * C<PrintWarn>
Can be changed.
=item * C<Profile>
Can be changed.
=item * C<RaiseError>
Can be changed.
=item * C<RowCacheSize>
Is read-only.
=item * C<RowsInCache>
Is read-only.
=item * C<SCALE>
Is read-only.
=item * C<ShowErrorStatement>
Can be changed.
=item * C<Statement>
Is read-only.
=item * C<TYPE>
Is read-only.
=item * C<Taint>
Can be changed.
=item * C<TaintIn>
Can be changed.
=item * C<TaintOut>
Can be changed.
=item * C<TraceLevel>
Can be changed.
=item * C<Type>
Can be changed.
=item * C<Username>
Is read-only.
=item * C<Warn>
Can be changed.
=item * C<sqlite_allow_multiple_statements>
Can be changed.
=item * C<sqlite_see_if_its_a_number>
Can be changed.
=item * C<sqlite_unicode>
Can be changed.
=item * C<sqlite_unprepared_statements>
Is read-only.
=item * C<sqlite_use_immediate_transaction>
Can be changed.
=item * C<sqlite_version>
Is read-only.
=back
=head2 available_drivers
Return the list of available drivers.
This is an inherited method from L<DB::Object/available_drivers>
=head2 begin_work
Mark the beginning of a transaction.
Any arguments provided are passed along to L<DBD::SQLite/begin_work>
=head2 bind
This is an inherited method from L<DB::Object/bind>
=head2 cache
This is an inherited method from L<DB::Object/cache>
=head2 can_update_delete_limit
Returns the boolean value for the SQLite compiled option C<ENABLE_UPDATE_DELETE_LIMIT> by calling L</has_compile_option>
=head2 check_driver
This is an inherited method from L<DB::Object/check_driver>
=head2 commit
Make any change to the database irreversible.
This must be used only after having called L</begin_work>
Any arguments provided are passed along to L<DBD::SQLite/commit>
=head2 compile_options
Returns the cached list of SQLite compiled options. The cached file is in the file C<sql_sqlite_compile_options.cfg> in the sytem directory.
=head2 connect
Same as L<DB::Object/connect>, only specific to SQLite.
It sets C<sqlite_unicode> to a true value in the connection parameters returned by L</_connection_params2hash>
See L</_connection_params2hash>
=head2 copy
This is an inherited method from L<DB::Object/copy>
=head2 create_table
This is an inherited method from L<DB::Object/create_table>
=head2 data_sources
This is an inherited method from L<DB::Object/data_sources>
=head2 data_type
This is an inherited method from L<DB::Object/data_type>
=head2 database
This is an inherited method from L<DB::Object/database>
=head2 database_file
Returns the file path to the database file.
=head2 databases
Returns a list of databases, which in SQLite, means a list of opened sqlite database files.
=head2 datatype_dict
Returns an hash reference of each data type with their equivalent C<constant>, regular expression (C<re>), constant C<name> and C<type> name.
Each data type is an hash with the following properties for each type: C<constant>, C<name>, C<re>, C<type>
=head2 delete
This is an inherited method from L<DB::Object/database>
=head2 disconnect
This is an inherited method from L<DB::Object/disconnect>
=head2 do
This is an inherited method from L<DB::Object/do>
=head2 enhance
This is an inherited method from L<DB::Object/enhance>
=head2 func
Provided with a table name and a function name and this will call L<DB::SQLite> passing it the table name and the function name.
It returns the value received from the function call.
=head2 get_sql_type
Provided with a data type as a string and this returns a SQLite constant suitable to be passed to L<DBI/bind_param>
=head2 having
A convenient wrapper to L<DB::Object::SQLite::Query/having>
=head2 has_compile_option
Provided with a compile option (the character case is irrelevant) and this will check if it exists or not.
=head2 last_insert_id
=head2 lock
This is an unsupported feature in SQLIte
=head2 on_conflict
See L<DB::Object::SQLite::Tables/on_conflict>
=head2 pragma
This is still a work in progress.
=head2 replace
Just like for the INSERT query, L</replace> takes one optional argument representing a L<DB::Object::SQLite::Statement> SELECT object or a list of field-value pairs.
If a SELECT statement is provided, it will be used to construct a query of the type of REPLACE INTO mytable SELECT FROM other_table
Otherwise the query will be REPLACE INTO mytable (fields) VALUES(values)
In scalar context, it execute the query and in list context it simply returns the statement handler.
=head2 register_function
This takes an hash reference of parameters and will register a new function by calling L<DBD::SQLite/sql_function_register>
Possible options are:
=over 4
=item * C<code>
Anonymous code to be executed when the function is called.
=item * C<func>
This is an hash reference representing registry of functions. The value for each key is the option hash reference.
=item * C<flags>
An array reference of flags
=item * C<name>
The function name
=back
=head2 remove_function
Provided with a function name and this will remove it.
It returns false if there is no function, or returns the options hash reference originally set for the function removed.
=head2 returning
A convenient wrapper to L<DB::Object::Postgres::Query/returning>
=head2 rollback
Will roll back any changes made to the database since the last transaction point marked with L</begin_work>
=head2 sql_function_register
Provided with an hash reference of options and this will register a sql function by calling L<DBD::SQLite/sqlite_create_function>
Possible options are:
=over 4
=item * C<argc>
The function arguments
=item * C<code>
Anonymous perl code to be executed when the function is called
=item * C<flags>
An array reference of flags. Those flags are joined with C<|> and L<perlfunc/eval>'ed
=item * C<name>
The function name
=back
=head2 stat
Provided with an hash or hash reference of parameters and this will call L<DBD::SQLite/sqlite_status> and get the hash reference of values returned.
If the option I<reset> is set, then this will call L<DBD::SQLite/sqlite_status> passing it 0 to reset it instead.
If the option I<type> is specified, this will return the equivalent property from the stat hash reference returned by L<DBD::SQLite/sqlite_status>, otherwise, it will return the hash in list context and the hash reference of stat properties in scalar context.
=head2 table_info
Provided with a table name and this will retrieve the table information as an hash reference.
Otherwise, if nothing can be found, it returns an empty hash reference.
It takes no optional parameters.
Information retrieved are:
=over 4
=item * C<name>
The table name
=item * C<type>
The object type, which may be one of: C<table>, C<view>, C<materialized view>, C<special>, C<foreign table>
=back
=head2 tables
Connects to the database and finds out the list of all available tables.
Returns undef or empty list in scalar or list context respectively if no table found.
Otherwise, it returns the list of table in list context or a reference of it in scalar context.
=head2 tables_info
Provided with a database or using by default the current database and this will issue a query to get an array reference of all tables.
It returns the array reference.
=head2 trace
Trace is unsupported on SQLite.
=head2 unlock
Unlock is unsupported on SQLite.
=head2 variables
Variables are unsupported on SQLite.
=head2 version
This returns the, possibly cached, SQLite server version as a L<version> object.
=head2 _check_connect_param
This returns an hash reference of connection parameters.
If there is no L</database_file> currently set, it will use the property I<uri>.
The database is taken from the property I<database>, or derived from the last path segment of the I<uri>.
The database file is made absolute and is et as the I<database_file> property
The database is name, if not set, is derived from the base path of the I<database_file>
The I<host> property is set to C<localhost> and I<port> property to C<0>
It returns the hash reference of parameters thus processed.
=head2 _check_default_option
Provided with an hash or hash reference of options and this will check it and set some default value.
The only default property this sets is C<sqlite_unicode> to true.
It returns the hash reference of options.
=head2 _connection_options
Provided with an hash reference of parameters and this will check them and returns an hash reference of options who name start with C<sqlite_>
=head2 _connection_parameters
Provided with an hash or hash reference of connection parameters and this will extra all the properties that start with C<sqlite_/> and add them to an array of core properties: db login passwd host port driver database server opt uri debug
It returns those properties as an array reference.
=head2 _dbi_connect
This calls L<DB::Connect/_dbi_connect> and do more driver specific processing.
It will register all the functions set in the global hash reference C<$PRIVATE_FUNCTIONS> which is a function name to code reference pairs. For each of those function, they will be added by calling L</sql_function_register>
It returns the database handler object (L<DBD::Object::SQLite>)
=head2 _dsn
Using the L</database_file> set and this will issue a connection to the SQLite database file.
If the file does not exist or is not writable, this will return an error, otherwise this will return the string representing the dsn, which are connection parameters separated by C<;>
=head2 _parse_timestamp
Provided a string and this will parse it to return a L<DateTime> object.
=head1 SQLITE FUNCTIONS AVAILABLE
=head2 ceiling
This is a sql function to be registered automatically upon connection to the SQLite database file.
It leverages L<POSIX/ceil>
=head2 concat
This returns the arguments provided concatenated as a string.
=head2 curdate
Returns a string representing the year, month and date separated by a C<->
This is computed using L<DateTime>
=head2 curtime
Returns a string representing the hours, minutes and seconds separated by a C<:>
This is computed using L<DateTime>
=head2 dayname
Based on a datetime that is parsed using L</_parse_timestamp>, this returns the day name of the week, such as C<Monday>
=head2 dayofmonth
Based on a datetime that is parsed using L</_parse_timestamp>, this returns the day of the month, such as 17.
=head2 dayofweek
Based on a datetime that is parsed using L</_parse_timestamp>, this returns the day of the week as a number from 1 to 7 with 1 being Monday
=head2 dayofyear
Based on a datetime that is parsed using L</_parse_timestamp>, this returns the day of the year, such as a number from 1 to 365, or possibly 366 depending on the year.
=head2 distance_miles
Provided with an original latitude, longitude and a target latitude and longitude and this will calculate the distance between the 2.
See the source L<StackOverflow post on which this function is based|http://stackoverflow.com/questions/10034636/postgres-longitude-longitude-query>.
=head2 from_days
Calculate the number of days since January 1st of year 0 and returns a L<DateTime> object.
=head2 from_unixtime
Provided with a unix timestamp, and this will return a datetime string such as C<YYYY-mm-dd HH:MM:SS>
=head2 hour
Provided with a date time, and this will parse it and return the hour.
=head2 lcase
Provided with a string and this returns its lower case value.
=head2 left
Provided with a string and an integer C<n> and this will return a substring capturing the nth first characters.
=head2 locate
This essentially does the same as L<perlfunc/index>
=head2 log10
Provided with a number and this returns its logarithm base 10.
=head2 minute
Provided with a date time, and this will parse it and return the minutes.
=head2 month
Provided with a date time, and this will parse it and return the month.
=head2 monthname
Provided with a date time, and this will parse it and return the month name.
=head2 number_format
Provided with a number, a thousand separator, a decimal separator and a decimal precision and this will format the number accordingly and return it as a string.
=head2 power
Provided with a number and a power, and this will return the number powered
=head2 quarter
Provided with a date time, and this will parse it and return the quarter.
=head2 query_object
Set or gets the SQLite query object (L<DB::Object::SQLite::Query>) used to process and format queries.
=head2 rand
This takes no argument and simply returns a random number using L<perlfunc/rand>
=head2 regexp
Provided with a regular expression and the string to test, and this will test the regular expression and return true if it matches or false otherwise.
=head2 replace
Provided with a string, some term to replace and a replacement string and this will do a perl substitution and return the resulting string.
=head2 right
Provided with a string and an integer n and this will return the nth right most characters.
=head2 second
Provided with a date time, and this will parse it and return the seconds.
=head2 space
Provided with an integer and this will return as much spaces.
=head2 sprintf
This behaves like L<perlfunc/sprintf> and provided with a template and some arguments, it will return a formatted string.
=head2 to_days
Provided with a date time, and this will return the number of days since January 1st of year 0.
=head2 ucase
This returns the string provided with all its characters in upper case.
=head2 unix_timestamp
Provided with a date time and this will returns its unix timestamp representation.
=head2 week
Provided with a date time, and this will parse it and return the week.
=head2 weekday
Provided with a date time, and this will parse it and return the day of the week.
=head2 year
Provided with a date time, and this will parse it and return the day of the year.
=head1 SEE ALSO
L<DBI>, L<Apache::DBI>
=head1 AUTHOR
Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
=head1 COPYRIGHT & LICENSE
Copyright (c) 2019-2021 DEGUEST Pte. Ltd.
You can use, copy, modify and redistribute this package and associated
files under the same terms as Perl itself.
=cut