=encoding ISO8859-1

=head1 NAME

DBIx::DataModel::Doc::Cookbook - Helpful recipes


=head1 DOCUMENTATION CONTEXT

This chapter is part of the C<DBIx::DataModel> manual.

=over

=item *

L<SYNOPSIS AND DESCRIPTION|DBIx::DataModel>

=item *

L<DESIGN|DBIx::DataModel::Doc::Design>

=item *

L<QUICKSTART|DBIx::DataModel::Doc::Quickstart>

=item *

L<REFERENCE|DBIx::DataModel::Doc::Reference>

=item *

COOKBOOK

=item *

L<INTERNALS|DBIx::DataModel::Doc::Internals>

=item *

L<GLOSSARY|DBIx::DataModel::Doc::Glossary>

=back


=head1 DESCRIPTION

This chapter provides some recipes for common ORM tasks.

=head1 SCHEMA DECLARATION

=head2 Automatically generate a schema

A schema skeleton can be produced automatically from
the following external sources : 
a C<DBI> connection, a L<SQL::Translator> parser, or a
C<DBIx::Class> schema. 
See L<DBIx::DataModel::Schema::Generator|DBIx::DataModel::Schema::Generator>.
That schema skeleton contains enough information to be immediately
usable with minimal functionalities; but it is usually a good idea
to enrich the schema with additional specifications, like for example
types and column definitions.



=head2 Add custom methods into a generated table class

Defining methods in any Perl class does not require to have a I<file>
corresponding to that class; it suffices to define the method within
the appropriate I<package>. So the easiest way to add methods into
tables is to first let C<DBIx::DataModel> create the schema and table
classes, and then switch to those packages, all in the same file :


  # define schema, tables, associations (current package doesn't matter)
  DBIx::DataModel->Schema('Some::Schema')
    ->Table(qw/Foo foo foo_id/)
    ->Table(...)
    ->Association(...)
    ->...;

  # add a method into table 'Foo'
  package Some::Schema::Foo;
  sub my_added_method {
    my $self = shift;
    ...
  }

  # go back to main package
  package main;
  ...
   

Another way to achieve the same result is to use C<DBIx::DataModel>'s 
L<internal utility method|DBIx::DataModel::Meta::Utils/define_method>
for injecting methods into classes :

   use DBIx::DataModel::Meta::Utils qw/define_method/;
   define_method(
      class => 'Some::Schema::Foo',
      name  => 'my_added_method',
      body  => sub {my $self = shift; ...},
    );
  


=head2 Views within the ORM


C<define_table()> declarations usually map directly to database tables
or database views; but it is also possible to map to an SQL query,
possibly with a predefined C<where> clause :

  $schema->metadm->define_table(
    class       => 'View_example',
    db_name     => 'Foo INNER JOIN Bar ON Foo.fk=Bar.pk',
    where       => {col => $special_filter},
    primary_key => [qw/some_foo_col some_bar_col/],
    parents     => [map {$schema->metadm->table($_)} qw/Foo Bar/],
  );

The same can be declared through the front-end C<View()> method :

  $schema->View('View_example', '*',
                'Foo INNER JOIN Bar ON Foo.fk=Bar.pk',
                {col => $special_filter}, [qw/Foo Bar/],
                {primary_key => [qw/some_foo_col some_bar_col/],
                 parents     => [map {$schema->metadm->table($_)} qw/Foo Bar/]},
                );


This is exactly the same idea as a database view, except that it is
implemented within the ORM, not within the database. Such views can
join several tables, or can specify WHERE clauses to filter the
data. ORM views are useful to implement application-specific or
short-lived requests, that would not be worth registering persistently
within the database model. They can also be useful if you have no
administration rights in the database.


=head2 Object inflation/deflation

The term "object inflation" means that a scalar value read from a
column in the database is transformed into an Perl object in memory,
and is transformed back into a scalar value when writing into the
database. The standard example for such situations is the handling
of dates, because Perl programs often need to perform operations
on dates that are not possible with a plain scalar format.

Here is an example of automatic inflation/deflation of date columns
to Perl objects of class L<Date::Simple> :

  # declare column type
  use Date::Simple;
  $schema->Type(Date_simple => 
    from_DB => sub {Date::Simple->new($_[0]) if $_[0] },
    to_DB   => sub {$_[0] = $_[0]->as_str    if $_[0] },
  );
  
  # apply column type to columns
  My::Table1->metadm->define_column_type(Date_simple => qw/d_start d_end/);
  My::Table2->metadm->define_column_type(Date_simple => qw/d_birth/);

With this automatic conversion, all functionalities of L<Date::Simple>
can be applied to date columns within rows of C<Table1> and C<Table2> :
comparisons, date arithmetics, etc.


B<Caveat>: the C<from_DB> / C<to_DB> functions do not apply
automatically within C<-where> conditions. So the following
would not work :

  use Date::Simple qw/today/;
  my $rows = $schema->table($name)->select(
    -where => {d_end => {'<' => today()}},  # BOGUS
  );

because C<today()> returns a C<Date::Simple> object that will
not be understood by L<SQL::Abstract|SQL::Abstract> when
generating the SQL query. C<DBIx::DataModel> is not clever
enough to inspect the C<-where> conditions and decide
which column types to apply, so you have to do it yourself :

  my $today = today()->as_str;
  my $rows = $schema->table($name)->select(
    -where => {d_end => {'<' => $today}},
  );


=head2 SQL Types

At places where a plain value is expected, you can put an arrayref of
2 elements, where the first element is a type specification, and the
second element is the value. This is convenient when the DBD driver
needs additional information about the values used in the statement.
See L<SQL::Abstract::More/"BIND VALUES WITH TYPES"> for explanations.

  my $rows = $source->select(
    -where => {col => [{sql_type => 'some_type'}, $val]}
  );
  $source->insert(
    {key => $pk, some_col => [{sql_type => 'some_type'}, $val]}
  );
  $record->update(
    {some_col => [{sql_type => 'some_type'}, $val]}
  );

This can also be automated within a C<to_DB> handler :

  # adding type information for the DBD handler to inform Oracle about XML data
  $schema->Type(XML => 
     to_DB  => sub {$_[0] = [{dbd_attrs => {ora_type => ORA_XMLTYPE}}, $_[0]]
                        if $_[0]},
    );

=head2 Quoting table and column names

By default, table or column names are inserted "as is" in the generated SQL;
but sometimes this could cause conflicts with SQL reserved words.
The solution is to quote table and column names, by activating the
C<quote_char> option of L<SQL::Abstract>, inherited through
L<SQL::Abstract::More>. Here is an example (assuming
single-schema mode) :

  # define the schema
  DBIx::DataModel->Schema('SCH');

  # feed the schema with a custom instance of SQL::Abstract::More
  my $sqlam = SQL::Abstract::More->new(quote_char => "`");
  SCH->singleton->sql_abstract($sqlam);

  # define a table
  SCH->Table(qw/Config CONFIG KEY/);

  # produce SQL with quoted table and column names
  my ($sql, @bind) = SCH::Config->select(
    -columns   => [qw/KEY VALUE/],
    -where     => {KEY => 123},
    -result_as => 'sql',
   );

  print $sql; # SELECT `KEY`, `VALUE` FROM `CONFIG` WHERE ( `KEY` = ? )


=head2 Self-referential associations

Associations can be self-referential, i.e. describing tree
structures :

  $schema->Association([qw/OrganisationalUnit parent   1 ou_id       /],
                       [qw/OrganisationalUnit children * parent_ou_id/],

However, when there are several self-referential associations,
we might get into problems : consider

  $schema->Association([qw/Person mother   1 pers_id  /],
                       [qw/Person children * mother_id/])
         ->Association([qw/Person father   1 pers_id  /],
                       [qw/Person children * father_id/]); # BUG: children

This does not work because there are two definitions  of the "children"
role name in the same class "Person".
One solution is to distinguish these
roles, and then write by hand a general "children" role :

  $schema->Association([qw/Person mother          1 pers_id  /],
                       [qw/Person mother_children * mother_id/])
         ->Association([qw/Person father          1 pers_id  /],
                       [qw/Person father_children * father_id/]);
  
  package MySchema::Person;
  sub children {
    my $self = shift;
    my $id = $self->{pers_id};
    my $sql = "SELECT * FROM Person WHERE mother_id = $id OR father_id = $id";
    my $children = $self->dbh->selectall_arrayref($sql, {Slice => {}});
    MySchema::Person->bless_from_DB($_) foreach @$children;
    return $children;
  }

Alternatively, since rolenames C<mother_children> and C<father_children>
are most probably useless, we might just specify unidirectional
associations : 

  $schema->Association([qw/Person mother  1 pers_id  /],
                       [qw/Person ---     * mother_id/])
         ->Association([qw/Person father  1 pers_id  /],
                       [qw/Person ---     * father_id/]);

And here is a more sophisticated way to define the "children" method,
that will accept additional "where" criteria, like every regular method.

  package MySchema::Person;
  sub children {
    my $self      = shift; # remaining args in @_ will be passed to select()
    my $class     = ref $self;
    my $id        = $self->{pers_id};
    my $statement = $self->schema->table($class)->select(
      -where => [mother_id => $id, 
                 father_id => $id],
      -result_as => 'statement'
    );
    return $statement->select(@_);
  }

This definition forces the join on C<mother_id> or 
C<father_id>, while leaving open the possibility for the caller
to specify additional criteria. For example, all female children 
of a person (either father or mother) can now be retrieved through

  $person->children(-where => {gender => 'F'})

Observe that C<mother_id> and C<father_id> are inside an arrayref
instead of a hashref, so that L<SQL::Abstract> will generate an SQL 'OR'.


=head2 Schema versioning

Currently C<DBIx::DataModel> has no specific support
for schema versioning. See CPAN module L<DBIx::VersionedSchema>,
or switch to the L<DBIx::Class> ORM, that has good support for
schema versioning.


=head1 DATA RETRIEVAL

=head2 Database functions

Use normal SQL syntax for database functions, and give them
column aliases (with a vertical bar C<|>) in order to retrieve the results.

  my $row = $source->select(-columns   => [qw/MAX(col1)|max_col1
                                              AVG(col2)|avg_col2
                                              COUNT(DISTINCT(col3))|n_col3/],
                            -where     => ...,
                            -result_as => 'firstrow');
  print "max is : $row->{max_col1}, average is $row->{avg_col2}";

Or you can dispense with column aliases, and retrieve the results
directly into an arrayref, using C<< -result_as => 'flat_arrayref' >> :

  my $array_ref = $source->select(-columns   => [qw/MAX(col1)
                                                   AVG(col2)
                                                   COUNT(DISTINCT(col3))/],
                                  -where     => ...,
                                  -result_as => 'flat_arrayref');
  my ($max_col1, $avg_col2, $count_col3) = @$array_ref;

B<Caveat>: C<from_DB> handlers do not apply to 
database functions. So if the result needs any transformation,
you have to specify a column type for it at the statement level :

  my $row = $source->select(
    -columns      => [qw/MAX(d_begin)|max_d_begin MIN(d_end)|min_d_end .../],
    -where        => ...,
    -column_types => {Date_simple => [qw/max_d_begin min_d_end/],
    -result_as    => 'firstrow'
  );




=head2 Conditions on functions with special syntax

Some database systems have SQL functions with special syntax.
For example a fulltext search in Oracle is expressed as

  ... WHERE CONTAINS(fulltext_field, 'word') > 0

This does not fit well in a hashref to be passed as a C<-where> condition for 
L<SQL::Abstract::More>, because the name of the field and the bind value
are lost within the SQL syntax. To make it easier, we define a I<special operator>
for L<SQL::Abstract::More> :

  # define the schema
  DBIx::DataModel->Schema('SCH');
  
  # feed the schema with a custom instance of SQL::Abstract::More
  my $sqlam = SQL::Abstract::More->new(
    sql_dialect => "Oracle",
    special_ops => [{regex   => qr/^contains(:?_all|_any)?$/i,
                     handler => \&_fulltext_contains_for_Oracle}],
   );
  SCH->singleton->sql_abstract($sqlam);
  
  sub _fulltext_contains_for_Oracle {
    my ($self, $field, $op, $arg) = @_;

    my $sql = "CONTAINS($field, ?) > 0";
    my @bind;

    # Oracle connector for words : default '&', but '|' if op is -contains_any
    my $connector = ($op =~ /any$/) ? ' | ' : ' & ';

    # words to be passed to the CONTAINS function
    my @words = ref $arg ? @$arg : ($arg);
    @words = map { split /\s+/ } grep {$_} @words;

    @bind = (join $connector, @words);
    return ($sql, @bind);
  }

Now fulltext queries can be expressed easily as

  my $results = SCH->table('Table1')->select(
    -where => {fulltext_field1 => {-contains_all => ['ab', 'cd']},
               fulltext_field2 => {-contains_any => ['ef', 'gh', 'ij']},
              },
   );


=head2 Nested queries

For inserting a nested query within a basic query, we need to
pass the SQL and bind values of the nested query to L<SQL::Abstract>;
the syntax for this is a reference to an
arrayref (in other words a double reference), as explained in
L<SQL::Abstract/"Literal SQL with placeholders and bind values (subqueries)">.

C<DBIx::DataModel> has a feature to produce exactly this datastructure :

  my $subquery = $source1->select(..., -result_as => 'subquery');

Then it is easy to insert the subquery within another query.

  my $rows = $source2->select(
      -columns => ...,
      -where   => {foo => 123, bar => {-not_in => $subquery}},
   );



=head2 "Hashref inflation"

Unlike other ORMs, there is no need here to transform results into
hashrefs, because rows returned by a C<select()> can be used directly
as hashrefs.  For example here is a loop that prints a hash slice from
each row :

  my $rows       = $schema->table($name)->select(...);
  my @print_cols = qw/col3 col6 col7/;
  foreach my $row (@$rows) {
    print @{$row}{@print_cols};
  }

The only differences between row objects and plain Perl hashrefs are
that :

=over

=item a.

they are blessed into a source class

=item b.

they may contain an additional key C<< $row->{__schema}  >>
if C<DBIx::DataModel> is used in
L<multi-schema mode|DBIx::DataModel::Doc::Glossary/"multi-schema mode">.

=back

Those differences can often be ignored; but nevertheless they can be a problem
with some external modules like L<JSON> that croak when encoding
a blessed reference. In that case you can use the C<unbless()> function
which removes both the blessing and the C<__schema> key. Unblessing is
recursively applied to nested datastructures :

  $schema->unbless($rows);
  my $json = JSON->new->encode($rows);



=head1 DATA UPDATE

=head2 Transaction

  # anonymous sub containing the work to do
  my $to_do = sub {
    $table1->insert(...);
    $table2->delete(...);
  };
  # so far nothing has happened in the database
  
  # now do the transaction
  $schema->do_transaction($to_do);

=head2 Nested transaction

  $schema->do_transaction(sub {
    do_something();
    $schema->do_transaction(sub { some_nested_code();       });
    $schema->do_transaction(sub { some_other_nested_code(); });
  });

=head2 Nested transaction involving another database

  $schema->dbh($initial_dbh);
  $schema->do_transaction(sub {

    # start working in $initial_dbh
    do_something();

    # now some work in $other_dbh
    $schema->do_transaction(sub { some_nested_code();       }, $other_dbh);

    # here, implicitly we are back in $initial_dbh
    $schema->do_transaction(sub { some_other_nested_code(); });
  });
  # commits in both $initial_dbh and $other_dbh are performed here


=head2 Generating primary keys

Most database systems have mechanisms to generate primary keys
automatically, generally as a sequence of natural numbers; however,
there may be situations where one would like primary keys to be generated
under other algorithms, like for example taking a random number, or taking
the next "free slot" in a sparse sequence of numbers. Algorithmic
generation of keys can be implemented in the ORM layer by overriding the
L<_singleInsert()|DBIx::DataModel::Doc::Internals/"_singleInsert"> method.
Here is an example :

  sub insert_with_random_key {
    my ($self) = @_;
    my $class = ref $self;
    my ($key_column) = $class->primary_key;
  
    for (1..$MAX_ATTEMPTS) {
      my $random_key = int(rand($MAX_RANDOM));
  
        $self->{$key_column} = $random_key;
        eval {$self->_rawInsert; 1} 
          and return $random_key;   # SUCCESS

        # if duplication error, try again; otherwise die
        last unless $DBI::errstr =~ $DUPLICATE_ERROR;
     }
     croak "cannot generate a random key for $class: $@";
  }
  
  foreach my $class (@tables_with_random_keys) {
    define_method(
      class          => $schema->metadm->table($class)->class,
      name           => '_singleInsert',
      body           => \&insert_with_random_key,
    );
  }


=head2 Cascaded operations

Some database systems support cascaded operations : for example
a constraint definition with a clause like C<ON DELETE CASCADE>
will automatically delete child rows (rows containing foreign keys)
when the parent row (the row containing the primary key) is deleted.

C<DBIx::DataModel> does not know about such cascaded operations in the
database; but it can perform some cascaded operations at the ORM level,
when tables are associated through a 
L<composition|DBIx::DataModel::Doc::Glossary/"composition">.
In that case, the C<insert()> method can accept a data tree as argument,
and will automatically perform recursive inserts in the children tables;
an example is given in the
L<quickstart tutorial|DBIx::DataModel::Doc::Quickstart/"Cascaded inserts">.
Cascaded deletes are also supported : 

  my $bach = HR->table('Employee')->fetch($bach_id); 
  $bach->expand('activities');
  $bach->delete; # deletes the Employee together with its Activities

The C<expand> operations retrieve related records and add them
into a tree in memory. Then C<delete> removes from the database
all records found in the tree.

Observe that this is not a "true" cascaded 
delete, because the client code is responsible for fetching the
related records first. 



=head2 Timestamp validation

Suppose we want to sure that the record was not touched between the time
it was presented to the user in a display form and the time
the user wants to update or delete that record. 

In order to do this, we will suppose that every record in every
table has a timestamp field C<TS_MODIF>, updated automatically by
a trigger within the database. When defining the schema, we
register an I<auto_update> callback on that column; such callbacks
are called automatically both on C<update()> and C<insert()> calls :

  DBIx::DataModel->define_schema(
   class               => 'My::Schema',
   auto_update_columns => {TS_MODIF => \&_check_time_stamp},
  );

The body of the callback looks like this : 

  sub _check_time_stamp {
    my ($record, $table, $where) = @_;
    if ($where) { # this is an update, not an insert

      my $displayed_timestamp = delete $record->{TS_MODIF};
      my $db_record  = $record->schema->table($table)->select(
        -columns   => 'TS_MODIF',
        -where     => $where,
        -for       => 'update', # optional, depends on your RDBMS
        -result_as => 'firstrow',
      )
        or croak "fetch timestamp: could not find record "
               . join(" / ", %$where);
     my $db_timestamp = $db_record->{TS_MODIF};
     $db_timestamp == $displayed_timestamp
       or croak "record in $table was modified by somebody else; please "
              . "refresh your screen and try again";
     }
  }

=head1 DATA CONVERSION

=head2 JSON

  use JSON;
  my $json_converter = JSON->new->convert_blessed(1);
  my $json_text      = $json_converter->encode($data_row);

By default, the L<JSON> module refuses to convert any object into JSON;
however, the L<JSON/convert_blessed> option will accept to convert objects
provided they possess a C<TO_JSON> method. Such a method is implemented in 
the L<DBIx::DataModel::Source/DBIx::DataModel::Source> class, so 
any data row can be converted into JSON.



