File Coverage

blib/lib/DBIx/DBO.pm

Criterion	Covered	Total	%
statement	175	186	94.0
branch	101	122	82.7
condition	29	39	74.3
subroutine	38	40	95.0
pod	17	19	89.4
total	360	406	88.6

package DBIx::DBO;

use 5.008;
use strict;
use warnings;
use DBI;
use Carp qw(carp croak);

our $VERSION;
our %Config = (
    AutoReconnect => 0,
    CacheQuery => 0,
    DebugSQL => 0,
    OnRowUpdate => 'simple',
    QuoteIdentifier => 1,
);
my $need_c3_initialize;
my @ConnectArgs;

BEGIN {
    $VERSION = '0.40';
    # The C3 method resolution order is required.
    if ($] < 5.009_005) {
        require MRO::Compat;
    } else {
        require mro;
    }
}

use DBIx::DBO::DBD;
use DBIx::DBO::Table;
use DBIx::DBO::Query;
use DBIx::DBO::Row;

sub _dbd_class   { 'DBIx::DBO::DBD' }
sub _table_class { 'DBIx::DBO::Table' }
sub _query_class { 'DBIx::DBO::Query' }
sub _row_class   { 'DBIx::DBO::Row' }

*_isa = \&DBIx::DBO::DBD::_isa;

=head1 NAME

DBIx::DBO - An OO interface to SQL queries and results.  Easily constructs SQL queries, and simplifies processing of the returned data.

=head1 SYNOPSIS

  use DBIx::DBO;

  # Create the DBO
  my $dbo = DBIx::DBO->connect('DBI:mysql:my_db', 'me', 'mypasswd') or die $DBI::errstr;

  # Create a "read-only" connection (useful for a replicated database)
  $dbo->connect_readonly('DBI:mysql:my_db', 'me', 'mypasswd') or die $DBI::errstr;

  # Start with a Query object
  my $query = $dbo->query('my_table');

  # Find records with an 'o' in the name
  $query->where('name', 'LIKE', '%o%');

  # And with an id that is less than 500
  $query->where('id', '<', 500);

  # Exluding those with an age range from 20 to 29
  $query->where('age', 'NOT BETWEEN', [20, 29]);

  # Return only the first 10 rows
  $query->limit(10);

  # Fetch the rows
  while (my $row = $query->fetch) {

      # Use the row as an array reference
      printf "id=%d  name=%s  status=%s\n", $row->[0], $row->[1], $row->[4];

      # Or as a hash reference
      print 'id=', $row->{id}, "\n", 'name=', $row->{name};

      # Update/delete rows
      $row->update(status => 'Fired!') if $row->{name} eq 'Harry';
      $row->delete if $row->{id} == 27;
  }

=head1 DESCRIPTION

This module provides a convenient and efficient way to access a database.  It can construct queries for you and returns the results in easy to use methods.

Once you've created a C object using one or both of C or C, you can begin creating L objects.  These are the "workhorse" objects, they encapsulate an entire query with JOINs, WHERE clauses, etc.  You need not have to know about what created the C to be able to use or modify it.  This makes it valuable in environments like mod_perl or large projects that prefer an object oriented approach to data.

The query is only automatically executed when the data is requested.  This is to make it possible to minimise lookups that may not be needed or to delay them as late as possible.

The L object returned can be treated as both an arrayref or a hashref.  The data is aliased for efficient use of memory.  C objects can be updated or deleted, even when created by JOINs (If the DB supports it).

=head1 METHODS

=cut

sub import {
    my $class = shift;
    if (@_ & 1) {
        my $opt = pop;
        carp "Import option '$opt' passed without a value";
    }
    while (my($opt, $val) = splice @_, 0, 2) {
        if (exists $Config{$opt}) {
            DBIx::DBO::DBD->_set_config(\%Config, $opt, $val);
        } else {
            carp "Unknown import option '$opt'";
        }
    }
}

=head3 C

  DBIx::DBO->new($dbh);
  DBIx::DBO->new(undef, $readonly_dbh);

Create a new C object from existsing C handles.  You must provide one or both of the I and I C handles.

=head3 C

  $dbo = DBIx::DBO->connect($data_source, $username, $password, \%attr)
      or die $DBI::errstr;

Takes the same arguments as Lconnect|DBI/"connect"> for a I connection to a database.  It returns the C object if the connection succeeds or undefined on failure.

=head3 C

Takes the same arguments as C for a I connection to a database.  It returns the C object if the connection succeeds or undefined on failure.

Both C & C can be called on a C object to add that respective connection to create a C with both I and I connections.

  my $dbo = DBIx::DBO->connect($master_dsn, $username, $password, \%attr)
      or die $DBI::errstr;
  $dbo->connect_readonly($slave_dsn, $username, $password, \%attr)
      or die $DBI::errstr;

=cut

sub new {
    my $me = shift;
    croak 'Too many arguments for '.(caller(0))[3] if @_ > 3;
    my($dbh, $rdbh, $new) = @_;

    if (defined $new and not UNIVERSAL::isa($new, 'HASH')) {
        croak '3rd argument to '.(caller(0))[3].' is not a HASH reference';
    }
    if (defined $dbh) {
        croak 'Invalid read-write database handle' unless _isa($dbh, 'DBI::db');
        $new->{dbh} = $dbh;
        $new->{dbd} ||= $dbh->{Driver}{Name};
    }
    if (defined $rdbh) {
        croak 'Invalid read-only database handle' unless _isa($rdbh, 'DBI::db');
        croak 'The read-write and read-only connections must use the same DBI driver'
            if $dbh and $dbh->{Driver}{Name} ne $rdbh->{Driver}{Name};
        $new->{rdbh} = $rdbh;
        $new->{dbd} ||= $rdbh->{Driver}{Name};
    }
    croak "Can't create the DBO, unknown database driver" unless $new->{dbd};
    $new->{dbd_class} = $me->_dbd_class->_require_dbd_class($new->{dbd});
    $me->_init($new);
}

sub _init {
    my($class, $me) = @_;
    bless $me, $class;
    $me->{dbd_class}->_init_dbo($me);
}

sub connect {
    my $me = shift;
    my $conn;
    if (ref $me) {
        croak 'DBO is already connected' if $me->{dbh};
        $me->_check_driver($_[0]) if @_;
        if ($me->config('AutoReconnect')) {
            $me->{ConnectArgs} = scalar @ConnectArgs unless defined $me->{ConnectArgs};
            $conn = $me->{ConnectArgs};
        } else {
            undef $ConnectArgs[$me->{ConnectArgs}] if defined $me->{ConnectArgs};
            delete $me->{ConnectArgs};
        }
#        $conn = $me->{ConnectArgs} //= scalar @ConnectArgs if $me->config('AutoReconnect');
        $me->{dbh} = $me->_connect($conn, @_) or return;
        return $me;
    }
    my %new;
    $conn = $new{ConnectArgs} = scalar @ConnectArgs if $me->config('AutoReconnect');
    my $dbh = $me->_connect($conn, @_) or return;
    $me->new($dbh, undef, \%new);
}

sub connect_readonly {
    my $me = shift;
    my $conn;
    if (ref $me) {
        undef $me->{rdbh};
        $me->_check_driver($_[0]) if @_;
        if ($me->config('AutoReconnect')) {
            $me->{ConnectReadOnlyArgs} = scalar @ConnectArgs unless defined $me->{ConnectReadOnlyArgs};
            $conn = $me->{ConnectReadOnlyArgs};
        } else {
            undef $ConnectArgs[$me->{ConnectReadOnlyArgs}] if defined $me->{ConnectReadOnlyArgs};
            delete $me->{ConnectReadOnlyArgs};
        }
#        $conn = $me->{ConnectReadOnlyArgs} //= scalar @ConnectArgs if $me->config('AutoReconnect');
        $me->{rdbh} = $me->_connect($conn, @_) or return;
        return $me;
    }
    my %new;
    $conn = $new{ConnectReadOnlyArgs} = scalar @ConnectArgs if $me->config('AutoReconnect');
    my $dbh = $me->_connect($conn, @_) or return;
    $me->new(undef, $dbh, \%new);
}

sub _check_driver {
    my($me, $dsn) = @_;

    my $driver = (DBI->parse_dsn($dsn))[1] or
        croak "Can't connect to data source '$dsn' because I can't work out what driver to use " .
            "(it doesn't seem to contain a 'dbi:driver:' prefix and the DBI_DRIVER env var is not set)";

    ref($me) =~ /::DBD::\Q$driver\E$/ or
    $driver eq $me->{dbd} or
        croak "Can't connect to the data source '$dsn'\n" .
            "The read-write and read-only connections must use the same DBI driver";
}

sub _connect {
    my $me = shift;
    my $conn_idx = shift;
    my @conn;

    if (@_) {
        my($dsn, $user, $auth, $attr) = @_;
        my %attr = %$attr if ref($attr) eq 'HASH';

        # Add a stack trace to PrintError & RaiseError
        $attr{HandleError} = sub {
            if ($Config{DebugSQL} > 1) {
                $_[0] = Carp::longmess($_[0]);
                return 0;
            }
            carp $_[1]->errstr if $_[1]->{PrintError};
            croak $_[1]->errstr if $_[1]->{RaiseError};
            return 1;
        } unless exists $attr{HandleError};

        # AutoCommit is always on
        %attr = (PrintError => 0, RaiseError => 1, %attr, AutoCommit => 1);
        @conn = ($dsn, $user, $auth, \%attr);

        # If a conn index is given then store the connection args
        $ConnectArgs[$conn_idx] = \@conn if defined $conn_idx;
    } elsif (defined $conn_idx and $ConnectArgs[$conn_idx]) {
        # If a conn index is given then retrieve the connection args
        @conn = @{$ConnectArgs[$conn_idx]};
    } else {
        croak "Can't auto-connect as AutoReconnect was not set";
    }

    local @DBIx::DBO::CARP_NOT = qw(DBI);
    DBI->connect(@conn);
}

=head3 C 




269




 





 





 





 





 





 



   




270




 





 





 





 





 





 



   $dbo->table($table); 




271




 





 





 





 





 





 



   $dbo->table([$schema, $table]); 




272




 





 





 





 





 





 



   $dbo->table($table_object); 




273




 





 





 





 





 





 



   




274




 





 





 





 





 





 



 Create and return a new L object. 




275




 





 





 





 





 





 



 Tables can be specified by their name or an arrayref of schema and table name or another L object. 




276




 





 





 





 





 





 



   




277




 





 





 





 





 





 



 =cut 




278




 





 





 





 





 





 



   




279




 





 





 





 





 





 



 sub table { 




280




7





 





 




  
7
  



  
1
  




626



     $_[0]->_table_class->new(@_); 




281




 





 





 





 





 





 



 } 




282




 





 





 





 





 





 



   




283




 





 





 





 





 





 



 =head3 C 




284




 





 





 





 





 





 



   




285




 





 





 





 





 





 



   $dbo->query($table, ...); 




286




 





 





 





 





 





 



   $dbo->query([$schema, $table], ...); 




287




 





 





 





 





 





 



   $dbo->query($table_object, ...); 




288




 





 





 





 





 





 



   




289




 





 





 





 





 





 



 Create a new L object from the tables specified. 




290




 





 





 





 





 





 



 In scalar context, just the C object will be returned. 




291




 





 





 





 





 





 



 In list context, the C object and L objects will be returned for each table specified. 




292




 





 





 





 





 





 



   




293




 





 





 





 





 





 



   my($query, $table1, $table2) = $dbo->query(['my_schema', 'my_table'], 'my_other_table'); 




294




 





 





 





 





 





 



   




295




 





 





 





 





 





 



 =cut 




296




 





 





 





 





 





 



   




297




 





 





 





 





 





 



 sub query { 




298




10





 





 




  
10
  



  
1
  




3483



     $_[0]->_query_class->new(@_); 




299




 





 





 





 





 





 



 } 




300




 





 





 





 





 





 



   




301




 





 





 





 





 





 



 =head3 C 




302




 





 





 





 





 





 



   




303




 





 





 





 





 





 



   $dbo->row($table || $table_object || $query_object); 




304




 





 





 





 





 





 



   




305




 





 





 





 





 





 



 Create and return a new L object. 




306




 





 





 





 





 





 



   




307




 





 





 





 





 





 



 =cut 




308




 





 





 





 





 





 



   




309




 





 





 





 





 





 



 sub row { 




310




5





 





 




  
5
  



  
1
  




1629



     $_[0]->_row_class->new(@_); 




311




 





 





 





 





 





 



 } 




312




 





 





 





 





 





 



   




313




 





 





 





 





 





 



 =head3 C, C, C, C 




314




 





 





 





 





 





 



   




315




 





 





 





 





 





 



   $dbo->selectrow_array($statement, \%attr, @bind_values); 




316




 





 





 





 





 





 



   $dbo->selectrow_arrayref($statement, \%attr, @bind_values); 




317




 





 





 





 





 





 



   $dbo->selectrow_hashref($statement, \%attr, @bind_values); 




318




 





 





 





 





 





 



   $dbo->selectall_arrayref($statement, \%attr, @bind_values); 




319




 





 





 





 





 





 



   




320




 





 





 





 





 





 



 These convenience methods provide access to Lselectrow_array|DBI/"selectrow_array">, Lselectrow_arrayref|DBI/"selectrow_arrayref">, Lselectrow_hashref|DBI/"selectrow_hashref">, Lselectall_arrayref|DBI/"selectall_arrayref"> methods. 




321




 





 





 





 





 





 



 They default to using the I C handle. 




322




 





 





 





 





 





 



   




323




 





 





 





 





 





 



 =cut 




324




 





 





 





 





 





 



   




325




 





 





 





 





 





 



 sub selectrow_array { 




326




1





 





 




  
1
  



  
1
  




2



     my $me = shift; 




327




1





 





 





 





 





13



     $me->{dbd_class}->_selectrow_array($me, @_); 




328




 





 





 





 





 





 



 } 




329




 





 





 





 





 





 



   




330




 





 





 





 





 





 



 sub selectrow_arrayref { 




331




2





 





 




  
2
  



  
1
  




5



     my $me = shift; 




332




2





 





 





 





 





18



     $me->{dbd_class}->_selectrow_arrayref($me, @_); 




333




 





 





 





 





 





 



 } 




334




 





 





 





 





 





 



   




335




 





 





 





 





 





 



 sub selectrow_hashref { 




336




0





 





 




  
0
  



  
1
  




0



     my $me = shift; 




337




0





 





 





 





 





0



     $me->{dbd_class}->_selectrow_hashref($me, @_); 




338




 





 





 





 





 





 



 } 




339




 





 





 





 





 





 



   




340




 





 





 





 





 





 



 sub selectall_arrayref { 




341




1





 





 




  
1
  



  
1
  




3



     my $me = shift; 




342




1





 





 





 





 





11



     $me->{dbd_class}->_selectall_arrayref($me, @_); 




343




 





 





 





 





 





 



 } 




344




 





 





 





 





 





 



   




345




 





 





 





 





 





 



 =head3 C 




346




 





 





 





 





 





 



   




347




 





 





 





 





 





 



   $dbo->do($statement)         or die $dbo->dbh->errstr; 




348




 





 





 





 





 





 



   $dbo->do($statement, \%attr) or die $dbo->dbh->errstr; 




349




 





 





 





 





 





 



   $dbo->do($statement, \%attr, @bind_values) or die ... 




350




 





 





 





 





 





 



   




351




 





 





 





 





 





 



 This provides access to the Ldo|DBI/"do"> method.  It defaults to using the I C handle. 




352




 





 





 





 





 





 



   




353




 





 





 





 





 





 



 =cut 




354




 





 





 





 





 





 



   




355




 





 





 





 





 





 



 sub do { 




356




6





 





 




  
6
  



  
1
  




425



     my $me = shift; 




357




6





 





 





 





 





34



     $me->{dbd_class}->_do($me, @_); 




358




 





 





 





 





 





 



 } 




359




 





 





 





 





 





 



   




360




 





 





 





 





 





 



 =head3 C 




361




 





 





 





 





 





 



   




362




 





 





 





 





 





 



   $dbo->table_info($table); 




363




 





 





 





 





 





 



   $dbo->table_info([$schema, $table]); 




364




 





 





 





 





 





 



   $dbo->table_info($table_object); 




365




 





 





 





 





 





 



   




366




 





 





 





 





 





 



 Returns a hashref containing C, C and C for the table. 




367




 





 





 





 





 





 



 Mainly for internal use. 




368




 





 





 





 





 





 



   




369




 





 





 





 





 





 



 =cut 




370




 





 





 





 





 





 



   




371




 





 





 





 





 





 



 sub table_info { 




372




24





 





 




  
24
  



  
1
  




47



     my($me, $table) = @_; 




373




24




  
 50
  



  
 33
  




 





 





151



     croak 'No table name supplied' unless defined $table and length $table; 




374




 





 





 





 





 





 



   




375




24





 





 





 





 





36



     my $schema; 




376




24




  
100
  




 





 





 





129



     if (_isa($table, 'DBIx::DBO::Table')) { 




377




2




  
100
  




 





 





 





11



         croak 'This table is from a different DBO connection' if $table->{DBO} != $me; 




378




1





 





 





 





 





6



         ($schema, $table) = @$table{qw(Schema Name)}; 




379




 





 





 





 





 





 



     } else { 




380




22




  
100
  




 





 





 





160



         ($schema, $table) = ref $table eq 'ARRAY' ? @$table : $me->{dbd_class}->_unquote_table($me, $table); 




381




22




  
100
  




 





 





 





160



         defined $schema or $schema = $me->{dbd_class}->_get_table_schema($me, $schema, $table); 




382




 





 





 





 





 





 



   




383




22




  
100
  




 





 





 





163



         $me->{dbd_class}->_get_table_info($me, $schema, $table) 




 




 




  
100
  




 





 





 





 



   




384




 





 





 





 





 





 



             unless exists $me->{TableInfo}{defined $schema ? $schema : ''}{$table}; 




385




 





 





 





 





 





 



     } 




386




22




  
100
  




 





 





 





224



     return ($schema, $table, $me->{TableInfo}{defined $schema ? $schema : ''}{$table}); 




387




 





 





 





 





 





 



 } 




388




 





 





 





 





 





 



   




389




 





 





 





 





 





 



 =head3 C 




390




 





 





 





 





 





 



   




391




 





 





 





 





 





 



 Disconnect both the I & I connections to the database. 




392




 





 





 





 





 





 



   




393




 





 





 





 





 





 



 =cut 




394




 





 





 





 





 





 



   




395




 





 





 





 





 





 



 sub disconnect { 




396




4





 





 




  
4
  



  
1
  




600



     my $me = shift; 




397




4




  
100
  




 





 





 





22



     if ($me->{dbh}) { 




398




3





 





 





 





 





204



         $me->{dbh}->disconnect; 




399




3





 





 





 





 





6



         undef $me->{dbh}; 




400




 





 





 





 





 





 



     } 




401




4




  
100
  




 





 





 





70



     if ($me->{rdbh}) { 




402




3





 





 





 





 





30



         $me->{rdbh}->disconnect; 




403




3





 





 





 





 





5



         undef $me->{rdbh}; 




404




 





 





 





 





 





 



     } 




405




4





 





 





 





 





87



     delete $me->{TableInfo}; 




406




4





 





 





 





 





15



     return; 




407




 





 





 





 





 





 



 } 




408




 





 





 





 





 





 



   




409




 





 





 





 





 





 



 =head2 Common Methods 




410




 





 





 





 





 





 



   




411




 





 





 





 





 





 



 These methods are accessible from all DBIx::DBO* objects. 




412




 





 





 





 





 





 



   




413




 





 





 





 





 





 



 =head3 C 




414




 





 





 





 





 





 



   




415




 





 





 





 





 





 



 This C object. 




416




 





 





 





 





 





 



   




417




 





 





 





 





 





 



 =head3 C 




418




 





 





 





 





 





 



   




419




 





 





 





 





 





 



 The I C handle. 




420




 





 





 





 





 





 



   




421




 





 





 





 





 





 



 =head3 C 




422




 





 





 





 





 





 



   




423




 





 





 





 





 





 



 The I C handle, or if there is no I connection, the I C handle. 




424




 





 





 





 





 





 



   




425




 





 





 





 





 





 



 =cut 




426




 





 





 





 





 





 



   




427




2





 





 




  
2
  



  
1
  




449



 sub dbo { $_[0] } 




428




 





 





 





 





 





 



   




429




 





 





 





 





 





 



 sub _handle { 




430




302





 





 




  
302
  




 





488



     my($me, $type) = @_; 




431




 





 





 





 





 





 



     # $type can be 'read-only', 'read-write' or false (which means try read-only then read-write) 




432




302




  
100
  



  
 66
  




 





 





1449



     $type ||= defined $me->{rdbh} ? 'read-only' : 'read-write'; 




433




302




  
100
  




 





 





 





788



     my($d, $c) = $type ne 'read-only' ? qw(dbh ConnectArgs) : qw(rdbh ConnectReadOnlyArgs); 




434




302




  
100
  




 





 





 





731



     croak "No $type handle connected" unless defined $me->{$d}; 




435




 





 





 





 





 





 



     # Automatically reconnect, but only if possible and needed 




436




300




  
100
  



  
100
  




 





 





870



     $me->{$d} = $me->_connect($me->{$c}) if exists $me->{$c} and not $me->{$d}->ping; 




437




300





 





 





 





 





2659



     $me->{$d}; 




438




 





 





 





 





 





 



 } 




439




 





 





 





 





 





 



   




440




 





 





 





 





 





 



 sub dbh { 




441




34





 





 




  
34
  



  
1
  




59



     my $me = shift; 




442




34





 




  
 50
  




 





 





91



     $me->_handle($me->config('UseHandle') || 'read-write'); 




443




 





 





 





 





 





 



 } 




444




 





 





 





 





 





 



   




445




 





 





 





 





 





 



 sub rdbh { 




446




268





 





 




  
268
  



  
1
  




400



     my $me = shift; 




447




268





 





 





 





 





667



     $me->_handle($me->config('UseHandle')); 




448




 





 





 





 





 





 



 } 




449




 





 





 





 





 





 



   




450




 





 





 





 





 





 



 =head3 C 




451




 





 





 





 





 





 



   




452




 





 





 





 





 





 



   $global_setting = DBIx::DBO->config($option); 




453




 





 





 





 





 





 



   DBIx::DBO->config($option => $global_setting); 




454




 





 





 





 





 





 



   $dbo_setting = $dbo->config($option); 




455




 





 





 





 





 





 



   $dbo->config($option => $dbo_setting); 




456




 





 





 





 





 





 



   




457




 





 





 





 





 





 



 Get or set the global or this C config settings.  When setting an option, the previous value is returned.  When getting an option's value, if the value is undefined, the global value is returned. 




458




 





 





 





 





 





 



   




459




 





 





 





 





 





 



 =head2 Available C options 




460




 





 





 





 





 





 



   




461




 





 





 





 





 





 



 =over 




462




 





 





 





 





 





 



   




463




 





 





 





 





 





 



 =item C 




464




 





 





 





 





 





 



   




465




 





 





 





 





 





 



 Boolean setting to store the connection details for re-use. 




466




 





 





 





 





 





 



 Before every operation the connection will be tested via ping() and reconnected automatically if needed. 




467




 





 





 





 





 





 



 Changing this has no effect after the connection has been made. 




468




 





 





 





 





 





 



 Defaults to C. 




469




 





 





 





 





 





 



   




470




 





 





 





 





 





 



 =item C 




471




 





 





 





 





 





 



   




472




 





 





 





 





 





 



 Boolean setting to cause C objects to cache their entire result for re-use. 




473




 





 





 





 





 





 



 The query will only be executed automatically once. 




474




 





 





 





 





 





 



 To rerun the query, either explicitly call L or alter the query. 




475




 





 





 





 





 





 



 Defaults to C. 




476




 





 





 





 





 





 



   




477




 





 





 





 





 





 



 =item C 




478




 





 





 





 





 





 



   




479




 





 





 





 





 





 



 Set to C<1> or C<2> to warn about each SQL command executed.  C<2> adds a full stack trace. 




480




 





 





 





 





 





 



 Defaults to C<0> (silent). 




481




 





 





 





 





 





 



   




482




 





 





 





 





 





 



 =item C 




483




 





 





 





 





 





 



   




484




 





 





 





 





 





 



 Set to C<'empty'>, C<'simple'> or C<'reload'> to define the behaviour of a C after an L. 




485




 





 





 





 





 





 



 C<'empty'> will simply leave the C empty after every update. 




486




 





 





 





 





 





 



 C<'simple'> will set the values in the C if they are not complex expressions, otherwise the C will be empty. 




487




 





 





 





 





 





 



 C<'reload'> is the same as C<'simple'> except it also tries to reload the C if possible. 




488




 





 





 





 





 





 



 Defaults to C<'simple'>. 




489




 





 





 





 





 





 



   




490




 





 





 





 





 





 



 =item C 




491




 





 





 





 





 





 



   




492




 





 





 





 





 





 



 Boolean setting to control quoting of SQL identifiers (schema, table and column names). 




493




 





 





 





 





 





 



   




494




 





 





 





 





 





 



 =item C 




495




 





 





 





 





 





 



   




496




 





 





 





 





 





 



 Set to C<'read-write'> or C<'read-only'> to force using only that handle for all operations. 




497




 





 





 





 





 





 



 Defaults to C which chooses the I handle for reads and the I handle otherwise. 




498




 





 





 





 





 





 



   




499




 





 





 





 





 





 



 =back 




500




 





 





 





 





 





 



   




501




 





 





 





 





 





 



 Global options can also be set when C'ing the module: 




502




 





 





 





 





 





 



   




503




 





 





 





 





 





 



   use DBIx::DBO QuoteIdentifier => 0, DebugSQL => 1; 




504




 





 





 





 





 





 



   




505




 





 





 





 





 





 



 =cut 




506




 





 





 





 





 





 



   




507




 





 





 





 





 





 



 sub config { 




508




399





 





 




  
399
  



  
1
  




7930



     my($me, $opt) = @_; 




509




399




  
100
  




 





 





 





941



     if (@_ > 2) { 




510




37




  
100
  



  
100
  




 





 





1472



         return ref $me 




511




 





 





 





 





 





 



             ? $me->{dbd_class}->_set_config($me->{Config} ||= {}, $opt, $_[2]) 




512




 





 





 





 





 





 



             : $me->_dbd_class->_set_config(\%Config, $opt, $_[2]); 




513




 





 





 





 





 





 



     } 




514




362




  
100
  



  
100
  




 





 





2168



     return ref $me 




515




 





 





 





 





 





 



         ? $me->{dbd_class}->_get_config($opt, $me->{Config} ||= {}, \%Config) 




516




 





 





 





 





 





 



         : $me->_dbd_class->_get_config($opt, \%Config); 




517




 





 





 





 





 





 



 } 




518




 





 





 





 





 





 



   




519




 





 





 





 





 





 



 sub STORABLE_freeze { 




520




16





 





 




  
16
  



  
0
  




358



     my $me = $_[0]; 




521




16




  
100
  



  
 66
  




 





 





801



     return unless ref $me->{dbh} or ref $me->{rdbh}; 




522




 





 





 





 





 





 



   




523




8





 





 





 





 





16



     my %stash = map { $_ => delete $me->{$_} } qw(dbh rdbh ConnectArgs ConnectReadOnlyArgs); 




 




32





 





 





 





 





85



   




524




8




  
 50
  




 





 





 





42



     $me->{dbh} = "$stash{dbh}" if defined $stash{dbh}; 




525




8




  
 50
  




 





 





 





19



     $me->{rdbh} = "$stash{rdbh}" if defined $stash{rdbh}; 




526




8





 





 





 





 





14



     for (qw(ConnectArgs ConnectReadOnlyArgs)) { 




527




16




  
 50
  




 





 





 





42



         $me->{$_} = $ConnectArgs[$stash{$_}] if defined $stash{$_}; 




528




 





 





 





 





 





 



     } 




529




 





 





 





 





 





 



   




530




8





 





 





 





 





26



     my $frozen = Storable::nfreeze($me); 




531




8





 




  
 66
  




 





 





112



     defined $stash{$_} and $me->{$_} = $stash{$_} for qw(dbh rdbh ConnectArgs ConnectReadOnlyArgs); 




532




8





 





 





 





 





370



     return $frozen; 




533




 





 





 





 





 





 



 } 




534




 





 





 





 





 





 



   




535




 





 





 





 





 





 



 sub STORABLE_thaw { 




536




8





 





 




  
8
  



  
0
  




2428



     my($me, $cloning, $frozen) = @_; 




537




8





 





 





 





 





9



     %$me = %{ Storable::thaw($frozen) }; 




 




8





 





 





 





 





22



   




538




8




  
 50
  




 





 





 





292



     if ($me->config('AutoReconnect')) { 




539




0





 





 





 





 





0



         for (qw(ConnectArgs ConnectReadOnlyArgs)) { 




540




0




  
  0
  




 





 





 





0



             $me->{$_} = push(@ConnectArgs, $me->{$_}) - 1 if $me->{$_}; 




541




 





 





 





 





 





 



         } 




542




 





 





 





 





 





 



     } else { 




543




8





 





 





 





 





197



         delete $me->{$_} for qw(ConnectArgs ConnectReadOnlyArgs); 




544




 





 





 





 





 





 



     } 




545




 





 





 





 





 





 



 } 




546




 





 





 





 





 





 



   




547




 





 





 





 





 





 



 sub DESTROY { 




548




17





 





 




  
17
  




 





1024



     undef %{$_[0]}; 




 




17





 





 





 





 





316



   




549




 





 





 





 





 





 



 } 




550




 





 





 





 





 





 



   




551




 





 





 





 





 





 



 1; 




552




 





 





 





 





 





 



   




553




 





 





 





 





 





 



 __END__

  $dbo->table($table);
  $dbo->table([$schema, $table]);
  $dbo->table($table_object);

Create and return a new L object.
Tables can be specified by their name or an arrayref of schema and table name or another L object.

=cut

sub table {
    $_[0]->_table_class->new(@_);
}

=head3 C

  $dbo->query($table, ...);
  $dbo->query([$schema, $table], ...);
  $dbo->query($table_object, ...);

Create a new L object from the tables specified.
In scalar context, just the C object will be returned.
In list context, the C object and L objects will be returned for each table specified.

  my($query, $table1, $table2) = $dbo->query(['my_schema', 'my_table'], 'my_other_table');

=cut

sub query {
    $_[0]->_query_class->new(@_);
}

=head3 C

  $dbo->row($table || $table_object || $query_object);

Create and return a new L object.

=cut

sub row {
    $_[0]->_row_class->new(@_);
}

=head3 C, C, C, C

  $dbo->selectrow_array($statement, \%attr, @bind_values);
  $dbo->selectrow_arrayref($statement, \%attr, @bind_values);
  $dbo->selectrow_hashref($statement, \%attr, @bind_values);
  $dbo->selectall_arrayref($statement, \%attr, @bind_values);

These convenience methods provide access to Lselectrow_array|DBI/"selectrow_array">, Lselectrow_arrayref|DBI/"selectrow_arrayref">, Lselectrow_hashref|DBI/"selectrow_hashref">, Lselectall_arrayref|DBI/"selectall_arrayref"> methods.
They default to using the I C handle.

=cut

sub selectrow_array {
    my $me = shift;
    $me->{dbd_class}->_selectrow_array($me, @_);
}

sub selectrow_arrayref {
    my $me = shift;
    $me->{dbd_class}->_selectrow_arrayref($me, @_);
}

sub selectrow_hashref {
    my $me = shift;
    $me->{dbd_class}->_selectrow_hashref($me, @_);
}

sub selectall_arrayref {
    my $me = shift;
    $me->{dbd_class}->_selectall_arrayref($me, @_);
}

=head3 C

  $dbo->do($statement)         or die $dbo->dbh->errstr;
  $dbo->do($statement, \%attr) or die $dbo->dbh->errstr;
  $dbo->do($statement, \%attr, @bind_values) or die ...

This provides access to the Ldo|DBI/"do"> method.  It defaults to using the I C handle.

=cut

sub do {
    my $me = shift;
    $me->{dbd_class}->_do($me, @_);
}

=head3 C

  $dbo->table_info($table);
  $dbo->table_info([$schema, $table]);
  $dbo->table_info($table_object);

Returns a hashref containing C, C and C for the table.
Mainly for internal use.

=cut

sub table_info {
    my($me, $table) = @_;
    croak 'No table name supplied' unless defined $table and length $table;

    my $schema;
    if (_isa($table, 'DBIx::DBO::Table')) {
        croak 'This table is from a different DBO connection' if $table->{DBO} != $me;
        ($schema, $table) = @$table{qw(Schema Name)};
    } else {
        ($schema, $table) = ref $table eq 'ARRAY' ? @$table : $me->{dbd_class}->_unquote_table($me, $table);
        defined $schema or $schema = $me->{dbd_class}->_get_table_schema($me, $schema, $table);

        $me->{dbd_class}->_get_table_info($me, $schema, $table)
            unless exists $me->{TableInfo}{defined $schema ? $schema : ''}{$table};
    }
    return ($schema, $table, $me->{TableInfo}{defined $schema ? $schema : ''}{$table});
}

=head3 C

Disconnect both the I & I connections to the database.

=cut

sub disconnect {
    my $me = shift;
    if ($me->{dbh}) {
        $me->{dbh}->disconnect;
        undef $me->{dbh};
    }
    if ($me->{rdbh}) {
        $me->{rdbh}->disconnect;
        undef $me->{rdbh};
    }
    delete $me->{TableInfo};
    return;
}

=head2 Common Methods

These methods are accessible from all DBIx::DBO* objects.

=head3 C

This C object.

=head3 C

The I C handle.

=head3 C

The I C handle, or if there is no I connection, the I C handle.

=cut

sub dbo { $_[0] }

sub _handle {
    my($me, $type) = @_;
    # $type can be 'read-only', 'read-write' or false (which means try read-only then read-write)
    $type ||= defined $me->{rdbh} ? 'read-only' : 'read-write';
    my($d, $c) = $type ne 'read-only' ? qw(dbh ConnectArgs) : qw(rdbh ConnectReadOnlyArgs);
    croak "No $type handle connected" unless defined $me->{$d};
    # Automatically reconnect, but only if possible and needed
    $me->{$d} = $me->_connect($me->{$c}) if exists $me->{$c} and not $me->{$d}->ping;
    $me->{$d};
}

sub dbh {
    my $me = shift;
    $me->_handle($me->config('UseHandle') || 'read-write');
}

sub rdbh {
    my $me = shift;
    $me->_handle($me->config('UseHandle'));
}

=head3 C

  $global_setting = DBIx::DBO->config($option);
  DBIx::DBO->config($option => $global_setting);
  $dbo_setting = $dbo->config($option);
  $dbo->config($option => $dbo_setting);

Get or set the global or this C config settings.  When setting an option, the previous value is returned.  When getting an option's value, if the value is undefined, the global value is returned.

=head2 Available C options

=over

=item C

Boolean setting to store the connection details for re-use.
Before every operation the connection will be tested via ping() and reconnected automatically if needed.
Changing this has no effect after the connection has been made.
Defaults to C.

=item C

Boolean setting to cause C objects to cache their entire result for re-use.
The query will only be executed automatically once.
To rerun the query, either explicitly call L or alter the query.
Defaults to C.

=item C

Set to C<1> or C<2> to warn about each SQL command executed.  C<2> adds a full stack trace.
Defaults to C<0> (silent).

=item C

Set to C<'empty'>, C<'simple'> or C<'reload'> to define the behaviour of a C after an L.
C<'empty'> will simply leave the C empty after every update.
C<'simple'> will set the values in the C if they are not complex expressions, otherwise the C will be empty.
C<'reload'> is the same as C<'simple'> except it also tries to reload the C if possible.
Defaults to C<'simple'>.

=item C

Boolean setting to control quoting of SQL identifiers (schema, table and column names).

=item C

Set to C<'read-write'> or C<'read-only'> to force using only that handle for all operations.
Defaults to C which chooses the I handle for reads and the I handle otherwise.

=back

Global options can also be set when C'ing the module:

  use DBIx::DBO QuoteIdentifier => 0, DebugSQL => 1;

=cut

sub config {
    my($me, $opt) = @_;
    if (@_ > 2) {
        return ref $me
            ? $me->{dbd_class}->_set_config($me->{Config} ||= {}, $opt, $_[2])
            : $me->_dbd_class->_set_config(\%Config, $opt, $_[2]);
    }
    return ref $me
        ? $me->{dbd_class}->_get_config($opt, $me->{Config} ||= {}, \%Config)
        : $me->_dbd_class->_get_config($opt, \%Config);
}

sub STORABLE_freeze {
    my $me = $_[0];
    return unless ref $me->{dbh} or ref $me->{rdbh};

    my %stash = map { $_ => delete $me->{$_} } qw(dbh rdbh ConnectArgs ConnectReadOnlyArgs);
    $me->{dbh} = "$stash{dbh}" if defined $stash{dbh};
    $me->{rdbh} = "$stash{rdbh}" if defined $stash{rdbh};
    for (qw(ConnectArgs ConnectReadOnlyArgs)) {
        $me->{$_} = $ConnectArgs[$stash{$_}] if defined $stash{$_};
    }

    my $frozen = Storable::nfreeze($me);
    defined $stash{$_} and $me->{$_} = $stash{$_} for qw(dbh rdbh ConnectArgs ConnectReadOnlyArgs);
    return $frozen;
}

sub STORABLE_thaw {
    my($me, $cloning, $frozen) = @_;
    %$me = %{ Storable::thaw($frozen) };
    if ($me->config('AutoReconnect')) {
        for (qw(ConnectArgs ConnectReadOnlyArgs)) {
            $me->{$_} = push(@ConnectArgs, $me->{$_}) - 1 if $me->{$_};
        }
    } else {
        delete $me->{$_} for qw(ConnectArgs ConnectReadOnlyArgs);
    }
}

sub DESTROY {
    undef %{$_[0]};
}

1;

__END__