NAME
DBIx::Struct - convenience SQL functions with Class::Struct-like row objects
SYNOPSIS
use DBIx::Struct;
DBIx::Struct::connect($data_source, $username, $auth);
my $row = one_row("table", $idField);
print $row->field;
$row->field('new data');
$row->update;
my $rows = all_rows("table", {field => "some data"});
print $rows->[0]->field;
## MORE EXAMPLES
# select columns
my $rows = all_rows(["table_users" =>
-columns => [qw(id email enable avatar)]]);
# Join tables: automatically join - based on foreign keys
# for multi tables too
my $rows = all_rows([
"table_1" =>
-join => "table_2",
-join => "table_3",
-columns => ['table_1.*', 'table_2.field', 'table_3.title as some_alias' ] ],
-where => { 'table_1.date' => {'<=', \"now()" }, 'table_1.is_true' => 1 },
-order_by => "table_2.id",
-limit => 10,
-offset => 0 ,
# you can manipulate with data in callback
# add and modify results on the fly, like this:
sub { +{ delay => $delay += 90, %{ $_->data } } } );
# Select with many params
my $row = one_row( "table_1", { field1 => 'foo', field2 => 'bar' } );
# Some tricks for update...
my $params = { field1 => 'foo', field2 => 'bar', field3 => 'var' };
my $row = one_row( "table_1", { id => $params->{id} } );
$row->$_($params->{$_}) for ( keys %$params );
$row->update;
# ..and insert
my $row = new_row( 'table_1' => hash_ref_slice $params, keys %$params );
DESCRIPTION
Makes SQL queries from Perl data structures. It uses SQL::Abstract module to parse "where" and "order by" structures. It also supports "group by", "having", "limit", "offset" and mapping function. To make actual queries subclass of DBIx::Connector is used. The main purpose of this module is to provide a very easy, simple and efficient interface to database. Internally every row is just an array of values and every accessor knows its offset in that array. This is much more efficient as storing row in hash.
IMPORT
This module can be integrated into some framework that already uses DBIx::Connector. Integration parameters should be passed on first use. These parameters are used for integration:
- connector_module
-
Connector's module name. By default used its own connector.
- connector_constructor
-
Connector's constructor function name. By default is 'new'.
- connector_args
-
Connector's arguments: ($dsn, $user, $password, $connect_attrs)
- connector_object
-
Connector's singleton object. By defaut its own object is used.
- connector_pool
-
Connector's pool object.
- connector_pool_method
-
Connector's pool object's method to retrieve a connector.
- table_classes_namespace
-
Namespace for table classes. By default is 'DBC'.
- query_classes_namespace
-
Namespace for query classes. By default is 'DBQ'.
- connect_timeout
-
Timeout to connect or reconnect to DB for default connector.
- error_class
-
Errors can be reported as strings or as hashes. By default errors reported as strings. To report error as string 'DBIx::Struct::Error::String' is used. There's 'DBIx::Struct::Error::Hash' to receive a structured hash containg keys: result => 'SQLERR', message => $message and probably some others.
This module always exports three functions: one_row()
, all_rows()
and new_row()
. Optionally it can export connector()
- connector's singleton object and hash_ref_slice()
function.
Possible usage:
use DBIx::Struct (
connector_module => 'PEF::Front::Connector',
error_class => 'DBIx::Struct::Error::Hash'
);
use DBIx::Struct qw(connector hash_ref_slice);
use DBIx::Struct;
METHODS
hash_ref_slice($hashref, @keys)
Simple hash slice function before perl-5.20 is widely distributred. It accepts hash reference and array of keys. Exportable. Returns array of key-value pairs.
DBC::Article->delete({hash_ref_slice $req, 'id_article'});
is the same as
DBC::Article->delete({id_article => $req->{id_article}});
And
new_row(
article => hash_ref_slice $req,
qw(title content id_author)
);
is the same as
new_row('article',
title => $req->{title},
content => $req->{content},
id_author => $req->{id_author}
);
connect($data_source, $username, $auth)
This method connects to database or returns already connected connector object. For every table in database there's one corresponding class in DBC:: namespace in CamelCase style after successful connect created. E.g. DBC::ClientData is created for table "client_data". This namespace is configurable.
one_row($table, $abstract_where, $order_by, $limit, $offset)
Selects one row from given table and returns its object.
$table
can be a simple table name, SQL query beginning with "select" and ending with SQL-from clause or array reference to generate SQL from Perl data structures.
For array reference following arguments can be specified:
$table_name
Any scalar without leading '-' means table name
-columns => \@columns
or
-columns => $columns_list
\@columns is a reference to an array of SQL column specifications (i.e. column names, * or table.*, functions, etc.). '*' is by default. If column specification is a scalar reference it will be dereferenced and quoted as a column identifier.
-column => $column
This singular column specification means "direct value": single scalar value for one_row
and array reference of column values for <all_rows>. Example:
my $chat_name = one_row([chat => -column => "name"]);
my $ids_array_ref = all_rows([chat => -column => "id"]);
-count => optional column name or expression
This counts rows. Can be used togeter with -distinct
or -all
. It implicit assumes singular returned column.
my $chat_count = one_row([chat => "-count"]);
my $chat_count = one_row([chat => -count => "-distinct"]);
my $chat_count = one_row([chat => -count => "-all"]);
my $chat_count = one_row([chat => -count => "title"]);
-distinct => optional column list as for B<-columns>.
Without -count
selects only unique rows. With -count
counts only unique rows.
my $row_objects = one_row([chat => -distinct => "name,id"]);
Joining tables.
-left => $table
left [OUTER] join
-right => $table
right [OUTER] join
-join => $table
[INNER] join
-on => $join_condition_string or SQL::Abstract-where search conditions
on($join_condition_string)
-using => $join_condition_string or SQL::Abstract-where search conditions
using($join_field_string)
my $count = one_row([table => "-count"],
{ date => {'>=', \"now() - interval '1 hour'"});
This module is smart enough to determine automatically table connections.
my $name = one_row([client => session => -column => "name"],
{ session_key => $input->{session}});
There are some named paramters can be used together with positional paramaters:
- -distinct
-
Selects only unique rows. This is different from "array reference table description": it takes no
column
expression argument; it can't be "off"; it is possible to return normal row object from table.my $people = all_rows(people => "-distinct");
This statement generates
select distinct * from people
. - -group_by
-
Generates "GROUP BY" SQL-clause
my $row1 = one_row("table", -group_by => "field");
Generates and executes "select * from table group by field" SQL-statement.
my $row2 = one_row("table", -group_by => [qw|field field2|]);
Generates and executes "select * from table group by field, field2" SQL-statement. Returns one row object.
- -having
-
Adds "HAVING" conditions to "GROUP BY"
my $row1 = one_row("table", -group_by => "field", -having => {"length(field)" => {">", 5} } );
- -order_by
-
Generates "ORDER BY" SQL-clause as in SQL::Abstract.
- -where
-
Generates "WHERE" SQL-clause as in SQL::Abstract. If $abstract_where is just a scalar then it is supposed to be a primary key value.
- -limit
- -offset
-
Generates "LIMIT $X OFFSET $Y" SQL-clause.
- -sql
-
Returns generated SQL statement. if value is scalar reference then $statement is assigned to referenced value.
- -dry_run
-
Means don't fetch actual data. Useful with -sql when you only need to get generated statement.
all_rows($table, $abstract_where, $order_by, $limit, $offset)
This is just like previous one_row
but returns array of row objects. It has one more "floating" parameter: you can specify CODE reference in any place and it will be used as "mapping function".
my $rows = all_rows("table",
{ date => {'>=', \"now() - interval '1 hour'"},
sub {$_->filter_timestamp; $_->data});
This anonymous function is called for every row clearing timestamps from microseconds part and converting every row object into anonymous hash.
It's possible to use all_rows()
and one_row()
not only for simple table select but for queries also.
my $count = one_row("select count(*) from table",
{ date => {'>=', \"now() - interval '1 hour'"})
->count;
my $name = one_row("select name from client"
." join session on (id = id_client)",
{ session_key => $input->{session}})
->name;
for_rows($table, $abstract_where, $order_by, $limit, $offset, $item_func)
This function is similar to all_rows
but it doesn't make array of row objects. Instead it calls $item_func
code reference for every selected row in $_
. Returns number of processed rows. $item_func
can be any argument, it is determined as the only code reference in argument list. To stop processing rows return any false value from this function.
my $number_of_rows = for_rows("table",
{ date => {'>=', \"now() - interval '1 hour'"},
sub {say $_->name});
new_row("table", column => $value, column2 => $value2, ...)
Inserts new row into table. Returns row object with set primary columns and passed in new_row
subroutine. If you need to set all columns from table then:
my $row = new_row("table", column => $value);
$row->fetch;
Row object methods
new
Creates new row in the table. This is the same as new_row()
except table name is already known from class name.
my $row = DBC::Table->new(email => 'a@bb.com', password => '12345');
set
Sets values of table columns. Returns object's $self value. Has three forms:
set([...])
-
Sets internal row data.
set({column => $value, ... })
-
Sets column(s) value(s)
set(column => $value, ... )
-
Same as above but without anonymous hash.
This method is useful when you can't use accessors. For example, when you have column name 'new' in your table. Full list of reserved keywords:
- new
- set
- data
- delete
- fetch
- update
- markUpdated
- filter_timestamp
data
Returns values of the row. Has four forms:
data()
-
No parameters means to return all columns in anonymous hash {column => "value", ... }.
data([])
-
Empty array reference means internal row data.
data([qw|column column2|])
-
Non-empty array means array of values for corresponding columns.
data({column => undef, columnt2 => undef})
-
Returns given columns set in anonymous hash {column => "value", ... }.
update
Updates its row or table
update()
-
Updates changed (if any) columns of the row. Returns object's $self value.
update({column => "value"}, $where)
-
Updates table. For example:
DBC::List->update({ref => 33}, {id => 1});
Means
update list ref = ? WHERE ( id = ? )
with bind values 33, 1
markUpdated($column)
Sets "updated" attribute for column. You don't need to use it usually. But sometimes you have to help Perl to understand that deeply located element of JSON hash or array was actually updated.
delete
Deletes the row or rows from the table.
delete()
-
Deletes the row if the row has primary key.
delete($where)
-
deletes row(s) from table. For example:
DBC::List->delete({id => 1});
Means
delete from list WHERE ( id = ? )
with bind value 1
filter_timestamp
Removes microseconds from timestamp columns. Returns object's $self value.
2010-05-19 23:30:01.737126 -> 2010-05-19 23:30:01
fetch
Fetches the whole row data from table. Useful when primary key is known after insert but other columns are set by database. Returns object's $self value.
Accessors
All column names from table except special keywords are accessible via accessors:
my $prim = one_row("prim", 1);
print "payload: " . $prim->payload . "\n";
# new data
$prim->payload("pay never");
$prim->update;
Here $prim->payload("pay never") sets new column value. To store it explicitly call $prim->update. By default update is called on row object destruction. To include a random snippet of SQL verbatim, you specify it as a scalar reference.
$client->bonus(\"bonus + 10");
Or with parameters:
$client->bonus([\"bonus + ?", 10]);
This literal SQL expressions can be used for insert values also.
Special form _$column
allows to set internal column value without marking it for actual update in table.
JSON output support
Every row-object has TO_JSON()
function that can be automatically used by JSON
encode
function. This TO_JSON()
has some flexibility what to output.
my $user = DBC::Users->findOneByUsername("cruks");
my $json = JSON->new->convert_blessed;
# please pay attention on "id", its value is of number type
print $json->encode($user); # {"username":"cruks","id":1}
# only one field is required
print $json->encode($user->TO_JSON("username")); # {"username":"cruks"}
# one field and more data in output
print $json->encode($user->TO_JSON("username",
{url => "http://site.com/login"})
); # {"username":"cruks","url":"http://site.com/login"}
# just add more data in output
print $json->encode($user->TO_JSON({url => "http://site.com/login"}));
# {"url":"http://site.com/login","username":"cruks","id":1}
JSON type support
Fields with datatype 'json' or 'jsonb' can be transparently used as perl-structures.
my $row = one_row(table => $id);
# table is like
# id | integer | not null default nextval('table_id_seq'::regclass)
# settings | jsonb |
# row is like
# id | settings
# ----+-----------------------------------------------------------------
# 1 | {"limits": {"low": 15, "max": 100}}
$row->settings->{current}{runner} = 100;
# now row is like this
# id | settings
# ----+-----------------------------------------------------------------
# 1 | {"limits": {"low": 15, "max": 100}, "current": {"runner": 100}}
Syntax sugar
find...By...
This is inspired by Spring-Data for Java. This automatically generated function compiled on first call and selects row(s) or column value(s). It should be called on table class:
my $authors_name = DBC::Article->findOneFirstNameById($id);
my $authors_names_array_ref = DBC::Article->findFirst10FirstNameByOrderByLastNameAsc;
Format of this find-family is following:
find-func = find<what>By<search>
what = <plural><column><distinct>
plural = All|One|First[$limit] | ''
* One or First or First1 - selects only one row
column = one column name | ''
* returns direct value(s)
distinct = Distinct | ''
* select only distinct values
search = <where><order>
order = OrderBy<column-to-order-by>(Asc|Desc) | ''
where = <column>|<column>And<column>|<column>Or<column>
column = column name | column(LessThanEqual|LessThan|GreaterThanEqual|
GreaterThan|IsNull|IsNotNull|IsNot|NotNull|
NotEquals|NotIn|NotLike|IsEqualTo|IsTrue|
IsFalse|Equals|True|False|Like|Is|Not|In)
Column names are converted from CamelCase to underscore lowercase style: FirstName -> first_name. More examples:
DBC::User->findAll;
DBC::User->findFirst10ByOrderByLastName;
DBC::User->findByAddressZipCode($zip);
DBC::User->findByLoginDateGreaterThan($date);
DBC::User->findByLoginDateGreaterThanAndReferralIsNull($date);
Referenced tables
Suppose you have two tables employer and employee:
employer:
id_employer,
name
employee:
id_employee,
id_employer references employer (id_employer),
id_employee_invited_by
name
alter table employee add constraint fk_employee_employee
foreign key (id_employee_invited_by) references employee (id_employee);
my $employee = one_row("employee", {name => 'John'});
my $employer = $employee->Employer;
Actually, $employee->Employer
is just the same as one_row("employer", $employee->id_employer)
.
Referenced by table
Now you want to find all people invited by one employee:
my $referenced_by = $employee->refEmployeeInvitedBys;
Or only those with name 'Robert':
my $robert_associates = $employee->Employer->refEmployees(name => 'Robert');
These names "refEmployees", "refEmployee" and alike are made up from:
"ref" . $TableName . $suffix . $plural
$plural
is "s" for plural (all_rows
) and empty for singular (one_row
). $suffix
is used when foreign key column name contains something more then just referenced table name and "_id" or "id_".
id_employer
of employee
makes methods refEmployee
and refEmployees
in class DBC::Employer
. And id_employee_invited_by
makes methods refEmployeeInvitedBy
and refEmployeeInvitedBys
.
Real-world usage scenarios
sub get_articles {
my $req = $_[0];
my $articles = all_rows(
[ # tables are automatically joined by FK->PK
"article a" => -join => "author w",
-columns => ['a.*', 'w.name author']
],
-order_by => {-desc => 'id_article'},
-limit => $req->{limit},
-offset => $req->{offset},
# strip miliseconds from timestamps and return anonymous hash for every row
sub { $_->filter_timestamp->data }
);
for my $article (@$articles) {
$article->{comment_count} =
# second unnamed argument is "where"
one_row([comment => -columns => 'count(*)'], {id_article => $article->{id_article}})->count;
}
return {
result => "OK",
articles => $articles,
count => one_row([article => -columns => 'count(*)'])->count
};
}
sub get_article_with_comments {
my $req = $_[0];
# second unnamed argument is "where" and plain scalar means it is primary key value
my $article = one_row(article => $req->{id_article});
return {
result => "NO_ARTICLE",
answer => "No such article"
} unless $article;
# transform object into hash
my $article_hash = $article->filter_timestamp->data;
# get author's name by executing one_row("author", { id_author => $article->id_author })->name
$article_hash->{author} = $article->Author->name;
return {
result => "OK",
article => $article_hash,
# execute complex recursive query
comments => connector->run(
sub {
$_->selectall_arrayref(
q{
with recursive article_comments(depth, path) as (
select 1 depth, array[id_comment] path, id_comment,
id_comment_parent, comment, author,
date_trunc('seconds', pub_date) pub_date
from comment
where id_article = ? and id_comment_parent is null
union all
select depth + 1, path || array[c.id_comment] path, c.id_comment,
c.id_comment_parent, c.comment, c.author,
date_trunc('seconds', c.pub_date) pub_date
from comment c, article_comments cs
where c.id_comment_parent = cs.id_comment
) select * from article_comments order by path, id_comment
},
{Slice => {}},
$req->{id_article}
);
}
)
};
}
Known issues
This module is tested only with PostgreSQL, MySQL and SQLite databases. If you need other database support be prepared to help me to test and debug it.
See also
Authors
This module was written and is maintained by:
Anton Petrusevich
LICENSE
This program is free software; you can redistribute it and / or modify it under the terms of the the Artistic License (2.0). You may obtain a copy of the full license at:
http://www.perlfoundation.org/artistic_license_2_0
Any use, modification, and distribution of the Standard or Modified Versions is governed by this Artistic License.By using, modifying or distributing the Package, you accept this license. Do not use, modify, or distribute the Package, if you do not accept this license.
If your Modified Version has been derived from a Modified Version made by someone other than you,you are nevertheless required to ensure that your Modified Version complies with the requirements of this license.
This license does not grant you the right to use any trademark, service mark, tradename, or logo of the Copyright Holder.
This license includes the non-exclusive, worldwide, free-of-charge patent license to make, have made, use, offer to sell, sell, import and otherwise transfer the Package with respect to any patent claims licensable by the Copyright Holder that are necessarily infringed by the Package. If you institute patent litigation (including a cross-claim or counterclaim) against any party alleging that the Package constitutes direct or contributory patent infringement,then this Artistic License to you shall terminate on the date that such litigation is filed.
Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.