view release on metacpan or  search on metacpan

lib/Alzabo/Driver.pm  view on Meta::CPAN

    my %p = @_;

    eval "use Alzabo::Driver::$p{rdbms}";
    Alzabo::Exception::Eval->throw( error => $@ ) if $@;

    my $self = "Alzabo::Driver::$p{rdbms}"->new(@_);

    $self->{schema} = $p{schema};

    return $self;
}

sub available { __PACKAGE__->subclasses }

sub _ensure_valid_dbh
{
    my $self = shift;

    unless ( $self->{dbh} )
    {
        my $sub = (caller(1))[3];
        Alzabo::Exception::Driver->throw( error => "Cannot call $sub before calling connect." );
    }

    $self->{dbh} = $self->_dbi_connect( $self->{connect_params} )
        if $$ != $self->{connect_pid};
}

sub quote
{
    my $self = shift;

    $self->_ensure_valid_dbh;

    return $self->{dbh}->quote(@_);
}

sub quote_identifier
{
    my $self = shift;

    $self->_ensure_valid_dbh;

    return $self->{dbh}->quote_identifier(@_);
}

sub rows
{
    my $self = shift;

    $self->_ensure_valid_dbh;

    my %p = @_;

    my $sth = $self->_prepare_and_execute(%p);

    my @data;
    eval
    {
        my @row;
        $sth->bind_columns( \ (@row[ 0..$#{ $sth->{NAME_lc} } ] ) );

        push @data, [@row] while $sth->fetch;

        $sth->finish;
    };
    if ($@)
    {
        my @bind = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [$p{bind}] ) : ();
        Alzabo::Exception::Driver->throw( error => $@,
                                          sql => $p{sql},
                                          bind => \@bind );
    }

    return wantarray ? @data : $data[0];
}

sub rows_hashref
{
    my $self = shift;
    my %p = @_;

    $self->_ensure_valid_dbh;

    my $sth = $self->_prepare_and_execute(%p);

    my @data;

    eval
    {
        my %hash;
        $sth->bind_columns( \ ( @hash{ @{ $sth->{NAME_uc} } } ) );

        push @data, {%hash} while $sth->fetch;

        $sth->finish;
    };
    if ($@)
    {
        my @bind = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [$p{bind}] ) : ();
        Alzabo::Exception::Driver->throw( error => $@,
                                          sql => $p{sql},
                                          bind => \@bind );
    }

    return @data;
}

sub one_row
{
    my $self = shift;
    my %p = @_;

    $self->_ensure_valid_dbh;

    my $sth = $self->_prepare_and_execute(%p);

    my @row;
    eval
    {
        @row = $sth->fetchrow_array;
        $sth->finish;
    };
    if ($@)
    {
        my @bind = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [$p{bind}] ) : ();
        Alzabo::Exception::Driver->throw( error => $@,
                                          sql => $p{sql},
                                          bind => \@bind );
    }

    return wantarray ? @row : $row[0];
}

sub one_row_hash
{
    my $self = shift;
    my %p = @_;

    $self->_ensure_valid_dbh;

    my $sth = $self->_prepare_and_execute(%p);

    my %hash;
    eval
    {
        my @row = $sth->fetchrow_array;
        @hash{ @{ $sth->{NAME_uc} } } = @row if @row;
        $sth->finish;
    };
    if ($@)
    {
        my @bind = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [$p{bind}] ) : ();
        Alzabo::Exception::Driver->throw( error => $@,
                                          sql => $p{sql},
                                          bind => \@bind );
    }

    return %hash;
}

sub column
{
    my $self = shift;
    my %p = @_;

    $self->_ensure_valid_dbh;

    my $sth = $self->_prepare_and_execute(%p);

    my @data;
    eval
    {
        my @row;
        $sth->bind_columns( \ (@row[ 0..$#{ $sth->{NAME_lc} } ] ) );
        push @data, $row[0] while ($sth->fetch);
        $sth->finish;
    };
    if ($@)
    {
        my @bind = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [$p{bind}] ) : ();
        Alzabo::Exception::Driver->throw( error => $@,
                                          sql => $p{sql},
                                          bind => \@bind );
    }

    return wantarray ? @data : $data[0];
}

use constant _PREPARE_AND_EXECUTE_SPEC => { sql => { type => SCALAR },
                                            bind => { type => UNDEF | SCALAR | ARRAYREF,
                                                      optional => 1 },
                                          };

sub _prepare_and_execute
{
    my $self = shift;

    validate( @_, _PREPARE_AND_EXECUTE_SPEC );
    my %p = @_;

    Alzabo::Exception::Driver->throw( error => "Attempt to access the database without database handle.  Was ->connect called?" )
        unless $self->{dbh};

    my @bind = exists $p{bind} ? ( ref $p{bind} ? @{ $p{bind} } : $p{bind} ) : ();

    my $sth;
    eval
    {
        $sth = $self->{dbh}->prepare( $p{sql} );
        $sth->execute(@bind);
    };
    if ($@)
    {
        Alzabo::Exception::Driver->throw( error => $@,
                                          sql => $p{sql},
                                          bind => \@bind );
    }

    return $sth;
}

sub do
{
    my $self = shift;
    my %p = @_;

    $self->_ensure_valid_dbh;

    my $sth = $self->_prepare_and_execute(%p);

    my $rows;
    eval
    {
        $rows = $sth->rows;
        $sth->finish;
    };
    if ($@)
    {
        my @bind = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [$p{bind}] ) : ();
        Alzabo::Exception::Driver->throw( error => $@,
                                          sql => $p{sql},
                                          bind => \@bind );
    }

    return $rows;
}

sub tables
{
    my $self = shift;

    $self->_ensure_valid_dbh;

    my @t = eval {  $self->{dbh}->tables( '', '', '%', 'table' ); };
    Alzabo::Exception::Driver->throw( error => $@ ) if $@;

    return @t;
}

sub schemas
{
    my $self = shift;

    shift()->_virtual;
}

sub _make_dbh
{
    my $self = shift;

    return $self->_dbi_connect( $self->_connect_params(@_) );
}

sub _dbi_connect
{
    my $self = shift;
    my $connect = shift;

    my $dbh = eval { DBI->connect(@$connect) };

    Alzabo::Exception::Driver->throw( error => $@ ) if $@;
    Alzabo::Exception::Driver->throw( error => "Unable to connect to database\n" ) unless $dbh;

    $self->{connect_params} = $connect;
    $self->{connect_pid} = $$;

    return $dbh;
}

sub statement
{
    my $self = shift;

    $self->_ensure_valid_dbh;

    return Alzabo::DriverStatement->new( dbh => $self->{dbh},
                                         @_ );
}

sub statement_no_execute
{
    my $self = shift;

lib/Alzabo/Driver.pm  view on Meta::CPAN

        require Carp;
        Carp::cluck( "$caller called commit without corresponding begin_work call\n" );
    }

    # Don't actually commit until we reach 'uber-commit'
    return if $self->{tran_count};

    unless ( $self->{dbh}->{AutoCommit} )
    {
        $self->{dbh}->commit;
    }
    $self->{dbh}->{AutoCommit} = 1;

    $self->{tran_count} = undef;
}

sub get_last_id
{
    shift()->_virtual;
}

sub driver_id
{
    shift()->_virtual;
}

sub _virtual
{
    my $self = shift;

    my $sub = (caller(1))[3];
    Alzabo::Exception::VirtualMethod->throw( error =>
                                             "$sub is a virtual method and must be subclassed in " . ref $self );
}

package Alzabo::DriverStatement;

use strict;
use vars qw($VERSION);

use Alzabo::Exceptions;

use DBI;

use Params::Validate qw( validate UNDEF SCALAR ARRAYREF );
Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } );

$VERSION = '0.1';

sub new
{
    my $self = shift->new_no_execute(@_);

    $self->execute;

    return $self;
}

use constant NEW_NO_EXECUTE_SPEC => { dbh   => { can => 'prepare' },
                                      sql   => { type => SCALAR },
                                      bind  => { type => SCALAR | ARRAYREF,
                                                 optional => 1 },
                                      limit => { type => UNDEF | ARRAYREF,
                                                 optional => 1 },
                                    };

sub new_no_execute
{
    my $proto = shift;
    my $class = ref $proto || $proto;

    my %p = validate( @_, NEW_NO_EXECUTE_SPEC );

    my $self = bless {}, $class;

    $self->{limit} = $p{limit} ? $p{limit}[0] : 0;
    $self->{offset} = $p{limit} && $p{limit}[1] ? $p{limit}[1] : 0;
    $self->{rows_fetched} = 0;

    eval
    {
        $self->{sth} = $p{dbh}->prepare( $p{sql} );

        $self->{bind} = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [ $p{bind} ] ) : [];
    };

    Alzabo::Exception::Driver->throw( error => $@,
                                      sql => $p{sql},
                                      bind => $self->{bind} ) if $@;

    return $self;
}

sub execute
{
    my $self = shift;

    eval
    {
        $self->{sth}->finish if $self->{sth}->{Active};
        $self->{rows_fetched} = 0;
        $self->{sth}->execute( @_ ? @_ : @{ $self->{bind} } );

        $self->{result} = [];
        $self->{count} = 0;

        $self->{sth}->bind_columns
            ( \ ( @{ $self->{result} }[ 0..$#{ $self->{sth}->{NAME_lc} } ] ) );
    };
    Alzabo::Exception::Driver->throw( error => $@,
                                      sql => $self->{sth}{Statement},
                                      bind => $self->{bind} ) if $@;
}

sub execute_no_result
{
    my $self = shift;

    eval
    {
        $self->{sth}->execute(@_);
    };
    Alzabo::Exception::Driver->throw( error => $@,
                                      sql => $self->{sth}{Statement},
                                      bind => $self->{bind} ) if $@;
}

sub next
{
    my $self = shift;
    my %p = @_;

    return unless $self->{sth}->{Active};

    my $active;
    eval
    {
        do
        {
            $active = $self->{sth}->fetch;
        } while ( $active && $self->{rows_fetched}++ < $self->{offset} );
    };

    Alzabo::Exception::Driver->throw( error => $@,
                                      sql => $self->{sth}{Statement},
                                      bind => $self->{bind} ) if $@;

    return unless $active;

    $self->{count}++;

    return wantarray ? @{ $self->{result} } : $self->{result}[0];
}

sub next_as_hash
{
    my $self = shift;

    return unless $self->{sth}->{Active};

    my $active;
    eval
    {
        do
        {
            $active = $self->{sth}->fetch;
        } while ( $active && $self->{rows_fetched}++ < $self->{offset} );
    };
    Alzabo::Exception::Driver->throw( error => $@,
                                      sql => $self->{sth}{Statement},
                                      bind => $self->{bind} ) if $@;

    return unless $active;

    my %hash;
    @hash{ @{ $self->{sth}->{NAME_lc} } } = @{ $self->{result} };

    $self->{count}++;

    return %hash;
}
*next_hash = \&next_as_hash;

sub all_rows
{
    my $self = shift;

    my @rows;

    while (my @row = $self->next)
    {
        push @rows, @row > 1 ? \@row : $row[0];
    }

    $self->{count} = scalar @rows;

    return @rows;
}

sub all_rows_hash
{
    my $self = shift;

    my @rows;

    while (my %h = $self->next_as_hash)
    {
        push @rows, \%h;
    }

    $self->{count} = scalar @rows;

    return @rows;
}

sub bind
{
    my $self = shift;

    return @{ $self->{bind} };
}

sub count { $_[0]->{count} }

sub DESTROY
{
    my $self = shift;

    local $@;
    eval { $self->{sth}->finish if $self->{sth}; };
    Alzabo::Exception::Driver->throw( error => $@ ) if $@;
}

1;

__END__

=head1 NAME

Alzabo::Driver - Alzabo base class for RDBMS drivers

=head1 SYNOPSIS

  use Alzabo::Driver;

  my $driver = Alzabo::Driver->new( rdbms => 'MySQL',
                                    schema => $schema );

=head1 DESCRIPTION

This is the base class for all Alzabo::Driver modules.  To instantiate
a driver call this class's C<new()> method.  See L<SUBCLASSING
Alzabo::Driver> for information on how to make a driver for the RDBMS
of your choice.

This class throws several, exceptions, one of which,
C<Alzabo::Exception::Driver>, has additional methods not present in
other exception classes.  See L<Alzabo::Exception::Driver METHODS> for
a description of these methods.

=head1 METHODS

=head2 available

Returns a list of names representing the available C<Alzabo::Driver>
subclasses.  Any one of these names would be appropriate as the
"rdbms" parameter for the L<C<< Alzabo::Driver->new
>>|Alzabo::Driver/new> method.

=head2 new

The constructor takes the following parameters:

=over 4

=item * rdbms => $rdbms_name

The name of the RDBMS being used.

=item * schema => C<Alzabo::Schema> object

=back

It returns a new C<Alzabo::Driver> object of the appropriate subclass.

Throws: L<C<Alzabo::Exception::Eval>|Alzabo::Exceptions>

=head2 tables

Returns a list of strings containing the names of the tables in the
database.  See the C<DBI> documentation of the C<DBI-E<gt>tables>
method for more details.

Throws: L<C<Alzabo::Exception::Driver>|Alzabo::Exceptions>

=head2 handle ($optional_dbh)

This method takes one optional parameter, a connected DBI handle.  If
this is given, then this handle is the new handle for the driver.

It returns the active database handle.

Throws: L<C<Alzabo::Exception::Params>|Alzabo::Exceptions>

=head2 Data Retrieval methods

Some of these methods return lists of data (the
L<C<rows>|Alzabo::Driver/rows>,
L<C<rows_hashref>|Alzabo::Driver/rows_hashref>, and
L<C<column>|Alzabo::Driver/column> methods).  With large result sets,
this can use a lot memory as these lists are created in memory before
being returned to the caller.  To avoid this, it may be desirable to
use the functionality provided by the
L<C<Alzabo::DriverStatement>|Alzabo::DriverStatement> class, which
allows you to fetch results one row at a time.

These methods all accept the following parameters:

=over 4

=item * sql => $sql_string

=item * bind => $bind_value or \@bind_values

=item * limit => [ $max, optional $offset ] (optional)

The C<$offset> defaults to 0.

This parameter has no effect for the methods that return only one
row.  For the others, it causes the drivers to skip C<$offset> rows
and then return only C<$max> rows.  This is useful if the RDBMS being
used does not support C<LIMIT> clauses.

=back

=head2 rows

Returns an array of array references containing the data requested.

=head2 rows_hashref

Returns an array of hash references containing the data requested.
The hash reference keys are the columns being selected.  All the key
names are in uppercase.

=head2 one_row

Returns an array or scalar containing the data returned, depending on
context.

=head2 one_row_hash

Returns a hash containing the data requested.  The hash keys are the
columns being selected.  All the key names are in uppercase.

=head2 column

Returns an array containing the values for the first column of each
row returned.

=head2 do

Use this for non-SELECT SQL statements.

Returns the number of rows affected.

Throws: L<C<Alzabo::Exception::Driver>|Alzabo::Exceptions>

=head2 statement

This methods returns a new
L<C<Alzabo::DriverStatement>|Alzabo::DriverStatement> handle, ready to
return data via the L<C<< Alzabo::DriverStatement->next()
>>|Alzabo::DriverStatement/next> or L<C<<
Alzabo::DriverStatement->next_as_hash()
>>|Alzabo::DriverStatement/next_as_hash> methods.

Throws: L<C<Alzabo::Exception::Driver>|Alzabo::Exceptions>

=head2 rdbms_version

Returns the version string of the database backend currently in use.
The form of this string will vary depending on which driver subclass
is being used.

=head2 quote (@strings)

This methods calls the underlying DBI handles C<quote()> method on the
array of strings provided, and returns the quoted versions.

=head2 quote_identifier (@strings)

This methods calls the underlying DBI handles C<quote_identifier()>
method on the array of strings provided, and returns the quoted
versions.

=head1 Alzabo::DriverStatement

This class is a wrapper around C<DBI>'s statement handles.  It finishes
automatically as appropriate so the end user does need not worry about
doing this.

=head2 next

Use this method in a while loop to fetch all the data from a
statement.

Returns an array containing the next row of data for statement or an
empty list if no more data is available.

Throws: L<C<Alzabo::Exception::Driver>|Alzabo::Exceptions>

=head2 next_as_hash

For backwards compatibility, this is also available as C<next_hash()>.

Returns a hash containing the next row of data for statement or an
empty list if no more data is available.  All the keys of the hash
will be lowercased.

Throws: L<C<Alzabo::Exception::Driver>|Alzabo::Exceptions>

=head2 all_rows

If the select for which this statement is cursor was for a single
column (or aggregate value), then this method returns an array
containing each B<remaining> value from the database.

Otherwise, it returns an array of array references, each one
containing a returned row from the database.

Throws: L<C<Alzabo::Exception::Driver>|Alzabo::Exceptions>

=head2 all_rows_hash

Returns an array of hashes, each hash representing a single row
returned from the database.  The hash keys are all in lowercase.

Throws: L<C<Alzabo::Exception::Driver>|Alzabo::Exceptions>

=head2 execute (@bind_values)

Executes the associated statement handle with the given bound
parameters.  If the statement handle is still active (it was
previously executed and has more data left) then its C<finish()>
method will be called first.

Throws: L<C<Alzabo::Exception::Driver>|Alzabo::Exceptions>

=head2 count

Returns the number of rows returned so far.

=head1 Alzabo::Exception::Driver METHODS

In addition to the methods inherited from
L<C<Exception::Class::Base>|Exception::Class::Base>, objects in this
class also contain several methods specific to this subclass.

=head2 sql

Returns the SQL statement in use at the time the error occurred, if
any.

=head2 bind

Returns an array reference contaning the bound parameters for the SQL
statement, if any.

=head1 SUBCLASSING Alzabo::Driver

To create a subclass of C<Alzabo::Driver> for your particular RDBMS is
fairly simple.  First of all, there must be a C<DBD::*> driver for it,
as C<Alzabo::Driver> is built on top of C<DBI>.

Here's a sample header to the module using a fictional RDBMS called FooDB:

 package Alzabo::Driver::FooDB;

 use strict;
 use vars qw($VERSION);

 use Alzabo::Driver;

 use DBI;
 use DBD::FooDB;

 use base qw(Alzabo::Driver);

The next step is to implement a C<new> method and the methods listed
under L<Virtual Methods>.  The C<new> method should look a bit like
this:

 1:  sub new
 2:  {
 3:      my $proto = shift;
 4:      my $class = ref $proto || $proto;
 5:      my %p = @_;
 6:
 7:      my $self = bless {}, $class;
 8:
 9:      return $self;
 10:  }

The hash %p contains any values passed to the
C<Alzabo::Driver-E<gt>new> method by its caller.

Lines 1-7 should probably be copied verbatim into your own C<new>
method.  Line 5 can be deleted if you don't need to look at the
parameters.

Look at the included C<Alzabo::Driver> subclasses for examples.  Feel
free to contact me for further help if you get stuck.  Please tell me
what database you're attempting to implement, what its DBD::* driver
is, and include the code you've written so far.

=head2 Virtual Methods

The following methods are not implemented in C<Alzabo::Driver> itself
and must be implemented in a subclass.

=head3 Parameters for connect(), create_database(), and drop_database()

=over 4