File Coverage

blib/lib/Module/Build/Database/SQLite.pm

Criterion	Covered	Total	%
statement	28	128	21.8
branch	1	26	3.8
condition	1	39	2.5
subroutine	10	30	33.3
pod	1	1	100.0
total	41	224	18.3

=head1 NAME

Module::Build::Database::SQLite - SQLite implementation for MBD

=head1 SYNOPSIS

 my $builder = Module::Build::Database->new(
    database_type => "SQLite",
    database_options => {
        name   => "my_database_name",
    });

=head1 DESCRIPTION

SQLite driver for Module::Build::Database.

=head1 METHODS

=over

=cut

package Module::Build::Database::SQLite;
use base 'Module::Build::Database';
use Module::Build::Database::Helpers qw/do_system verify_bin debug info/;

use Path::Class qw( tempdir );
use File::Copy qw( copy );
use File::Temp;
use File::Basename qw/dirname/;
use Cwd qw/abs_path/;

use strict;
use warnings;
our $VERSION = '0.56';

__PACKAGE__->add_property(database_options => default => { name => "unknown" });
__PACKAGE__->add_property(_tmp_db_dir         => default => "" );

our $dbFile;
our %Bin = (
    Sqlite => 'sqlite3'
);
verify_bin(\%Bin);

=item have_db_cli

Is there a command line interface for sqlite available
in the current PATH?

=cut

sub have_db_cli {
    return $Bin{Sqlite} && $Bin{Sqlite} !~ qr[/bin/false] ? 1 : 0;
}

sub _show_live_db {
    my $self = shift;
    my $name = shift || $self->database_options('name');
    info "database : ". (eval { abs_path($name) } || $name);
}

sub _is_fresh_install {
    my $self = shift;
    my $database_name = $self->database_options('name');

    return -e $database_name && -s _ ? 0 : 1;
}

sub _create_database {
    my $self = shift;
    $dbFile = $self->database_options('name') or die "no database name";
    # nothing to do
    return 1;
}

sub _create_patch_table {
    my $self = shift;
    $dbFile ||= $self->database_options('name');
    debug "creating patch table";
    $self->_do_sqlite(<
    CREATE TABLE patches_applied (
        patch_name   varchar(255) primary key,
        patch_md5    varchar(255),
        when_applied timestamp );
EOT
}

sub _insert_patch_record {
    my $self = shift;
    my $record = shift;
    my ($name,$md5) = @$record;
    debug "adding patch record $name, $md5";
    $self->_do_sqlite("insert into patches_applied (patch_name, patch_md5, when_applied) ".
             " values ('$name','$md5',current_timestamp); ");
}

sub _patch_table_exists {
    my $self = shift;
    $dbFile ||= $self->database_options('name');
    my $is_it = do_system("_silent", "echo",q[.table patches_applied],"|",$Bin{Sqlite},$dbFile,"|","grep -q patches_applied");
    return $is_it ? 1 : 0;
}

sub _dump_patch_table {
    my $self = shift;
    my %args = @_;
    my $filename = $args{outfile} or Carp::confess "need a filename";
    debug "dumping patches into $filename";
    $self->_do_sqlite_into_file($filename,"select patch_name,patch_md5 from patches_applied order by patch_name;");
}

sub _remove_patches_applied_table {
    my $self = shift;
    $self->_do_sqlite("drop table if exists patches_applied;");
}

sub _start_new_db {
    # Make a new empty database file, return the name of the file.
    my $self = shift;
    $dbFile = File::Temp->new(UNLINK => 0);
    $dbFile->close;
    return "$dbFile";
}

sub _do_sql_file {
    my $self = shift;
    my $filename = shift;
    my $outfile = shift;  # optional output file
    Carp::confess "dbFile is not defined" unless defined($dbFile);
    do_system( $Bin{Sqlite}, $dbFile, "<", $filename,
        ( $outfile ? ( ">", $outfile ) : () ) );
}

sub _do_sqlite {
    my $self = shift;
    my $sql = shift;
    my $tmp = File::Temp->new(TEMPLATE => "tmp_db_XXXX", SUFFIX => '.sql');
    print $tmp ".header off\n";
    print $tmp ".mode list\n";
    print $tmp ".separator ' '\n";
    print $tmp $sql;
    $tmp->close;
    my $ret = $self->_do_sql_file("$tmp", @_);  # pass @_ which may have an $outfile
    $tmp->unlink_on_destroy($ret);
    $ret;
}

sub _do_sqlite_into_file {
    my $self = shift;
    my $filename = shift;
    my $sql      = shift;
    debug "doing $sql";
    $self->_do_sqlite($sql,$filename);
}

sub _do_sqlite_getlines {
    my $self = shift;
    my $sql      = shift;
    my $filename = tempdir(CLEANUP=>1)->file("tmp.sql");
    debug "doing $sql";
    $self->_do_sqlite($sql,$filename);
    my @result = $filename->slurp;
    return @result;
}

sub _apply_base_sql {
    my $self = shift;
    my $filename = shift || $self->base_dir."/db/dist/base.sql";
    return unless -e $filename;
    info "applying base.sql";
    $self->_do_sql_file($filename);
}

sub _apply_base_data {
    my $self = shift;
    my $filename = shift || $self->base_dir."/db/dist/base_data.sql";
    return unless -e $filename;
    info "applying base_data.sql";
    $self->_do_sql_file($filename);
}

sub _apply_patch {
    my $self = shift;
    my $patch_file = shift;

    return $self->_do_sql_file($self->base_dir."/db/patches/$patch_file");
}

sub _dump_base_sql {
    my $self = shift;

    $dbFile ||= $self->database_options('name');

    # Optional parameter "outfile" gives the name of the file into which to dump the schema.
    # If the parameter is omitted, dump and atomically rename to db/dist/base.sql.
    my %args = @_;
    my $outfile = $args{outfile} || $self->base_dir. "/db/dist/base.sql";

    my $tmpfile = File::Temp->new(
        TEMPLATE => (dirname $outfile)."/dump_XXXXXX",
        UNLINK   => 0
    );
    $tmpfile->close;

    debug "dumping base sql";
    $self->_do_sqlite(qq[.output $tmpfile\n.schema\n.exit\n]);
    rename "$tmpfile", $outfile or die "rename failed: $!";
}

sub _dump_base_data {
    my $self = shift;
    my %args = @_;
    my $outfile = $args{outfile} || $self->base_dir. "/db/dist/base_data.sql";

    $dbFile ||= $self->database_options('name');

    my $tmpfile = File::Temp->new(
        TEMPLATE => (dirname $outfile)."/dump_XXXXXX",
        UNLINK   => 1,
    );
    debug "dumping base_data.sql";

    my ($tables) = $self->_do_sqlite_getlines(qq[.tables]);
    for my $table (split /\s+/, $tables) {
        my $more = tempdir(CLEANUP => 1)->file("more.sql");
        my $more_safe_fn = $more;
        $more_safe_fn =~ s{\\}{/}g;
        $self->_do_sqlite(qq[.output $more_safe_fn\n.mode insert $table\nselect * from $table;\n.exit\n]);
        $tmpfile->print($_) for $more->slurp;
    }
    copy $tmpfile, $outfile or die "copy failed: $!";
}

sub _stop_db {
   # there's no daemon, yay
}

sub _remove_db {
    return unless defined($dbFile) && -e "$dbFile";
    unlink "$dbFile" or die "Could not unlink $dbFile :$!";
}

=back

=head1 SEE ALSO

See L.

=cut

1;