view release on metacpan or  search on metacpan

lib/Pcore/Handle/sqlite.pm  view on Meta::CPAN

package Pcore::Handle::sqlite;

use Pcore -class, -const, -res;
use DBI qw[];
use Pcore::Handle::DBI::Const qw[:CONST];
use DBD::SQLite qw[];
use DBD::SQLite::Constants qw[:file_open];
use Pcore::Util::Scalar qw[weaken is_blessed_ref looks_like_number is_plain_arrayref is_plain_coderef is_blessed_arrayref];
use Pcore::Util::UUID qw[uuid_v1mc_str uuid_v4_str];
use Pcore::Util::Data qw[to_json];

# NOTE http://habrahabr.ru/post/149635/
# для вставки данных в цикле надо использовать h->begin_work ... h->commit

with qw[Pcore::Handle::DBI];

const our $SQLITE_OPEN_RO  => SQLITE_OPEN_READONLY | SQLITE_OPEN_SHAREDCACHE;
const our $SQLITE_OPEN_RW  => SQLITE_OPEN_READWRITE | SQLITE_OPEN_SHAREDCACHE;
const our $SQLITE_OPEN_RWC => SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE | SQLITE_OPEN_SHAREDCACHE;

const our $SQLITE_OPEN => {
    ro  => $SQLITE_OPEN_RO,
    rw  => $SQLITE_OPEN_RW,
    rwc => $SQLITE_OPEN_RWC,
};

has mode         => 'rwc';        # ( is => 'ro', isa => Enum [ keys $SQLITE_OPEN->%* ] );
has busy_timeout => 1_000 * 3;    # ( is => 'ro', isa => PositiveOrZeroInt );    # milliseconds, set to 0 to disable timeout, default - 3 seconds

# SQLITE PRAGMAS
has temp_store   => 'MEMORY';      # ( is => 'ro', isa => Enum [qw[FILE MEMORY]] );
has journal_mode => 'WAL';         # ( is => 'ro', isa => Enum [qw[DELETE TRUNCATE PERSIST MEMORY WAL OFF]] );      # WAL is the best
has synchronous  => 'OFF';         # ( is => 'ro', isa => Enum [qw[FULL NORMAL OFF]] );      # OFF - data integrity on app failure, NORMAL - data integrity on app and OS failures, FULL - full data integrity on app or OS failures, slower
has cache_size   => -1_048_576;    # ( is => 'ro', isa => Int );    # 0+ - pages,  -kilobytes, default 1G
has foreign_keys => 1;             # ( is => 'ro', isa => Bool );

has is_sqlite    => 1;             # ( is => 'ro', isa => Bool,      default  => 1, init_arg => undef );
has h            => ();            # ( is => 'ro', isa => Object,    init_arg => undef );
has prepared_sth => ();            # ( is => 'ro', isa => HashRef,   init_arg => undef );
has query        => ();            # ( is => 'ro', isa => ScalarRef, init_arg => undef );                  # ref to the last query

# SQLite types
const our $SQLITE_UNKNOWN => 0;
const our $SQLITE_INTEGER => 4;
const our $SQLITE_REAL    => 6;
const our $SQLITE_TEXT    => 12;
const our $SQLITE_BLOB    => 30;

# postgreSQL types to SQLite
const our $TYPE_TO_SQLITE => {
    $SQL_BOOL    => $SQLITE_INTEGER,
    $SQL_BYTEA   => $SQLITE_BLOB,
    $SQL_CHAR    => $SQLITE_TEXT,
    $SQL_FLOAT4  => $SQLITE_REAL,
    $SQL_FLOAT8  => $SQLITE_REAL,
    $SQL_JSON    => $SQLITE_BLOB,
    $SQL_INT2    => $SQLITE_INTEGER,
    $SQL_INT4    => $SQLITE_INTEGER,
    $SQL_INT8    => $SQLITE_INTEGER,
    $SQL_MONEY   => $SQLITE_REAL,
    $SQL_NUMERIC => $SQLITE_REAL,
    $SQL_TEXT    => $SQLITE_TEXT,
    $SQL_UNKNOWN => $SQLITE_UNKNOWN,
    $SQL_UUID    => $SQLITE_BLOB,
    $SQL_VARCHAR => $SQLITE_TEXT,
};

sub BUILD ( $self, $args ) {
    my $attr = {
        AutoCommit                       => 1,
        sqlite_open_flags                => $SQLITE_OPEN->{ $self->{mode} },
        sqlite_unicode                   => 1,
        sqlite_allow_multiple_statements => 1,
        sqlite_use_immediate_transaction => 1,
        sqlite_see_if_its_a_number       => 1,

        Warn               => 1,
        PrintWarn          => 0,
        PrintError         => 0,
        RaiseError         => 0,
        ShowErrorStatement => 1,

        # HandleError => sub {
        #     my $msg = shift;
        #
        #     # escape_scalar $msg;
        #
        #     P->sendlog( 'Pcore-DBH.ERROR', $msg );
        #
        #     return;
        # },
        # Callbacks          => {
        #     connected => sub {
        #         P->sendlog( 'Pcore-DBH.DEBUG', 'Connected to: ' . $_[1] ) if $ENV{PCORE_DBH_DEBUG};
        #
        #         return;
        #     },
        #     prepare => sub {
        #         return;
        #     },
        #     do => sub {
        #         P->sendlog( 'Pcore-DBH.DEBUG', 'Do: ' . $_[1] ) if $ENV{PCORE_DBH_DEBUG};
        #
        #         return;
        #     },
        #     ChildCallbacks => {
        #         execute => sub {
        #             P->sendlog( 'Pcore-DBH.DEBUG', 'Execute: ' . $_[0]->{Statement} ) if $ENV{PCORE_DBH_DEBUG};
        #
        #             return;
        #         }
        #     }
        # },
    };

    my $dbname = $self->{uri}->{path} ? $self->{uri}->{path}->to_string : ':memory:';

    my $dbh = DBI->connect( "dbi:SQLite:dbname=$dbname", q[], q[], $attr );

    $dbh->do('PRAGMA encoding = "UTF-8"');
    $dbh->do( 'PRAGMA temp_store = ' . $self->{temp_store} );
    $dbh->do( 'PRAGMA journal_mode = ' . $self->{journal_mode} );
    $dbh->do( 'PRAGMA synchronous = ' . $self->{synchronous} );
    $dbh->do( 'PRAGMA cache_size = ' . $self->{cache_size} );
    $dbh->do( 'PRAGMA foreign_keys = ' . $self->{foreign_keys} );

    $dbh->sqlite_busy_timeout( $self->{busy_timeout} );

    # create custom functions
    $dbh->sqlite_create_function( 'uuid_generate_v1mc', 0, sub { return uuid_v1mc_str } );
    $dbh->sqlite_create_function( 'uuid_generate_v4',   0, sub { return uuid_v4_str } );
    $dbh->sqlite_create_function( 'gen_random_uuid',    0, sub { return uuid_v4_str } );

    $self->{on_connect}->($self) if $self->{on_connect};

    $self->{h} = $dbh;

    return;
}

# STH
sub prepare ( $self, $query ) {
    my $sth = bless {
        id    => uuid_v1mc_str,
        query => $query,
      },
      'Pcore::Handle::DBI::STH';

    return $sth;
}

sub destroy_sth ( $self, $id ) {
    delete $self->{prepared_sth}->{$id};

    return;
}

# SCHEMA PATCH
sub _get_schema_patch_table_query ( $self, $table_name ) {
    return <<"SQL";
        CREATE TABLE IF NOT EXISTS "$table_name" (
            "id" INTEGER PRIMARY KEY NOT NULL,
            "timestamp" DATETIME NOT NULL DEFAULT CURRENT_TIMESTAMP
        )
SQL
}

# QUOTE
sub _get_sqlite_type : prototype($) ($type) {

    # use TEXT as default type
    if ( !defined $type || !exists $TYPE_TO_SQLITE->{$type} ) {
        $type = $SQLITE_TEXT;
    }
    else {
        $type = $TYPE_TO_SQLITE->{$type};
    }

    return $type;
}

sub quote ( $self, $var ) {
    return 'NULL' if !defined $var;

    my $type;

    if ( is_blessed_arrayref $var) {