/usr/local/CPAN/Data-All/Data/All/IO/Database.pm

• package Data::All::IO::Database
  • open
  • close
  • nextrecord
  • getrecord_hash
  • getrecord_array
  • getrecords
  • putfields
  • putrecord
  • putrecords
  • count
  • _generate_query_vars
  • _create_dbh
  • _create_sth
  • _db_connect
  • _create_connect
  • _extract_fields
• EOF

package Data::All::IO::Database;

#   $Id: Database.pm,v 1.1.1.1 2005/05/10 23:56:20 dmandelbaum Exp $


use strict;
no warnings;

use Data::All::IO::Base;
use DBI;

our $VERSION = 0.16;

attribute '__DBH';
attribute '__STH';

attribute 'format';
attribute 'fields';
attribute 'ioconf';
attribute   'path';

attribute 'is_open'             => 0;

sub open($)
{
    my $self = shift;
    my $query = $self->path()->[3];
    
    unless ($self->is_open())
    {
        #warn " -> Opening database connection for ", $self->ioconf()->{'perm'};
        #warn " -> path:", join ', ', @{ $self->path() };
        #warn " -> format:", $self->format()->{'type'};
        #warn " -> io:", $self->ioconf->{'type'};
        
        $self->_create_dbh();               #   Open DB connection
        if ($self->ioconf()->{'perm'} =~ /r/)
        {
            #warn " -> Executing query";
            
            my $sth = $self->__DBH()->prepare($query);
            $sth->execute() or die "Can't execute statement: $DBI::errstr";
            $self->__STH($sth);
            $self->_extract_fields();
        }
        
        $self->is_open(1);
    }
    
    return $self->is_open();
}

sub close()
{
    my $self = shift;

    $self->__STH()->finish()
    , $self->__DBH()->commit()     #   NOTE: uncomment this if autocommit = 0
        if ($self->__STH());

    $self->__DBH()->disconnect();
    $self->is_open(0);
    
    return;
}

sub nextrecord() { $_[0]->__STH()->fetchrow_hashref() }

sub getrecord_hash()
{
    my $self = shift; 
    my $sth = $self->__STH();

    return $sth->fetchrow_hashref();
}

sub getrecord_array() 
{ 
    my $self = shift; 
    my $record = $self->__STH()->fetchrow_arrayref();

    return !wantarray ? $record : @{ $record };
}

sub getrecords
{ 
    my $self = shift;
    
    return undef unless ($self->__STH()->rows);
    
    my (@records);
    while (my $ref = $self->__STH()->fetchrow_hashref())
    {
        push (@records, $ref);
    }

    return !wantarray ? \@records : @records;
    
}

sub putfields()
{
    my $self = shift;
    
    #   We don't do nothin' with fields for the database
    
    #   IDEA: Maybe we could use this call for creating a table
}


sub putrecord($;\%)
{
    my $self = shift;
    my ($record, $options) = @_;

    
    my @vars = $self->_generate_query_vars(
                            $options, $self->hash_to_array($record));
   
    #print join(':', @vars), "\n";
    
    $self->__STH($self->__DBH()->prepare($self->path()->[3]))
        unless $self->__STH();

    $self->__STH()->execute(@vars);
    
    return 1;
}


sub putrecords()
{
    my $self = shift;
    my ($records, $options) = @_;
    
    my $query = $self->path()->[3];

    
    die("$self->putrecords() needs records") unless ($#{ $records }+1);
        
    $self->__STH($self->__DBH()->prepare($query));
    
    my $record;
    foreach my $rec (@{ $records })
    {
        $self->putrecord($rec, $options);
    }
    
    #   Close the statement handle
    $self->__STH()->finish();
    
}

sub count()
#   TODO: Refactor this count() functionality.
#   What about INSERT queries. We could keep track of how many were
#   successfully inserted. 
{
    my $self = shift;
    my $query = $self->path()->[3];
    my ($sth, $ref, $count);
    
    return $count unless($self->ioconf()->{'perm'} =~ /^r/);
    
    $query =~ s/SELECT\s.+?\sFROM/SELECT COUNT(*) as cnt FROM/im;
    
    return undef unless ($sth = $self->__DBH()->prepare($query));
    
    $count = $self->__STH()->execute() or return undef;
    
    $self->__STH()->finish();
    
    return $count;
}





sub _generate_query_vars($$)
#   Create an ordered array of values to use in a DBI->execute() call to
#   replace '?' in the query.
{
    my $self = shift;
    my ($options, $vars) = @_;
    my @vars;
    
    #   TODO: Move arrayref checking to some form of option parser 
    
    if (defined($options->{'extra_pre_vars'}))
    {
        my @pre_vars = (ref($options->{'extra_pre_vars'}) eq 'ARRAY')
            ? @{ $options->{'extra_pre_vars'} }
            : ($options->{'extra_pre_vars'});
            
        #   Add the prefix values to the beginning of the array
        push(@vars, @pre_vars); 
    }
    
    #   Put the actual values into the array (in an INSERT, putrecord() will 
    #   send the ordered field values here)
    push(@vars, @{ $vars });
    
    #   Complete the array with the suffix values
    if (defined($options->{'extra_post_vars'}))
    {
        my @post_vars = (ref($options->{'extra_post_vars'}) eq 'ARRAY')
            ? @{ $options->{'extra_post_vars'} }
            : ($options->{'extra_post_vars'});
            
        #   Add the prefix values to the beginning of the array
        push(@vars, @post_vars); 
    }
         
    return wantarray ? @vars : \@vars; 
}

sub _create_dbh()
{
    my $self = shift;
    my $dbh = $self->__DBH() || $self->_db_connect();
    
    ($dbh)
        ? $self->__DBH($dbh)
        : die("Cannot create DB Connection");
        
    #$self->__DBH()->trace(2);
}

sub _create_sth()
{
    my $self = shift;
    my $sth = $self->__DBH()->prepare();
    
    ($sth)
        ? $self->__STH($sth)
        : die("Cannot prepare statement handle");
}

sub _db_connect()
{
    my $self = shift;
    return if ($self->is_open());
    #   NOTE: See line 53 if you want to set autocommit = 0
    return DBI->connect($self->_create_connect(), { PrintWarn=>1,PrintError=>1, RaiseError => 1, AutoCommit => 0 });
}

sub _create_connect()
{
    my $self = shift;
    return ($self->path()->[0],$self->path()->[1],$self->path()->[2]);
}

sub _extract_fields()
{
    my $self = shift;
    return if ($self->fields());
    
    $self->fields($self->__STH()->{'NAME'});
}



1;