File Coverage

blib/lib/DBIx/DBO.pm

Criterion	Covered	Total	%
statement	164	172	95.3
branch	92	108	85.1
condition	36	44	81.8
subroutine	36	38	94.7
pod	21	23	91.3
total	349	385	90.6

use 5.014;
use warnings;

package DBIx::DBO 0.50;

use DBI;
use Carp qw(carp croak);

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

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')) {
            $conn = $me->{ConnectArgs} //= scalar @ConnectArgs;
        } else {
            undef $ConnectArgs[$me->{ConnectArgs}] if defined $me->{ConnectArgs};
            delete $me->{ConnectArgs};
        }
        $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')) {
            $conn = $me->{ConnectReadOnlyArgs} //= scalar @ConnectArgs;
        } else {
            undef $ConnectArgs[$me->{ConnectReadOnlyArgs}] if defined $me->{ConnectReadOnlyArgs};
            delete $me->{ConnectReadOnlyArgs};
        }
        $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";
}

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

sub _connect {
    my($me, $conn_idx, @conn) = @_;

    if (@conn) {
        # 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]) {
        # Retrieve the connection args
        @conn = @{$ConnectArgs[$conn_idx]};
    } else {
        croak "Can't auto-connect as AutoReconnect was not set";
    }

    my %attr;
    %attr = %{$conn[3]} if ref $conn[3] eq 'HASH';
    # AutoCommit is always on
    %attr = (HandleError => \&_handle_error, PrintError => 0, RaiseError => 1, %attr, AutoCommit => 1);

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

=head3 C 




249




 





 





 





 





 





 



   




250




 





 





 





 





 





 



   $dbo->table($table); 




251




 





 





 





 





 





 



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




252




 





 





 





 





 





 



   $dbo->table($table_object); 




253




 





 





 





 





 





 



   




254




 





 





 





 





 





 



 Create and return a new L object. 




255




 





 





 





 





 





 



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




256




 





 





 





 





 





 



   




257




 





 





 





 





 





 



 =cut 




258




 





 





 





 





 





 



   




259




 





 





 





 





 





 



 sub table { 




260




15





 





 




  
15
  



  
1
  




4869



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




261




 





 





 





 





 





 



 } 




262




 





 





 





 





 





 



   




263




 





 





 





 





 





 



 =head3 C 




264




 





 





 





 





 





 



   




265




 





 





 





 





 





 



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




266




 





 





 





 





 





 



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




267




 





 





 





 





 





 



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




268




 





 





 





 





 





 



   




269




 





 





 





 





 





 



 Create a new L object from the tables specified. 




270




 





 





 





 





 





 



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




271




 





 





 





 





 





 



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




272




 





 





 





 





 





 



   




273




 





 





 





 





 





 



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




274




 





 





 





 





 





 



   




275




 





 





 





 





 





 



 =cut 




276




 





 





 





 





 





 



   




277




 





 





 





 





 





 



 sub query { 




278




17





 





 




  
17
  



  
1
  




2620



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




279




 





 





 





 





 





 



 } 




280




 





 





 





 





 





 



   




281




 





 





 





 





 





 



 =head3 C 




282




 





 





 





 





 





 



   




283




 





 





 





 





 





 



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




284




 





 





 





 





 





 



   




285




 





 





 





 





 





 



 Create and return a new L object. 




286




 





 





 





 





 





 



   




287




 





 





 





 





 





 



 =cut 




288




 





 





 





 





 





 



   




289




 





 





 





 





 





 



 sub row { 




290




6





 





 




  
6
  



  
1
  




1882



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




291




 





 





 





 





 





 



 } 




292




 





 





 





 





 





 



   




293




 





 





 





 





 





 



 =head3 C, C, C, C 




294




 





 





 





 





 





 



   




295




 





 





 





 





 





 



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




296




 





 





 





 





 





 



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




297




 





 





 





 





 





 



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




298




 





 





 





 





 





 



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




299




 





 





 





 





 





 



   




300




 





 





 





 





 





 



 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. 




301




 





 





 





 





 





 



 They default to using the I C handle. 




302




 





 





 





 





 





 



   




303




 





 





 





 





 





 



 =cut 




304




 





 





 





 





 





 



   




305




 





 





 





 





 





 



 sub selectrow_array { 




306




1





 





 




  
1
  



  
1
  




3



     my $me = shift; 




307




1





 





 





 





 





13



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




308




 





 





 





 





 





 



 } 




309




 





 





 





 





 





 



   




310




 





 





 





 





 





 



 sub selectrow_arrayref { 




311




2





 





 




  
2
  



  
1
  




6



     my $me = shift; 




312




2





 





 





 





 





20



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




313




 





 





 





 





 





 



 } 




314




 





 





 





 





 





 



   




315




 





 





 





 





 





 



 sub selectrow_hashref { 




316



  
0
  




 





 




  
0
  



  
1
  




0



     my $me = shift; 




317




0





 





 





 





 





0



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




318




 





 





 





 





 





 



 } 




319




 





 





 





 





 





 



   




320




 





 





 





 





 





 



 sub selectall_arrayref { 




321




6





 





 




  
6
  



  
1
  




15



     my $me = shift; 




322




6





 





 





 





 





45



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




323




 





 





 





 





 





 



 } 




324




 





 





 





 





 





 



   




325




 





 





 





 





 





 



 =head3 C 




326




 





 





 





 





 





 



   




327




 





 





 





 





 





 



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




328




 





 





 





 





 





 



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




329




 





 





 





 





 





 



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




330




 





 





 





 





 





 



   




331




 





 





 





 





 





 



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




332




 





 





 





 





 





 



   




333




 





 





 





 





 





 



 =cut 




334




 





 





 





 





 





 



   




335




 





 





 





 





 





 



 sub do { 




336




6





 





 




  
6
  



  
1
  




625



     my $me = shift; 




337




6





 





 





 





 





47



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




338




 





 





 





 





 





 



 } 




339




 





 





 





 





 





 



   




340




 





 





 





 





 





 



 =head3 C 




341




 





 





 





 





 





 



   




342




 





 





 





 





 





 



   $dbo->table_info($table); 




343




 





 





 





 





 





 



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




344




 





 





 





 





 





 



   $dbo->table_info($table_object); 




345




 





 





 





 





 





 



   




346




 





 





 





 





 





 



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




347




 





 





 





 





 





 



 Mainly for internal use. 




348




 





 





 





 





 





 



   




349




 





 





 





 





 





 



 =cut 




350




 





 





 





 





 





 



   




351




 





 





 





 





 





 



 sub table_info { 




352




33





 





 




  
33
  



  
1
  




83



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




353




33




  
100
  




 





 





 





96



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




354




 





 





 





 





 





 



   




355




31





 





 





 





 





49



     my $schema; 




356




31




  
100
  




 





 





 





90



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




357




2




  
100
  




 





 





 





12



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




358




1





 





 





 





 





5



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




359




 





 





 





 





 





 



     } else { 




360




29




  
100
  




 





 





 





197



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




361




29





 




  
100
  




 





 





207



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




362




 





 





 





 





 





 



   




363




 





 





 





 





 





 



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




364




29




  
100
  



  
100
  




 





 





237



             unless exists $me->{TableInfo}{$schema // ''}{$table}; 




365




 





 





 





 





 





 



     } 




366




28





 




  
100
  




 





 





187



     return ($schema, $table, $me->{TableInfo}{$schema // ''}{$table}); 




367




 





 





 





 





 





 



 } 




368




 





 





 





 





 





 



   




369




 





 





 





 





 





 



 =head3 C 




370




 





 





 





 





 





 



   




371




 





 





 





 





 





 



 Disconnect both the I & I connections to the database. 




372




 





 





 





 





 





 



   




373




 





 





 





 





 





 



 =cut 




374




 





 





 





 





 





 



   




375




 





 





 





 





 





 



 sub disconnect { 




376




4





 





 




  
4
  



  
1
  




561



     my $me = shift; 




377




4




  
100
  




 





 





 





19



     if ($me->{dbh}) { 




378




3





 





 





 





 





71



         $me->{dbh}->disconnect; 




379




3





 





 





 





 





73



         undef $me->{dbh}; 




380




 





 





 





 





 





 



     } 




381




4




  
100
  




 





 





 





18



     if ($me->{rdbh}) { 




382




3





 





 





 





 





79



         $me->{rdbh}->disconnect; 




383




3





 





 





 





 





46



         undef $me->{rdbh}; 




384




 





 





 





 





 





 



     } 




385




4





 





 





 





 





19



     delete $me->{TableInfo}; 




386




4





 





 





 





 





14



     return; 




387




 





 





 





 





 





 



 } 




388




 





 





 





 





 





 



   




389




 





 





 





 





 





 



 =head2 Common Methods 




390




 





 





 





 





 





 



   




391




 





 





 





 





 





 



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




392




 





 





 





 





 





 



   




393




 





 





 





 





 





 



 =head3 C 




394




 





 





 





 





 





 



   




395




 





 





 





 





 





 



 This C object. 




396




 





 





 





 





 





 



   




397




 





 





 





 





 





 



 =head3 C 




398




 





 





 





 





 





 



   




399




 





 





 





 





 





 



 The I C handle. 




400




 





 





 





 





 





 



   




401




 





 





 





 





 





 



 =head3 C 




402




 





 





 





 





 





 



   




403




 





 





 





 





 





 



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




404




 





 





 





 





 





 



   




405




 





 





 





 





 





 



 =cut 




406




 





 





 





 





 





 



   




407




2





 





 




  
2
  



  
1
  




187483



 sub dbo { $_[0] } 




408




 





 





 





 





 





 



   




409




 





 





 





 





 





 



 sub _handle { 




410




497





 





 




  
497
  




 





1126



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




411




 





 





 





 





 





 



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




412




497




  
100
  



  
 66
  




 





 





2699



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




413




497




  
100
  




 





 





 





1342



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




414




497




  
100
  




 





 





 





1343



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




415




 





 





 





 





 





 



     # Automatically reconnect, but only if possible and needed 




416




495




  
100
  



  
100
  




 





 





1494



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




417




495





 





 





 





 





4516



     $me->{$d}; 




418




 





 





 





 





 





 



 } 




419




 





 





 





 





 





 



   




420




 





 





 





 





 





 



 sub dbh { 




421




34





 





 




  
34
  



  
1
  




66



     my $me = shift; 




422




34





 




  
 50
  




 





 





111



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




423




 





 





 





 





 





 



 } 




424




 





 





 





 





 





 



   




425




 





 





 





 





 





 



 sub rdbh { 




426




463





 





 




  
463
  



  
1
  




809



     my $me = shift; 




427




463





 





 





 





 





1278



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




428




 





 





 





 





 





 



 } 




429




 





 





 





 





 





 



   




430




 





 





 





 





 





 



 =head3 C 




431




 





 





 





 





 





 



   




432




 





 





 





 





 





 



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




433




 





 





 





 





 





 



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




434




 





 





 





 





 





 



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




435




 





 





 





 





 





 



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




436




 





 





 





 





 





 



   




437




 





 





 





 





 





 



 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. 




438




 





 





 





 





 





 



   




439




 





 





 





 





 





 



 =head2 Available C options 




440




 





 





 





 





 





 



   




441




 





 





 





 





 





 



 =over 




442




 





 





 





 





 





 



   




443




 





 





 





 





 





 



 =item C 




444




 





 





 





 





 





 



   




445




 





 





 





 





 





 



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




446




 





 





 





 





 





 



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




447




 





 





 





 





 





 



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




448




 





 





 





 





 





 



 Defaults to C. 




449




 





 





 





 





 





 



   




450




 





 





 





 





 





 



 =item C 




451




 





 





 





 





 





 



   




452




 





 





 





 





 





 



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




453




 





 





 





 





 





 



 The query will only be executed automatically once. 




454




 





 





 





 





 





 



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




455




 





 





 





 





 





 



 Defaults to C. 




456




 





 





 





 





 





 



   




457




 





 





 





 





 





 



 =item C 




458




 





 





 





 





 





 



   




459




 





 





 





 





 





 



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




460




 





 





 





 





 





 



 Defaults to C<0> (silent). 




461




 





 





 





 





 





 



   




462




 





 





 





 





 





 



 =item C 




463




 





 





 





 





 





 



   




464




 





 





 





 





 





 



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




465




 





 





 





 





 





 



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




466




 





 





 





 





 





 



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




467




 





 





 





 





 





 



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




468




 





 





 





 





 





 



 Defaults to C<'simple'>. 




469




 





 





 





 





 





 



   




470




 





 





 





 





 





 



 =item C 




471




 





 





 





 





 





 



   




472




 





 





 





 





 





 



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




473




 





 





 





 





 





 



   




474




 





 





 





 





 





 



 =item C 




475




 





 





 





 





 





 



   




476




 





 





 





 





 





 



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




477




 





 





 





 





 





 



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




478




 





 





 





 





 





 



   




479




 





 





 





 





 





 



 =back 




480




 





 





 





 





 





 



   




481




 





 





 





 





 





 



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




482




 





 





 





 





 





 



   




483




 





 





 





 





 





 



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




484




 





 





 





 





 





 



   




485




 





 





 





 





 





 



 =cut 




486




 





 





 





 





 





 



   




487




 





 





 





 





 





 



 sub config { 




488




609





 





 




  
609
  



  
1
  




145226



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




489




609




  
100
  




 





 





 





1599



     if (@_ > 2) { 




490




 





 





 





 





 





 



         return ref $me 




491




46




  
100
  



  
100
  




 





 





563



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




492




 





 





 





 





 





 



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




493




 





 





 





 





 





 



     } 




494




 





 





 





 





 





 



     return ref $me 




495




563




  
100
  



  
100
  




 





 





2914



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




496




 





 





 





 





 





 



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




497




 





 





 





 





 





 



 } 




498




 





 





 





 





 





 



   




499




 





 





 





 





 





 



 sub STORABLE_freeze { 




500




16





 





 




  
16
  



  
0
  




377



     my $me = $_[0]; 




501




16




  
100
  



  
 66
  




 





 





535



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




502




 





 





 





 





 





 



   




503




 





 





 





 





 





 



     # Stash the unfreezable bits 




504




8





 





 





 





 





14



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




 




32





 





 





 





 





62



   




505




8




  
 50
  




 





 





 





32



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




506




8




  
 50
  




 





 





 





14



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




507




8





 





 





 





 





13



     for (qw(ConnectArgs ConnectReadOnlyArgs)) { 




508




16




  
 50
  




 





 





 





32



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




509




 





 





 





 





 





 



     } 




510




 





 





 





 





 





 



   




511




8





 





 





 





 





12



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




512




 





 





 





 





 





 



   




513




 





 





 





 





 





 



     # Restore the stashed bits 




514




8





 





 





 





 





84



     for (qw(dbh rdbh ConnectArgs ConnectReadOnlyArgs)) { 




515




32




  
100
  




 





 





 





51



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




516




 





 





 





 





 





 



     } 




517




 





 





 





 





 





 



   




518




8





 





 





 





 





258



     return $frozen; 




519




 





 





 





 





 





 



 } 




520




 





 





 





 





 





 



   




521




 





 





 





 





 





 



 sub STORABLE_thaw { 




522




8





 





 




  
8
  



  
0
  




980



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




523




 





 





 





 





 





 



   




524




8





 





 





 





 





9



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




 




8





 





 





 





 





17



   




525




8





 





 





 





 





206



     for (qw(ConnectArgs ConnectReadOnlyArgs)) { 




526




16




  
 50
  




 





 





 





189



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




527




 





 





 





 





 





 



     } 




528




 





 





 





 





 





 



 } 




529




 





 





 





 





 





 



   




530




 





 





 





 





 





 



 sub DESTROY { 




531




17





 





 




  
17
  




 





457



     undef %{$_[0]}; 




 




17





 





 





 





 





339



   




532




 





 





 





 





 





 



 } 




533




 





 





 





 





 





 



   




534




 





 





 





 





 





 



 1; 




535




 





 





 





 





 





 



   




536




 





 





 





 





 





 



 __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 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);
        $schema //= $me->{dbd_class}->_get_table_schema($me, $table);

        $me->{dbd_class}->_get_table_info($me, $schema, $table)
            unless exists $me->{TableInfo}{$schema // ''}{$table};
    }
    return ($schema, $table, $me->{TableInfo}{$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};

    # Stash the unfreezable bits
    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);

    # Restore the stashed bits
    for (qw(dbh rdbh ConnectArgs ConnectReadOnlyArgs)) {
        $me->{$_} = $stash{$_} if defined $stash{$_};
    }

    return $frozen;
}

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

    %$me = %{ Storable::thaw($frozen) };
    for (qw(ConnectArgs ConnectReadOnlyArgs)) {
        $me->{$_} = push(@ConnectArgs, $me->{$_}) - 1 if exists $me->{$_};
    }
}

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

1;

__END__