The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use warnings;
use strict;
use utf8;
use open qw(:std :utf8);
use lib qw(lib ../lib);

use Test::More tests    => 67;
use Encode qw(decode encode);


BEGIN {
    # Подготовка объекта тестирования для работы с utf8
    my $builder = Test::More->builder;
    binmode $builder->output,         ":utf8";
    binmode $builder->failure_output, ":utf8";
    binmode $builder->todo_output,    ":utf8";

    note "************* DBIx::DR *************";
    use_ok 'DBIx::DR';
    use_ok 'DBD::SQLite';
    use_ok 'File::Temp', 'tempdir';
    use_ok 'File::Path', 'remove_tree';
    use_ok 'File::Spec::Functions', 'catfile', 'rel2abs';
    use_ok 'File::Basename', 'dirname', 'basename';
}

my $temp_dir = tempdir;
END {
    remove_tree $temp_dir, { verbose => 0 };
    ok !-d $temp_dir, "Temporary dir was removed: $temp_dir";
}
my $test_dir = catfile(dirname($0), 'sql');
ok -d $test_dir, 'Directory contained sqls is found: ' . $test_dir;

ok -d $temp_dir, "Temporary directory was created: $temp_dir";
my $db_file = "$temp_dir/db.sqlite";

my $dbh = DBIx::DR->connect(
    "dbi:SQLite:dbname=$db_file", '', '',
    {
            dr_sql_dir => $test_dir,
            RaiseError      => 1,
            PrintError      => 0,
            PrintWarn       => 0,
    });

isa_ok $dbh => 'DBIx::DR::db', 'Connector was created';
ok -r $db_file, 'Database file was created';

ok $dbh->{'private_DBIx::DR_iterator'} eq 'dbix-dr-iterator#new',
    'Default iterator class';
ok $dbh->{'private_DBIx::DR_item'} eq 'dbix-dr-iterator-item#new',
    'Default item class';

my $res = $dbh->perform(q{
        CREATE TABLE tbl (id INTEGER PRIMARY KEY, value CARCHAR(32))
    }
);
is $res, '0E0', 'Table tbl was created';

my @values = (1, 2, 3, 4, 6, 'abc', 'def');
for(@values) {
    $res = $dbh->perform(
        'INSERT INTO tbl (value) VALUES (<%= $value %>)',
        value  => $_
    );

    ok $res && $res ne '0E0', 'Array item was inserted';
}

$res = $dbh->perform(q[
        UPDATE
            tbl
        SET
            value = value || <%= $suffix %>
        WHERE
            id > <%= $id_limit %>
    ],
    suffix => '_suffix',
    id_limit => 2
);


ok $res == @values - 2, 'Updated was passed';

$res = $dbh->select('SELECT * FROM tbl');
isa_ok $res => 'DBIx::DR::Iterator', 'A few rows were fetched';
ok $res->count == @values, 'Rows count has well value';
while(my $v = $res->next) {
    ok $v->id > 0, 'Record identifier: ' . $v->id;
    if ($v->id > 2) {
        ok $v->value eq $values[ $v->id - 1 ] . '_suffix',
            'Record value: ' . $v->value;
    } else {
        ok $v->value eq $values[ $v->id - 1 ], 'Record value: ' . $v->value;
    }
}



my $select_file = catfile $test_dir, 'select_ids.sql.ep';
ok -r $select_file, 'select.sql is found';

my $w;
eval {
    local $SIG{__WARN__} = sub { $w = shift };
    $dbh->select(
        -f          => 'select_ids',
        ids         => [ 1, 2 ],
        -hash       => 'id',
        -item       => 'my_item_package#new',
        -iterator   => 'my_iterator_package#new',
        -die        => 1,
        -warn       => 1,
    )
};

like $@, qr{SELECT}, '-die statement';
like $w, qr{SELECT}, '-warn statement';

$res = $dbh->select(
    -f          => 'select_ids',
    ids         => [ 1, 2 ],
    -hash       => 'id',
    -item       => 'my_item_package#new',
    -iterator   => 'my_iterator_package#new'
);

ok 'HASH' eq ref $res->{fetch}, 'SELECT was done';
ok $res->count == 2, 'Rows count has well value';
ok $res->get(1)->value eq $values[0], 'First item';
ok $res->get(2)->value eq $values[1], 'Second item';

$res = $dbh->select(
    -f          => rel2abs($select_file),
    ids         => [ 1, 2 ],
    -hash       => 'id',
    -item       => 'my_item_package#new',
    -iterator   => 'my_iterator_package#new'
);
isa_ok $res => 'MyIteratorPackage', 'Repeat sql from file';
ok $res->count == 2, 'Rows count has well value';

my @a = sort { $a->id <=> $b->id } $res->all;
ok @a == $res->count, 'Rows count has well value';
is $a[0]->value, $values[0], 'First item';
is $a[1]->value, $values[1], 'Second item';


$res = $dbh->single('SELECT * FROM tbl WHERE id = <%= $id %>', id => 1);
ok $res, 'Select one exists row';
ok $res->id == 1, 'Identifier';
ok $res->value eq $values[0], 'Value';


$res = $dbh->single('SELECT * FROM tbl WHERE id = <%= $id %>', id => 5000);
ok !$res, 'No results';


$dbh->set_helper(
    foo => sub { 'foo' },
    bar => sub { $_[0]->call_helper('foo') . 'bar' },
);

$res = $dbh->single('SELECT <%= foo %> AS foo');
ok $res->foo eq 'foo', 'User helper';

$res = $dbh->single('SELECT <%= bar %> AS bar');
ok $res->bar eq 'foobar', 'User helper (call the other helper)';


$res = eval { $dbh->perform(-f => 'unknown_function') };
my $e = $@ // '';
ok $e, 'Exception';
my ($line) = $e =~ /unknown_function\.sql\.ep\s+line\s+(\d+)/;
diag $e unless ok $line, '"at line" is present';

my $fname = catfile($test_dir, 'unknown_function.sql.ep');
ok -f $fname, $fname;
open my $fh, '<', $fname;
my @lines = <$fh>;
my ($line_real) = grep { $lines[$_] =~ /UNKNOWN_FUNCTION/ } 0 .. $#lines;
$line_real++;
cmp_ok $line, '==', $line_real, 'Exception point';


package MyItemPackage;
use base 'DBIx::DR::Iterator::Item';
use Test::More;

sub value {
    my ($self) = @_;
    ok @_ == 1, 'Get item value';
    return $self->SUPER::value;
}

package MyIteratorPackage;
use base 'DBIx::DR::Iterator';
use Test::More;

sub count {
    my ($self) = @_;
    ok @_ == 1, 'Get iterator size';
    return $self->SUPER::count;
}

=head1 COPYRIGHT

 Copyright (C) 2011 Dmitry E. Oboukhov <unera@debian.org>
 Copyright (C) 2011 Roman V. Nikolaev <rshadow@rambler.ru>

 This program is free software, you can redistribute it and/or
 modify it under the terms of the Artistic License.

=cut