App-Repository
view release on metacpan or search on metacpan
x add bin/dbget
x add default params and params that don't relate to column names
x fix index hints.
x clean up MySQL explain
x change author email to spadkins@gmail.com
0.963
x add support for qualified classes on a single table (i.e. get_object("person",...)
may return an App::RepositoryObject::Man or an App::RepositoryObject::Woman depending
on the value in the "gender" field)
x add not_in, not_contains, and not_matches operators
x add better implied operations to value-side of params (=, !, !=, >, >=, <=, ~, =~)
x _shutdown_unshareable_resources()
x substitute() on joincriteria
x added automatic timings on all debug_sql
x added explain_sql
x added support for dbsocket option in App::Repository::MySQL
0.962
???
x App::Repository::DBI - add _do($sql) method - same as $db->{dbh}->do($sql) with added debugging features
The "_" reminds you this is not really a portable method in the spirit of the App::Repository abstraction.
It is provided so that you won't be tempted to use the work-around described above.
Any need to use this method is an indication that the API still needs work. Please send feedback to me.
NOTE: _do() works for select as well as insert/update/delete statements, returning the array of rows
x App::ValueDomain::Repository - add extra_values, extra_labels, and order_by
x App::SessionObject::RepositoryObjectSet - enable relevant "columns" to be configured (limits them)
x App::SessionObject::RepositoryObjectDomain - can configure mappings of domain params to individual object set params
x $rep->new_object() calls class-specific (RepositoryObject) _init() method to set up object values
x $rep->new_object() now adds configured "default" values
x $rep->new_object() now throws an exception for NULL values in "not_null" and alternate key columns
x $rep->new_object() has option { temp => 1 } that doesn't create the RepositoryObject in the repository
0.95
x add "config_from_options" as a default behavior for App::Repository::DBI
x add $rep->new_object($table, {@initializers}); (and tests)
x add $repobj->delete(); (and tests)
x add $rep->import_rows(...) (import from file) (handles CSV by default)
x add $rep->export_rows(...) (export to file) (handles CSV by default)
0.94
lib/App/Repository.pm view on Meta::CPAN
&App::sub_entry if ($App::trace);
my ($self, $table, $hash) = @_;
my $table_def = $self->get_table_def($table);
my $column_defs = $table_def->{column};
if ($column_defs) {
foreach my $column (keys %$column_defs) {
if (!defined $hash->{$column}) {
if (defined $column_defs->{$column}{default}) {
$hash->{$column} = $column_defs->{$column}{default};
}
elsif (defined $column_defs->{$column}{not_null}) {
die "Illegal object value for $table: $column cannot be NULL (i.e. undef)";
}
}
}
}
my $primary_key = $table_def->{primary_key};
if ($primary_key) {
# Watch out for auto-generated primary keys. It's OK for them to be NULL.
#if ($#$primary_key > 0) {
# foreach my $column (@$primary_key) {
lib/App/Repository/DBI.pm view on Meta::CPAN
my ($tabledef, $tabcols, $alias, $dbexpr);
my $dbh = $self->{dbh};
$tabledef = $self->{table}{$table};
$alias = $tabledef->{alias};
$tabcols = $tabledef->{column};
my %sqlop = (
"contains" => "like",
"matches" => "like",
"not_contains" => "not like",
"not_matches" => "not like",
"eq" => "=",
"ne" => "!=",
"le" => "<=",
"lt" => "<",
"ge" => ">=",
"gt" => ">",
"in" => "in",
"not_in" => "not in",
);
my %repop = (
"=~" => "contains",
"~" => "contains",
"!~" => "not_contains",
"==" => "eq",
"=" => "eq",
"!" => "ne",
"!=" => "ne",
"<=" => "le",
"<" => "lt",
">=" => "ge",
">" => "gt",
"=/" => "regexp",
"/" => "regexp",
"!/" => "not_regexp",
);
$where = "";
$params = {} if (!$params);
my $param_order = $params->{"_order"};
if (!defined $param_order && ref($params) eq "HASH") {
$param_order = [ (keys %$params) ];
}
if (defined $param_order && $#$param_order > -1) {
my ($include_null, $inferred_op, @where);
lib/App/Repository/DBI.pm view on Meta::CPAN
$quoted = (defined $column_def->{quoted}) ? ($column_def->{quoted}) : ($value !~ /^-?[0-9.,]+$/);
}
else {
$quoted = (defined $column_def->{quoted}) ? ($column_def->{quoted}) : ($value !~ /^-?[0-9.]+$/);
}
next if ($inferred_op && !$quoted && $value eq "");
$include_null = 0;
if ($repop eq "contains" || $repop eq "not_contains") {
$value = $dbh->quote("%" . $value . "%");
}
elsif ($repop eq "matches" || $repop eq "not_matches") {
$value = $dbh->quote($value);
$value =~ s/_/\\_/g;
$value =~ s/\*/%/g;
$value =~ s/\?/_/g;
}
elsif ($sqlop eq "in" || ($inferred_op && $sqlop eq "=")) {
if (! defined $value || $value eq "NULL") {
$sqlop = "is";
$value = "null";
}
lib/App/Repository/DBI.pm view on Meta::CPAN
############################################################
# create initial where conditions for the selected rows
############################################################
#print $App::DEBUG_FILE $self->{context}->dump(), "\n";
my %sqlop = (
"contains" => "like",
"matches" => "like",
"not_contains" => "not like",
"not_matches" => "not like",
"eq" => "=",
"ne" => "!=",
"le" => "<=",
"lt" => "<",
"ge" => ">=",
"gt" => ">",
"in" => "in",
"not_in" => "not in",
);
my %repop = (
"=~" => "contains",
"~" => "contains",
"!~" => "not_contains",
"==" => "eq",
"=" => "eq",
"!" => "ne",
"!=" => "ne",
"<=" => "le",
"<" => "lt",
">=" => "ge",
">" => "gt",
);
lib/App/Repository/DBI.pm view on Meta::CPAN
}
elsif ($value =~ /,/ && ! $table_def->{param}{$param}{no_auto_in_param}) {
$quoted = (defined $column_def->{quoted}) ? ($column_def->{quoted}) : ($value !~ /^-?[0-9.,]+$/);
}
else {
$quoted = (defined $column_def->{quoted}) ? ($column_def->{quoted}) : ($value !~ /^-?[0-9.]+$/);
}
next if ($inferred_op && !$quoted && $value eq "");
if ($repop eq "contains" || $repop eq "not_contains") {
$value = $dbh->quote("%" . $value . "%");
}
elsif ($repop eq "matches" || $repop eq "not_matches") {
$value = $dbh->quote($value);
$value =~ s/_/\\_/g;
$value =~ s/\*/%/g;
$value =~ s/\?/_/g;
}
elsif ($sqlop eq "in" || ($inferred_op && $sqlop eq "=")) {
if (! defined $value || $value eq "NULL") {
$sqlop = "is";
$value = "null";
t/DBI-getset.t view on Meta::CPAN
$hashes = $rep->get_hashes("test_person", {state => "GA"});
is($#$hashes+1, 5, "get_hashes(GA)");
$hashes = $rep->get_hashes("test_person", {state => "GA,NULL"});
is($#$hashes+1, 6, "get_hashes(GA,NULL)");
$hashes = $rep->get_hashes("test_person", {state => "!GA,NULL"});
is($#$hashes+1, 2, "get_hashes(!GA,NULL)");
$hashes = $rep->get_hashes("test_person", {state => "GA,CA"});
is($#$hashes+1, 6, "get_hashes(GA,CA)");
$hashes = $rep->get_hashes("test_person", {state => "!GA,CA"});
is($#$hashes+1, 1, "get_hashes(!GA,CA)");
$hashes = $rep->get_hashes("test_person", {"state.not_in" => ["GA","CA"]});
is($#$hashes+1, 1, "get_hashes not_in [GA,CA]");
$hashes = $rep->get_hashes("test_person", {"state.not_in" => "GA,CA"});
is($#$hashes+1, 1, "get_hashes not_in (GA,CA)");
$hashes = $rep->get_hashes("test_person", {"state.in" => "!GA,CA"});
is($#$hashes+1, 1, "get_hashes in (!GA,CA)");
$hashes = $rep->get_hashes("test_person", {"state.eq" => "!GA,CA"});
is($#$hashes+1, 0, "get_hashes eq (!GA,CA)");
$hashes = $rep->get_hashes("test_person", {"state.contains" => "A"});
is($#$hashes+1, 6, "get_hashes contains (A)");
$hashes = $rep->get_hashes("test_person", {"state.not_contains" => "A"});
is($#$hashes+1, 1, "get_hashes not_contains (A)");
$hashes = $rep->get_hashes("test_person", {"state.matches" => "?A"});
is($#$hashes+1, 6, "get_hashes matches (?A)");
$hashes = $rep->get_hashes("test_person", {"state" => "?A"});
is($#$hashes+1, 6, "get_hashes (?A)");
$hashes = $rep->get_hashes("test_person", {"state.not_matches" => "?A"});
is($#$hashes+1, 1, "get_hashes not_matches (?A)");
#print $rep->{sql};
#####################################################################
# dbexpr with substitutions
#####################################################################
my ($years_older);
$years_older = $rep->get("test_person", {person_id => 1}, "years_older");
is($years_older, 41, "get() years_older [$years_older] base_age is undef");
$years_older = $rep->get("test_person", {person_id => 1, base_age => 20}, "years_older");
t/DBI-select.t view on Meta::CPAN
$expect_sql = <<EOF;
select
first_name
from test_person
where first_name not like '%s%'
and age not like '%3%'
and birth_dt not like '%1962%'
EOF
$sql = $rep->_mk_select_sql("test_person",{
"_order" => [ "first_name.not_contains", "age.not_contains", "birth_dt.not_contains", ],
"first_name.not_contains" => "s",
"age.not_contains" => "3",
"birth_dt.not_contains" => "1962",
},["first_name"]);
is($sql, $expect_sql, "_mk_select_sql(): param.contains");
&check_select($sql,0);
$sql = $rep->_mk_select_sql("test_person",{
"_order" => [ "first_name", "age", "birth_dt", ],
"first_name" => "!~s",
"age" => "!~3",
"birth_dt" => "!~1962",
},["first_name"]);
is($sql, $expect_sql, "_mk_select_sql(): param.not_contains (inferred)");
&check_select($sql,0);
$expect_sql = <<EOF;
select
first_name
from test_person
where first_name like '%s%e_'
and age like '%3'
and birth_dt like '1962\\_%'
EOF
t/DBI-select.t view on Meta::CPAN
$expect_sql = <<EOF;
select
first_name
from test_person
where first_name not like '%s%'
and age not like '%3'
and birth_dt not like '1962%'
EOF
$sql = $rep->_mk_select_sql("test_person",{
"_order" => [ "first_name.not_matches", "age.not_matches", "birth_dt.not_matches", ],
"first_name.not_matches" => "*s*",
"age.not_matches" => "*3",
"birth_dt.not_matches" => "1962*",
},["first_name"]);
is($sql, $expect_sql, "_mk_select_sql(): param.not_matches");
&check_select($sql,0);
# this doesn't work yet, but that's ok
#$sql = $rep->_mk_select_sql("test_person",{
# "_order" => [ "first_name", "age", "birth_dt", ],
# "first_name" => "!*s*",
# "age" => "!*3",
# "birth_dt" => "!1962*",
# },["first_name"]);
#is($sql, $expect_sql, "_mk_select_sql(): param.not_matches (inferred)");
#&check_select($sql,0);
$expect_sql = <<EOF;
select
first_name,
last_name,
age
from test_person
where age >= 37
limit 1
t/DBI-select.t view on Meta::CPAN
$expect_sql = <<EOF;
select
gender
from test_person
where (first_name not in ('stephen','keith') and first_name is not null)
EOF
$sql = $rep->_mk_select_sql("test_person", { first_name => "!stephen,keith,NULL", }, ["gender"]);
is($sql, $expect_sql, "_mk_select_sql(): not in and not null (by '!stephen,keith,NULL')");
&check_select($sql,0);
$sql = $rep->_mk_select_sql("test_person", { "first_name.not_in" => "stephen,keith,NULL", }, ["gender"]);
is($sql, $expect_sql, "_mk_select_sql(): is not null (by .not_in 'stephen,keith,NULL')");
&check_select($sql,0);
$expect_sql = <<'EOF';
select
first_name
from test_person
where first_name like '%\'%'
and birth_dt like '%\\\'_'
EOF
#print "[$expect_sql]\n";
t/DBI-select.t view on Meta::CPAN
t1.age
from test_person
where not (not(age > 14)
and not (first_name like '%A%')
and not (state in ('GA','CA') and
age <= 2))
EOF
&test_get_rows($expect_sql, 0, "_mk_select_joined_sql(): ordercols, directions",
"test_person",
["_not", age => ">14",
["_not_or", first_name => "*A*"],
["_not_and", state => ["GA","CA"], "age.le" => 2]],
["first_name","state","age"]);
$sql = $rep->_mk_select_sql("test_person",
[age => ">14", first_name => "*A*"],
["first_name","state","age"]);
is($sql, $expect_sql, "_mk_select_sql(): verbatim");
&check_select($sql,0);
&test_get_rows($expect_sql,0,"_mk_select_joined_sql(): 1 col as array, no params","test_person",{},["age"]);
$expect_sql = <<EOF;
( run in 0.267 second using v1.01-cache-2.11-cpan-0a987023a57 )