[Milan-pm] Actual status of smartSelect
marcos rebelo
oleber at gmail.com
Sat Oct 23 07:05:00 PDT 2010
#######################################################
package SmartSelect;
use strict;
use warnings;
use re 'eval';
our $VERSION = '0.0.1';
use Carp qw(confess);
use Data::Dumper;
sub new {
my ($pkg, $dbh) = @_;
return bless({'dbh' => $dbh, 'db_struct' => {}}, $pkg);
}
sub get_dbh { return shift->{'dbh'} }
sub get_db_struct { return shift->{'db_struct'}}
our $AUTOLOAD;
sub AUTOLOAD {
my ($self, @constrains) = @_;
my $method = $AUTOLOAD;
$method =~ s/.*::(.*)/$1/;
return if $method eq 'DESTROY';
my $closure;
$closure = shift(@constrains) if @constrains and
ref($constrains[0]) eq 'CODE';
my $hash_args;
$hash_args = shift(@constrains) if @constrains and
ref($constrains[0]) eq 'HASH';
local $self->get_dbh->{'RaiseError'} = 1;
my ($sql, $action) = @{$self->_parse($method, scalar @constrains)};
confess("Closure just accepted in execute") if $closure and
$action ne 'EXECUTE';
confess("Hash just accepted in update or insert") if $hash_args
and $action ne 'UPDATE' and $action ne 'INSERT';
if ( $action eq 'DELETE') {
return $self->get_dbh->do($sql, undef, @constrains);
} elsif ( $action eq 'UPDATE') {
my $values_to_set = join(", ", map { "$_ = ?"} keys %{$hash_args});
$sql =~ s/<#>/SET $values_to_set/;
return $self->get_dbh->do($sql, undef, values(%{$hash_args}),
@constrains);
} elsif ( $action eq 'INSERT') {
my $values = join(", ", map { "?" } keys %{$hash_args});
my $names = join(", ", map { $_ } keys %{$hash_args});
$sql = "$sql ($names) VALUES ( $values )";
return $self->get_dbh->do($sql, undef, values(%{$hash_args}));
} else {
my $sth = $self->get_dbh->prepare($sql);
my $rs = $sth->execute(@constrains);
my @rows;
while ( my $row = $sth->fetchrow_hashref ) {
if ($action eq 'EXECUTE') {
local $_ = $row;
push(@rows, $closure->($row));
} else {
push(@rows, $row);
}
}
return \@rows;
}
}
sub _parse {
my ($self, $text, $count) = @_;
my $self_db_struct = $self->get_db_struct;
if ( not keys %{$self_db_struct}) {
my $sth = $self->get_dbh->table_info;
while ( my $row = $sth->fetchrow_hashref) {
if ($row->{'TABLE_TYPE'} eq 'TABLE' or
$row->{'TABLE_TYPE'} eq 'VIEW') {
$self_db_struct->{$row->{'TABLE_NAME'}} = undef;
}
}
}
my @tables = keys %{$self_db_struct};
my $re_tables = '(?:' . join( '|', @tables ) . ')';
my ($action, $table, $constraints, @used_columns) = do {
my $re_columns;
local *closure = sub {
my ($action, $table) = @_;
$re_columns = ($action eq 'insert') ? "" :
$self->_regexp_for_table($table, $count);
return $re_columns;
};
my $extra_re = $count ? qr/(?:_by_((??{closure($1, $2)})))/ : qr//;
my $full_re =
qr/^(select|execute|delete|update|insert)_($re_tables)$extra_re$/;
{ # I don't know why but I need the next line
$text =~ $full_re;
}
my @table_info = ($text =~ $full_re);
my @column_info = ( $count and @table_info ) ? (
$table_info[-1] =~ /^$re_columns$/ ) : ();
(@table_info, @column_info);
};
confess "No match for '$text' with $count columns" if not defined $table;
$action = uc $action;
my $sql =
$action eq 'DELETE' ? "DELETE FROM $table"
: $action eq 'UPDATE' ? "UPDATE $table <#>"
: $action eq 'INSERT' ? "INSERT INTO $table"
: "SELECT * FROM $table";
if ( $count ) {
$sql = "$sql WHERE " . join(' AND ', map {"$_ = ?"} @used_columns);
}
return [$sql, $action];
}
sub _regexp_for_table {
my ($self, $table, $column_count) = @_;
my $self_db_struct = $self->get_db_struct;
if ( not defined $self_db_struct->{$table} ) {
@{$self_db_struct->{$table}} = keys
%{$self->get_dbh->column_info( undef, undef, $table, undef
)->fetchall_hashref('COLUMN_NAME')};
}
my @columns = @{$self_db_struct->{$table}};
my $re_column = '(?:' . join('|', @columns) . ')';
my $re_columns = join('_', map { "($re_column)" } 1 .. $column_count);
return qr/$re_columns/;
}
1;
#######################################################
and its tests
#######################################################
#!perl
use strict;
use warnings;
use Test::More;
use Test::Exception;
use Test::Deep;
use Data::Dumper;
use DBI;
use Readonly 'Readonly';
Readonly my $PKG => 'SmartSelect';
use File::Temp 'tempdir';
my $tempdir = tempdir('CLEANUP' => 1);
my $tempdb = "$tempdir/db.sqlite";
my $dbh = DBI->connect("dbi:SQLite:dbname=:memory:","","");
$dbh->do('CREATE TABLE document (id, name)');
$dbh->do('INSERT INTO document(id, name) VALUES (?, ?)', undef,
'doc1', 'document 1');
$dbh->do('INSERT INTO document(id, name) VALUES (?, ?)', undef,
'doc2', 'document 2');
$dbh->do('CREATE TABLE person (id, name, country)');
$dbh->do('INSERT INTO person(id, name, country) VALUES (?, ?, ?)',
undef, 'p1', 'John', 'USA');
$dbh->do('INSERT INTO person(id, name, country) VALUES (?, ?, ?)',
undef, 'p2', 'Marcos', 'PT');
$dbh->do('INSERT INTO person(id, name, country) VALUES (?, ?, ?)',
undef, 'p3', 'Maria', 'PT');
$dbh->do("CREATE VIEW portuguese_person AS SELECT * FROM person WHERE
country = 'PT'") or die $dbh->err;
use_ok($PKG);
my $obj = $PKG->new($dbh);
isa_ok($obj, $PKG);
isa_ok($obj, 'SmartSelect');
is_deeply( $obj->get_db_struct, {}, 'db_struct correctly started');
can_ok($obj, '_parse');
cmp_deeply($obj->_parse('select_document', 0), ['SELECT * FROM
document', 'SELECT'], 'select all table');
cmp_deeply($obj->get_db_struct, { 'document' => undef, 'person' =>
undef, 'portuguese_person' => undef }, 'db_struct correctly created');
throws_ok { $obj->_parse('select_other', 0) } qr/No match for
'select_other' with 0 columns at /, 'Fail with unreconizable table';
throws_ok { $obj->_parse('select_document', 1) } qr/No match for
'select_document' with 1 columns at /, 'Fail expecting 1 column';
throws_ok { $obj->_parse('select_person_by_id', 0) } qr/No match for
'select_person_by_id' with 0 columns at /, 'Fail expecting no column';
cmp_deeply($obj->_parse('execute_person_by_id', 1), ['SELECT * FROM
person WHERE id = ?', 'EXECUTE'], 'select by id');
cmp_deeply($obj->_parse('select_person_by_name_id', 2), ['SELECT *
FROM person WHERE name = ? AND id = ?', 'SELECT'], 'select by name
id');
cmp_deeply($obj->get_db_struct, { 'document' => undef, 'person' =>
bag('id', 'name', 'country'), 'portuguese_person' => undef },
'db_struct correctly maintained');
cmp_deeply($obj->_parse('select_portuguese_person_by_id', 1), ['SELECT
* FROM portuguese_person WHERE id = ?', 'SELECT'], 'select by name
id');
cmp_deeply($obj->get_db_struct, { 'document' => undef, 'person' =>
bag('id', 'name', 'country'), 'portuguese_person' => bag('id', 'name',
'country') }, 'db_struct correctly maintained');
throws_ok { $obj->_parse('select_document_by_country', 1) } qr/No
match for 'select_document_by_country' with 1 columns at /, 'Fail with
unrecognizable column';
cmp_deeply($obj->get_db_struct, { 'document' => bag('id', 'name'),
'person' => bag('id', 'name', 'country'), 'portuguese_person' =>
bag('id', 'name', 'country') }, 'db_struct correctly maintained');
cmp_deeply($obj->_parse('delete_person', 0), ['DELETE FROM person',
'DELETE'], '_parse delete_person');
cmp_deeply($obj->_parse('delete_person_by_id', 1), ['DELETE FROM
person WHERE id = ?', 'DELETE'], '_parse delete_person_by_id');
cmp_deeply($obj->_parse('update_person', 0), ['UPDATE person <#>',
'UPDATE'], '_parse update_person');
cmp_deeply($obj->_parse('update_person_by_id', 1), ['UPDATE person <#>
WHERE id = ?', 'UPDATE'], '_parse update_person_by_id');
cmp_deeply($obj->_parse('insert_person', 0), ['INSERT INTO person',
'INSERT'], '_parse insert_person');
throws_ok { $obj->_parse('insert_person_by_id', 1) } qr/No match for
'insert_person_by_id' with 1 columns/;
cmp_deeply(
$obj->select_document_by_id('doc2'),
[{'id' => 'doc2', 'name' => 'document 2'}],
'1 record selected in document'
);
cmp_deeply(
$obj->select_document,
bag(
{'id' => 'doc1', 'name' => 'document 1'},
{'id' => 'doc2', 'name' => 'document 2'}
),
'2 record selected in document'
);
cmp_deeply($obj->execute_person_by_country(
sub {
is($dbh->{'RaiseError'}, 1, 'RaiseError activated');
return shift->{'name'};
}, 'PT'),
bag('Marcos', 'Maria'),
'execute with parameter in closure');
{
my @names;
$obj->execute_person_by_country(sub {push(@names, shift->{'name'})}, 'PT');
cmp_deeply(\@names, bag('Marcos', 'Maria'), 'execute with parameter in \$_');
}
throws_ok
{ $obj->select_person_by_country(sub {}, 'PT') }
qr/Closure just accepted in execute at /, 'Fail with Closure in SELECT';
throws_ok
{ $obj->update_person_by_country(sub {}, 'PT') }
qr/Closure just accepted in execute at /, 'Fail with Closure in UPDATE';
throws_ok
{ $obj->delete_person_by_country(sub {}, 'PT') }
qr/Closure just accepted in execute at /, 'Fail with Closure in DELETE';
throws_ok
{ $obj->select_person_by_country({}, 'PT') }
qr/Hash just accepted in update or insert at /, 'Fail with Hash in SELECT';
throws_ok
{ $obj->execute_person_by_country({}, 'PT') }
qr/Hash just accepted in update or insert at /, 'Fail with Hash in EXECUTE';
throws_ok
{ $obj->delete_person_by_country({}, 'PT') }
qr/Hash just accepted in update or insert at /, 'Fail with Hash in DELETE';
{
local $dbh->{'PrintError'} = 0;
local $obj->get_db_struct->{'document'} = ['pippo'];
throws_ok {$obj->select_document_by_pippo('PT')} qr/prepare/;
}
{
is($obj->delete_person_by_country('PT'), 2, 'Delete returned the
number of deleted rows');
cmp_deeply($obj->select_person,[{'id' => 'p1', 'name' => 'John',
'country' => 'USA'}], 'Delete deleted the rows');
}
{
$obj->insert_person({'id' => 'p2', 'name' => 'Marcos', 'country' => 'PT'});
$obj->insert_person({'id' => 'p3', 'name' => 'Maria', 'country' => 'PT'});
cmp_deeply(
$obj->select_person,
bag(
{'id' => 'p1', 'name' => 'John', 'country' => 'USA'},
{'id' => 'p2', 'name' => 'Marcos', 'country' => 'PT'} ,
{'id' => 'p3', 'name' => 'Maria', 'country' => 'PT'}),
'UPDATE updated the rows');
}
{
is($obj->update_person_by_country({'country' => 'IT'} , 'PT'), 2,
'UPDATE returned the number of deleted rows');
cmp_deeply(
$obj->select_person,
bag(
{'id' => 'p1', 'name' => 'John', 'country' => 'USA'},
{'id' => 'p2', 'name' => 'Marcos', 'country' => 'IT'} ,
{'id' => 'p3', 'name' => 'Maria', 'country' => 'IT'}),
'UPDATE updated the rows');
}
done_testing;
--
Marcos Rebelo
http://oleber.freehostia.com
Milan Perl Mongers leader http://milan.pm.org
Webmaster of http://perl5notebook.oleber.com
More information about the Milan-pm
mailing list