File Coverage

blib/lib/Database/Temp/Driver/SQLite.pm

Criterion	Covered	Total	%
statement	47	63	74.6
branch	3	6	50.0
condition	3	5	60.0
subroutine	11	13	84.6
pod	2	2	100.0
total	66	89	74.1

package Database::Temp::Driver::SQLite;

use strict;
use warnings;

# ABSTRACT: Create an ad-hoc database, driver for SQLite

our $VERSION = '0.003'; # VERSION: generated by DZP::OurPkgVersion

use Module::Load::Conditional qw( can_load );
use File::Spec;
use Carp qw( shortmess );

use Log::Any;
use Try::Tiny;

sub is_available {
    my %needed = ( 'DBD::SQLite' => 1.41_01, );
    if ( can_load( modules => \%needed ) ) {
        return 1;
    }
    else {
        Log::Any->get_logger( category => 'Database::Temp' )->infof( 'Cannot load module %s, %s', %needed );
        return 0;
    }

}

sub new {
    my ( $class, %params ) = @_;
    my $_log = Log::Any->get_logger( category => 'Database::Temp' );

    my $dir      = $params{'args'}->{'dir'} // File::Spec->tmpdir();
    my $filename = $params{'name'};
    my $filepath = File::Spec->catfile( $dir, $filename );
    my $dsn      = "dbi:SQLite:uri=file:$filepath?mode=rwc";
    $_log->debugf( 'Created temp filepath \'%s\'', $filepath );

    my %attrs = (

        # 'ReadOnly'          => 0,
        'AutoCommit' => 1,
        'RaiseError' => 1,
        'PrintError' => 1,
        'RaiseWarn'  => 1,
        'PrintWarn'  => 1,
        'TaintIn'    => 1,
        'TaintOut'   => 0,
        'TraceLevel' => 0,
    );
    my %info = ( 'filepath' => $filepath, );

    # Construct start method
    my $_start = sub {
        my ( $dbh, $name ) = @_;
        Log::Any->get_logger( category => 'Database::Temp' )->debugf( 'Created temp db \'%s\'', $name );
    };

    # Construct init method
    my $init;
    if ( ref $params{'init'} eq 'CODE' ) {
        $init = $params{'init'};
    }
    else {    # SCALAR
        $init = sub {
            my ($dbh) = @_;
            $dbh->begin_work();
            foreach my $row ( split qr/;\s*/msx, $params{'init'} ) {
                $dbh->do($row);
            }
            $dbh->commit;
            return;
        }
    }

    # Construct deinit method
    my $deinit;
    if ( ref $params{'deinit'} eq 'CODE' ) {
        $deinit = $params{'deinit'};
    }
    else {    # SCALAR
        $deinit = sub {
            my ($dbh) = @_;
            $dbh->begin_work();
            foreach my $row ( split qr/;\s*/msx, $params{'deinit'} ) {
                $dbh->do($row);
            }
            $dbh->commit;
            return;
        }
    }

    # Construct _cleanup method
    my $_cleanup = sub {
        my ( $dbh, $name, $info ) = @_;
        $_log->infof( 'Deleting file %s, db %s', $info->{'filepath'}, $name );
        unlink $info->{'filepath'};
    };

    # Create database representing object.
    return Database::Temp::DB->new(
        driver   => ( __PACKAGE__ =~ m/^Database::Temp::Driver::(.*)$/msx )[0],
        name     => $params{'name'},
        cleanup  => $params{'cleanup'} // 0,
        _cleanup => $_cleanup,
        _start   => $_start,
        init     => $init,
        deinit   => $deinit,
        dsn      => $dsn,
        username => undef,
        password => undef,
        attr     => \%attrs,
        info     => \%info,
    );
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Database::Temp::Driver::SQLite - Create an ad-hoc database, driver for SQLite

=head1 VERSION

version 0.003

=head2 is_available

Can this driver provide a database?

Return boolean.

=head2 new

Create a temp database.

User should never call this subroutine directly, only via L<Database::Temp>.

=head1 AUTHOR

Mikko Koivunalho <[e-mail]>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2023 by Mikko Johannes Koivunalho.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut