A subroutine that returns all matching results of a DBI query in an array of hashes data struture. More subroutines provided to create a simple package to implement this. Sample code presented within 'package main;'.
Update: Suggestion by rob_au to decrease code and increase performance of get_data() applied.
#!/usr/bin/perl -w
use strict;
package DBI::mt2k;
use DBI;
use Carp;
# DBI::mt2k Constructor
sub new {
my ($class) = shift;
my $self = {};
bless $self, $class;
return $self;
}
# Destructor
sub DESTROY {
my ($self) = shift;
$self->{DB}->disconnect
if ($self->{DB});
return 1;
}
# Connect to DBI database
sub connect {
my ($self) = shift;
my %q = ( -host => "localhost",
-port => 3306,
-user => "root",
-pass => "",
@_ );
eval {
$self->{DB} = DBI->connect(
"DBI:mysql:database=$q{'-db'};
host=$q{'-host'};port=$q{'-port'}",
$q{'-user'}, $q{'-pass'},
{ RaiseError => 1,
PrintError => 0,
AutoCommit => 1 }
)
} or croak "Connection to database failed";
# We return the shortcut to the DB handler.
# This way, users can directly access DBI's functions:
# my $DB = new DBI::mt2k;
# my $DBI = $DB->connect ( ... );
# my $sth = $DBI->prepare( ... ); $DBI->execute();
return $self->{DB};
}
# Disconnect from database
sub disconnect {
my ($self) = shift;
croak "Need to connect to database first"
unless defined($self->{DB});
$self->DESTROY;
return 1;
}
# Main code: retrieve data from the DB
sub get_data {
my ($self) = shift;
my %q = ( -table => "mysql",
-cols => "*",
-query => "",
-ph => [],
@_ );
croak "Need to connect to database first"
unless defined($self->{DB});
my $sth = $self->{DB}->prepare(
"SELECT $q{'-cols'} FROM $q{'-table'} $q{'-query'}"
) or croak $self->{DB}->errstr;
$sth->execute(@{$q{'-ph'}})
or croak $self->{DB}->errstr;
my @results;
if ($q{'-cols'} eq "*") {
push @results, $_ while ($_ = $sth->fetchrow_hashref);
} else {
my @keys = split(", ", $q{'-cols'});
my %results;
@results{ @keys } = @$_
while ($_ = $sth->fetchrow_arrayref);
push @results, \%results;
}
$sth->finish
or croak $self->{DB}->errstr;
return \@results;
}
########################################################
package main;
my $DB = new DBI::mt2k;
$DB->connect( -db => "users",
-user => "mt2k",
-pass => "perlhack0r" );
# Example 1: get columns 'title' and 'nodetype'
# -ph => ['mt2k', 6608] -> placeholders for -query
my $results = $DB->get_data (
-table => "nodes",
-cols => "title, nodetype",
-query => "WHERE title=? AND node_id=?",
-ph => ['mt2k', 6608]
);
# Iterate through all results
for my $result (@{$results}) {
print $result->{title},
" has nodetype ",
$result->{nodetype}, "\n";
}
print "\n\n\n";
# Example 2: return an entire table
$results = $DB->get_data( -table => "users" );
for my $row (0 .. $#{$results}) {
print "Row #$row:\n";
while (my ($col, $val) = each %{$results->[$row]}) {
print "$col: $val\n";
}
print "\n";
}
print "\n\n\n";
# Print out the node_id of the first user returned
print $results->[0]->{node_id};
$DB->disconnect;
In reply to DBI Queries
by mt2k
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.