The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Test::DBICx::Modeler::Generator::SQLite;


# ****************************************************************
# pragma(s)
# ****************************************************************

use strict;
use warnings;


# ****************************************************************
# base class(es)
# ****************************************************************

use base qw(
    Test::DBICx::Modeler::Generator
);


# ****************************************************************
# general dependency(-ies)
# ****************************************************************

use DBI;
use List::MoreUtils qw(all apply uniq);
use Path::Class;
use Test::Moose;
use Test::More;
use Test::Requires {
    'DBD::SQLite' => 0,
};


# ****************************************************************
# class variable(s)
# ****************************************************************

our $With_Foreign_Key = 1;


# ****************************************************************
# accessor(s) of class variable(s)
# ****************************************************************

sub with_foreign_key {
    $With_Foreign_Key = $_[1]
        if scalar @_ == 2;

    return $With_Foreign_Key;
}


# ****************************************************************
# test(s)
# ****************************************************************

sub _has_means {
    ! system('sqlite3 --version');
}

sub _get_driver_class {
    return 'DBICx::Modeler::Generator::Driver::SQLite';
}

sub _get_special_literals {
    my $self = shift;

    $self->_set_script_extension;

    return $self->_can_support_foreign_keys ? (
        '/Path/script_extension' => $self->{script_extension},
    ) : ();
}

sub _set_script_extension {
    my $self = shift;

    $self->{script_extension}
        = $self->_can_support_foreign_keys ? '_sqlite_with_fk.sql'
        :                                    '.sql';

    return;
}

sub _connect_database {
    my $self = shift;

    $self->{db_file} = $self->{examples}->file('myapp.db')->relative;
    $self->{connect_info} = [
        'dbi:SQLite:dbname=' . $self->{db_file}->stringify,
        undef,
        undef,
        {
            PrintWarn  => 0,
            PrintError => 0,
        }
    ];
    my $dbh = DBI->connect(@{ $self->{connect_info} });
    if (defined $dbh) {
        if ($self->_can_support_foreign_keys) {
            $dbh->do('PRAGMA foreign_keys = ON')
                or $self->BAILOUT($dbh->errstr);
        }
        $self->{dbh} = $dbh;
    }

    return;
}

sub _test_path_of_creation_script {
    my ($self, $path, $source_library) = @_;

    is $path->module_extension,
        '.pm'
            => 'path: module_extension ok';
    is $path->script_extension,
        $self->{script_extension}
            => 'path: script_extension ok';
    is $path->creation_script->stringify,
        $source_library->parent->file(
            'myapp' . $self->{script_extension}
        )->stringify
            => 'path: creation_script ok';

    return;
}

sub test_driver : Tests(no_plan) {
    my $self = shift;

    my $driver = $self->{generator}->driver;
    isa_ok $driver, 'DBICx::Modeler::Generator::Driver::SQLite';
    does_ok $driver, 'DBICx::Modeler::Generator::DriverLike';

    is $driver->bin, 'sqlite3'
        => 'driver: bin ok';
    my $database = $self->{db_file}->stringify;
    is file($driver->database)->stringify,
        $database
            => 'driver: database ok';
    is $driver->dbd, 'SQLite'
        => 'driver: dbd ok';
    is $driver->dsn,
        "dbi:SQLite:dbname=$database"
            => 'driver: dsn ok';
    is $driver->extension, '.db'
        => 'driver: extension ok';
    is_deeply [$driver->host], [undef]
        => 'driver: host ok';
    is_deeply [$driver->username], [undef]
        => 'driver: username ok';
    is_deeply [$driver->password], [undef]
        => 'driver: password ok';
    is_deeply [$driver->port], [undef]
        => 'driver: port ok';
    my $script = file(
        'examples/src/myapp' . $self->{script_extension}
    )->stringify;
    is $driver->command,
        qq{sqlite3 "$database" < "$script"}
            => 'driver: command ok';

    return;
}

sub _exists_database {
    my $self = shift;

    my %table;
    @table{
        apply {
            s{
                \A
                "main" \.
                "(.+?)"
                \z
            }{$1}xms;
        } uniq (
            $self->{dbh}->tables(undef, 'main')
        )
    } = ();

    return all {
        exists $table{$_};
    } qw(artist cd track);
}

sub _remove_generated_database {
    my $self = shift;

    foreach my $table (qw(track cd artist)) {
        $self->{dbh}->do(sprintf 'DROP TABLE IF EXISTS %s', $table)
            or $self->BAILOUT($self->{dbh}->errstr);
    }

    return;
}

sub _disconnect_database {
    my $self = shift;

    $self->{dbh}->disconnect
        or $self->BAILOUT($self->{dbh}->errstr);
    delete $self->{dbh};

    return;
}

sub _reconnect_database {
    my $self = shift;

    $self->_disconnect_database;
    $self->_connect_database;

    return;
}

sub _can_support_foreign_keys {
    my $self = shift;

    return $self->with_foreign_key
        && DBD::SQLite->VERSION >= 1.26_06;
}

sub _clean_up_database {
    my $self = shift;

    # fixme: could not access to the file because an other process uses it
    # $self->{db_file}->remove
    #     or die $!;
    $self->{db_file}->remove;

    return;
}


# ****************************************************************
# return true
# ****************************************************************

1;
__END__


# ****************************************************************
# POD
# ****************************************************************

=pod

=head1 NAME

Test::DBICx::Modeler::Generator::SQLite - Tests for DBICx::Modeler::Generator::Driver::SQLite

=head1 SYNOPSIS

    package Test::DBICx::Modeler::Generator::Manual::SQLite;

    use base qw(
        Test::DBICx::Modeler::Generator::Manual
        Test::DBICx::Modeler::Generator::SQLite
    );

=head1 DESCRIPTION

This class is a base class of C<Test::DBICx::Modeler::Generator::*::SQLite>.

=head1 AUTHOR

=over 4

=item MORIYA Masaki, alias Gardejo

C<< <moriya at cpan dot org> >>,
L<http://gardejo.org/>

=back

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2009-2010 MORIYA Masaki, alias Gardejo

This module is free software;
you can redistribute it and/or modify it under the same terms as Perl itself.
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>.

The full text of the license can be found in the F<LICENSE> file
included with this distribution.

=cut