DBIx-Struct/lib/DBIx/Struct.pod
=head1 NAME
DBIx::Struct - convenience SQL functions with Class::Struct-like row objects
=head1 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 );
=head1 DESCRIPTION
Makes SQL queries from Perl data structures. It uses L<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
L<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.
=head2 IMPORT
This module can be integrated into some framework that already uses
L<DBIx::Connector>. Integration parameters should be passed on first use.
These parameters are used for integration:
=over
=item connector_module
Connector's module name. By default used its own connector.
=item connector_constructor
Connector's constructor function name. By default is 'new'.
=item connector_args
Connector's arguments: ($dsn, $user, $password, $connect_attrs)
=item connector_object
Connector's singleton object. By defaut its own object is used.
=item connector_pool
Connector's pool object.
=item connector_pool_method
Connector's pool object's method to retrieve a connector.
=item table_classes_namespace
Namespace for table classes. By default is 'DBC'.
=item query_classes_namespace
Namespace for query classes. By default is 'DBQ'.
=item connect_timeout
Timeout to connect or reconnect to DB for default connector.
=item 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.
=back
This module always exports three functions: C<one_row()>, C<all_rows()> and C<new_row()>.
Optionally it can export C<connector()> - connector's singleton object and
C<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;
=head2 METHODS
=head3 C<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}
);
=head3 C<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.
=head3 C<one_row($table, $abstract_where, $order_by, $limit, $offset)>
Selects one row from given table and returns its object.
C<$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 C<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 C<-distinct> or C<-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 C<-count> selects only unique rows.
With C<-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:
=over
=item -distinct
Selects only unique rows. This is different from
"array reference table description": it takes no C<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 C<select distinct * from people>.
=item -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.
=item -having
Adds "HAVING" conditions to "GROUP BY"
my $row1 = one_row("table",
-group_by => "field",
-having => {"length(field)" => {">", 5} }
);
=item -order_by
Generates "ORDER BY" SQL-clause as in L<SQL::Abstract>.
=item -where
Generates "WHERE" SQL-clause as in L<SQL::Abstract>. If $abstract_where is just a scalar
then it is supposed to be a primary key value.
=item -limit
=item -offset
Generates "LIMIT $X OFFSET $Y" SQL-clause.
=item -sql
Returns generated SQL statement. if value is scalar reference then $statement is
assigned to referenced value.
=for comment If value is code reference then it is called
with two arguments: $sub->($statement, \@bind_variables);
=item -dry_run
Means don't fetch actual data. Useful with -sql when you only need to get
generated statement.
=back
=head3 C<all_rows($table, $abstract_where, $order_by, $limit, $offset)>
This is just like previous C<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 C<all_rows()> and C<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;
=head3 C<for_rows($table, $abstract_where, $order_by, $limit, $offset, $item_func)>
This function is similar to C<all_rows> but it doesn't make array of row objects.
Instead it calls C<$item_func> code reference for every selected row in C<$_>.
Returns number of processed rows. C<$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});
=head3 C<< new_row("table", column => $value, column2 => $value2, ...) >>
Inserts new row into table. Returns row object with set primary columns and passed in
C<new_row> subroutine. If you need to set all columns from table then:
my $row = new_row("table", column => $value);
$row->fetch;
=head2 Row object methods
=head3 C<new>
Creates new row in the table. This is the same as C<new_row()> except table name is already
known from class name.
my $row = DBC::Table->new(email => 'a@bb.com', password => '12345');
=head3 C<set>
Sets values of table columns. Returns object's $self value. Has three forms:
=over
=item C<set([...])>
Sets internal row data.
=item C<< set({column => $value, ... }) >>
Sets column(s) value(s)
=item C<< set(column => $value, ... ) >>
Same as above but without anonymous hash.
=back
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:
=over
=item new
=item set
=item data
=item delete
=item fetch
=item update
=item markUpdated
=item filter_timestamp
=back
=head3 C<data>
Returns values of the row. Has four forms:
=over
=item C<data()>
No parameters means to return all columns in anonymous hash {column => "value", ... }.
=item C<data([])>
Empty array reference means internal row data.
=item C<data([qw|column column2|])>
Non-empty array means array of values for corresponding columns.
=item C<< data({column => undef, columnt2 => undef}) >>
Returns given columns set in anonymous hash {column => "value", ... }.
=back
=head3 C<update>
Updates its row or table
=over
=item C<update()>
Updates changed (if any) columns of the row. Returns object's $self value.
=item C<< 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
=back
=head3 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.
=head3 C<delete>
Deletes the row or rows from the table.
=over
=item C<delete()>
Deletes the row if the row has primary key.
=item C<delete($where)>
deletes row(s) from table. For example:
DBC::List->delete({id => 1});
Means
delete from list WHERE ( id = ? )
with bind value 1
=back
=head3 C<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
=head3 C<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.
=head3 B<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 C<_$column> allows to set internal column value without marking
it for actual update in table.
=head4 B<JSON> output support
Every row-object has C<TO_JSON()> function that can be automatically used
by C<JSON> C<encode> function. This C<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}
=head4 B<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}}
=head2 Syntax sugar
=head3 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);
=head3 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, C<< $employee->Employer >> is just the same as
C<< one_row("employer", $employee->id_employer) >>.
=head3 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
C<$plural> is "s" for plural (C<all_rows>) and empty for singular (C<one_row>).
C<$suffix> is used when foreign key column name contains something more then
just referenced table name and "_id" or "id_".
C<id_employer> of C<employee> makes methods C<refEmployee> and C<refEmployees>
in class C<DBC::Employer>. And C<id_employee_invited_by> makes methods
C<refEmployeeInvitedBy> and C<refEmployeeInvitedBys>.
=head2 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}
);
}
)
};
}
=head1 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.
=head1 See also
=over
=item * L<DBIx::Connector>
=item * L<SQL::Abstract>
=back
=head1 Authors
This module was written and is maintained by:
=over
=item * Anton Petrusevich
=back
=head1 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:
L<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.
=cut