Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

DBI Queries

by mt2k (Hermit)
on Dec 07, 2002 at 23:21 UTC ( #218299=snippet: print w/replies, xml ) Need Help??
Description: 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;
Replies are listed 'Best First'.
Re: DBI Queries
by diotalevi (Canon) on Dec 09, 2002 at 04:26 UTC

    I'm not going to spend the time on it right now but in general mt2k's approach to DBI really ought to be subclassed instead. This approach provides a DBI::mt2k->connect() method while not respecting any other normal DBI method. Doing this properly would involve providing a custom connect() method and just passing the default work back up to SUPER::. The docs on how to do this are in DBI (which specifically mentions how to subclass DBI) and perltoot which also goes over subclassing. I'll try to follow up with a sample later this week but for now I'd like to make sure that this is noted.

    __SIG__ use B; printf "You are here %08x\n", unpack "L!", unpack "P4", pack "L!", B::svref_2object(sub{})->OUTSIDE;
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: snippet [id://218299]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (5)
As of 2022-08-13 08:32 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?