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

my $chat_name = one_row([chat => -column => "name"]);
my $ids_array_ref = all_rows([chat => -column => "id"]);

This singular column specification means "direct value": single scalar value for one_row and array reference of column values for <all_rows>. Example:

count => optional column name or expression

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"]);

This counts rows. Can be used togeter with -distinct or -all. It implicit assumes singular returned column.

distinct => optional column list as for -columns.

my $row_objects = one_row([chat => -distinct => "name,id"]);

Without -count selects only unique rows. With -count counts only unique rows.

-left => $table

left [OUTER] join

-right => $table

right [OUTER] join

-join => $table

[INNER] join

-on => $join_condition_string or L<SQL::Abstract>-where search conditions

on($join_condition_string)

-using => $join_condition_string or L<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 code reference then it is called with two arguments: $sub->($statement, \@bind_variables); 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.

JSON 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 and MySQL databases. If you need other database support be prepared to help me to test and debug it.

See also

• DBIx::Connector

• SQL::Abstract

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.

cpanm DBIx::Struct::JSON::Array

perl -MCPAN -e shell
install DBIx::Struct::JSON::Array