CPAN::Testers::Common::DBUtils - Basic Database Wrapper

CPAN-Testers-Common-DBUtils documentation Contained in the CPAN-Testers-Common-DBUtils distribution.

Index

Code Index:

NAME

Top

CPAN::Testers::Common::DBUtils - Basic Database Wrapper

SYNOPSIS

Top

  use CPAN::Testers::Common::DBUtils;

  my $dbx = CPAN::Testers::Common::DBUtils->new(
                driver      => 'mysql',
                database    => 'testdb');

  sub errors { print STDERR "Error: $_[0], sql=$_[1]\n" }
  my $dbi = CPAN::Testers::Common::DBUtils->new(
                driver  => 'CSV',
                dbfile  => '/var/www/mysite/db
                errsub  => \&errors);

  my @arr = $dbi->get_query('array',$sql);
  my @arr = $dbi->get_query('array',$sql,$id);
  my @arr = $dbi->get_query('hash', $sql,$id);

  my $id = $dbi->id_query($sql,$id,$name);
  $dbi->do_query($sql,$id);

  $dbi->do_commit();    # where AutoCommit is disabled

  # array iterator
  my $next = $dbi->iterator('array',$sql);
  my $row = $next->();
  my $id = $row->[0];

  # hash iterator
  my $next = $dbi->iterator('hash',$sql);
  my $row = $next->();
  my $id = $row->{id};

  $value = $dbi->quote($value);

DESCRIPTION

Top

The DBUtils package is a wrapper around the database interface layer, providing a collection of methods to access and alter the data within the database, which handle any errors and abstracts these commonly called routines away from the calling program.

Known supported drivers:

  MySQL     (database)
  SQLite    (database)
  CSV       (dbfile)
  ODBC      (driver)

The keys in braces above, indicate how the name/location of the data store is passed to the wrapper and thus added to the connection string.

CONSTRUCTOR

new()

The Constructor method can be called with an anonymous hash, listing the values to be used to connect to and handle the database.

Values in the hash can be

  driver (*)
  database (+)
  dbfile (+)
  dbhost
  dbport
  dbuser
  dbpass
  errsub
  AutoCommit

(*) These entries MUST exist in the hash. (+) At least ONE of these must exist in the hash, and depend upon the driver.

Note that 'dbfile' is for use with a flat file database, such as DBD::CSV.

By default the errors are handle via croak(), however if you pass a subroutine reference that will be called instead. Parameters passed to the error subroutine are the error string, the SQL string and the list of arguments given.

AutoCommit is on by default, unless you explicitly pass 'AutoCommit => 0'.

PUBLIC INTERFACE METHODS

get_query(type,sql,<list>)
  type - 'array' or 'hash'
  sql - SQL statement
  <list> - optional additional values to be inserted into SQL placeholders

This method performs a SELECT statement and returns an array of the returned rows. Each column within the row is then accessed as an array or hash as specified by 'type'.

iterator(type,sql,<list>)
  type - 'array' or 'hash'
  sql - SQL statement
  <list> - optional additional values to be inserted into SQL placeholders

This method is used to call a SELECT statement a row at a time, via a closure. Returns a subroutine reference which can then be used to obtain each row as a array reference or hash reference. Finally returns 'undef' when no more rows can be returned.

do_query(sql,<list>)
  sql - SQL statement
  <list> - optional additional values to be inserted into SQL placeholders

This method is used to perform an SQL action statement.

id_query(sql,<list>)
  sql - SQL statement
  <list> - optional additional values to be inserted into SQL placeholders

This method is used to perform an SQL action statement. Commonly used when performing an INSERT statement, so that it returns the inserted record id.

do_commit()

Performs a commit on the transaction where AutoCommit is disabled.

quote(string)
  string - string to be quoted

This method performs a DBI quote operation, which will quote a string according to the SQL rules.

Accessor Methods

The following accessor methods are available:

* driver
* database
* dbfile
* dbhost
* dbport
* dbuser
* dbpass

All methods can be called to return the current value of the associated object variable. Note that these are only meant to be used as read-only methods.

SEE ALSO

Top

CPAN::WWW::Testers::Generator, CPAN::WWW::Testers, CPAN::Testers::WWW::Statistics

http://www.cpantesters.org/, http://stats.cpantesters.org/, http://wiki.cpantesters.org/

AUTHOR

Top

Barbie, <barbie@missbarbell.co.uk> for Miss Barbell Productions, http://www.missbarbell.co.uk/

COPYRIGHT & LICENSE

Top

  Copyright (C) 2002-2009 Barbie for Miss Barbell Productions
  All Rights Reserved.

  This module is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.
CPAN-Testers-Common-DBUtils documentation Contained in the CPAN-Testers-Common-DBUtils distribution. 
package CPAN::Testers::Common::DBUtils;

use warnings;
use strict;

use vars qw($VERSION);
$VERSION = '0.05';


# -------------------------------------
# Library Modules

use Carp;
use DBI;

use base qw(Class::Accessor::Fast);

# -------------------------------------
# The Public Interface Subs


sub new {
    my ($self, %hash) = @_;

    # check we've got our mandatory fields
    croak("$self needs a driver!")      unless($hash{driver});
    croak("$self needs a database/file!")
            unless($hash{database} || $hash{dbfile});

    # create an attributes hash
    my $dbv = {
        'driver'     => $hash{driver},
        'database'   => $hash{database},
        'dbfile'     => $hash{dbfile},
        'dbhost'     => $hash{dbhost},
        'dbport'     => $hash{dbport},
        'dbuser'     => $hash{dbuser},
        'dbpass'     => $hash{dbpass},
        'errsub'     => $hash{errsub} || \&_errsub,
        'AutoCommit' => defined $hash{AutoCommit} ? $hash{AutoCommit} : 1,
    };

    # create the object
    bless $dbv, $self;
    return $dbv;
}


sub get_query {
    my ($dbv,$type,$sql,@args) = @_;
    return ()   unless($sql);

    # if the object doesnt contain a reference to a dbh object
    # then we need to connect to the database
    $dbv = &_db_connect($dbv) if not $dbv->{dbh};

    # prepare the sql statement for executing
    my $sth;
    eval { $sth = $dbv->{dbh}->prepare($sql) };
    if($@ || !$sth) {
        $dbv->{errsub}->($dbv->{dbh}->errstr,$sql,@args);
        return ();
    }

    # execute the SQL using any values sent to the function
    # to be placed in the sql
    my $res;
    eval { $res = $sth->execute(@args); };
    if($@ || !$res) {
        $dbv->{errsub}->($sth->errstr,$sql,@args);
        return ();
    }

    my @result;
    # grab the data in the right way
    if ( $type eq 'array' ) {
        while ( my $row = $sth->fetchrow_arrayref() ) {
            push @result, [@{$row}];
        }
    } else {
        while ( my $row = $sth->fetchrow_hashref() ) {
            push @result, $row;
        }
    }

    # finish with our statement handle
    $sth->finish;
    # return the found datastructure
    return @result;
}


sub iterator {
    my ($dbv,$type,$sql,@args) = @_;
    return undef    unless($sql);

    # if the object doesnt contain a reference to a dbh object
    # then we need to connect to the database
    $dbv = &_db_connect($dbv) if not $dbv->{dbh};

    # prepare the sql statement for executing
    my $sth;
    eval { $sth = $dbv->{dbh}->prepare($sql); };
    if($@ || !$sth) {
        $dbv->{errsub}->($dbv->{dbh}->errstr,$sql,@args);
        return undef;
    }

    # execute the SQL using any values sent to the function
    # to be placed in the sql
    my $res;
    eval { $res = $sth->execute(@args); };
    if($@ || !$res) {
        $dbv->{errsub}->($sth->errstr,$sql,@args);
        return undef;
    }

    # grab the data in the right way
    if ( $type eq 'array' ) {
        return sub {
            if ( my $row = $sth->fetchrow_arrayref() ) { return $row; }
            else { $sth->finish; return; }
        }
    } else {
        return sub {
            if ( my $row = $sth->fetchrow_hashref() ) { return $row; }
            else { $sth->finish; return; }
        }
    }
}


sub do_query {
    my ($dbv,$sql,@args) = @_;
    $dbv->_do_query($sql,0,@args);
}


sub id_query {
    my ($dbv,$sql,@args) = @_;
    return $dbv->_do_query($sql,1,@args);
}

# _do_query(sql,idrequired,<list>)
#
#  sql - SQL statement
#  idrequired - true if an ID value is required on return
#  <list> - optional additional values to be inserted into SQL placeholders
#
# This method is used to perform an SQL action statement. Commonly used when
# performing an INSERT statement, so that it returns the inserted record id.

sub _do_query {
    my ($dbv,$sql,$idrequired,@args) = @_;
    my $rowid = undef;

    return $rowid   unless($sql);

    # if the object doesnt contain a refrence to a dbh object
    # then we need to connect to the database
    $dbv = &_db_connect($dbv) if not $dbv->{dbh};

    if($idrequired) {
        # prepare the sql statement for executing
        my $sth;
        eval { $sth = $dbv->{dbh}->prepare($sql); };
        if($@ || !$sth) {
            $dbv->{errsub}->($dbv->{dbh}->errstr,$sql,@args);
            return undef;
        }

        # execute the SQL using any values sent to the function
        # to be placed in the sql
        my $res;
        eval { $res = $sth->execute(@args); };
        if($@ || !$res) {
            $dbv->{errsub}->($sth->errstr,$sql,@args);
            return undef;
        }

        if($dbv->{driver} =~ /mysql/i) {
            $rowid = $dbv->{dbh}->{mysql_insertid};
        } else {
            my $row;
            $rowid = $row->[0]  if( $row = $sth->fetchrow_arrayref() );
        }

    } else {
        eval { $dbv->{dbh}->do($sql, undef, @args) };
        if ( $@ ) {
            $dbv->{errsub}->($dbv->{dbh}->errstr,$sql,@args);
            return -1;
        }

        $rowid = 1;     # technically this should be the number of succesful rows
    }


    ## Return the rowid we just used
    return $rowid;
}


sub do_commit {
    my $dbv  = shift;
    $dbv->{dbh}->commit if($dbv->{dbh});
}


sub quote {
    my $dbv  = shift;
    return undef    unless($_[0]);

    # Cant quote with DBD::CSV
    return $_[0]    if($dbv->{driver} =~ /csv/i);

    # if the object doesnt contain a refrence to a dbh object
    # then we need to connect to the database
    $dbv = &_db_connect($dbv) if not $dbv->{dbh};

    $dbv->{dbh}->quote($_[0]);
}

# -------------------------------------
# The Accessors


__PACKAGE__->mk_accessors(qw(driver database dbfile dbhost dbport dbuser dbpass));

# -------------------------------------
# The Private Subs
# These modules should not have to be called from outside this module

sub _db_connect {
    my $dbv  = shift;

    my $dsn =   'dbi:' . $dbv->{driver};
    my %options = (
        RaiseError => 1,
        AutoCommit => $dbv->{AutoCommit},
    );

    if($dbv->{driver} =~ /ODBC/) {
        # all the info is in the Data Source repository

    } elsif($dbv->{driver} =~ /SQLite/i) {
        $dsn .=     ':dbname='   . $dbv->{database} if $dbv->{database};
        $dsn .=     ';host='     . $dbv->{dbhost}   if $dbv->{dbhost};
        $dsn .=     ';port='     . $dbv->{dbport}   if $dbv->{dbport};

        $options{sqlite_handle_binary_nulls} = 1;

    } else {
        $dsn .=     ':f_dir='    . $dbv->{dbfile}   if $dbv->{dbfile};
        $dsn .=     ':database=' . $dbv->{database} if $dbv->{database};
        $dsn .=     ';host='     . $dbv->{dbhost}   if $dbv->{dbhost};
        $dsn .=     ';port='     . $dbv->{dbport}   if $dbv->{dbport};
    }

    eval {
        $dbv->{dbh} = DBI->connect($dsn, $dbv->{dbuser}, $dbv->{dbpass}, \%options);
    };

    croak("Cannot connect to DB [$dsn]: $@")    if($@);
    return $dbv;
}

sub DESTROY {
    my $dbv = shift;
#   $dbv->{dbh}->commit     if defined $dbv->{dbh};
    $dbv->{dbh}->disconnect if defined $dbv->{dbh};
}

sub _errsub {
    my ($err,$sql,@args) = @_;
    croak("err=$err, sql=[$sql], args[".join(",",map{$_ || ''} @args)."]");
}

1;

__END__