#!/usr/bin/perl -w

use strict;

use DBI;

my    $TRUE    = 1;
my    $FALSE    = 0;

my    $Wrnflg    = $TRUE;                    # Do we let warnings thro
+ugh?

# Establish WARN handler
BEGIN { $SIG{'__WARN__'} = sub { warn $_[0] if $Wrnflg } }

{
     # Set up SQLite DB filename and the SQL statement to execute
     my $Db_dbn = 'test.db';
     my $sqlsmt = 'SELECT * FROM FOO;';

     # A place to put the results
     my $retval = '';

     # Set up presumed statistics
     my $dbargs = {AutoCommit => 0,
                      PrintError => 1};

     # Build connection string
     my $dbscns = "dbi:SQLite:dbname=$Db_dbn";

     # Open the connection to the database server
     my $dbshan = DBI->connect($dbscns,"","",$dbargs);

     if ($dbshan->err())
     {
          $retval = "$DBI::errstr";
          # Do something with this error message.
     }

     # Prepare the SQL statement
     my $sqlhan = $dbshan->prepare($sqlsmt);

     if ($dbshan->err())
     {
          $retval = "$DBI::errstr";
          &debug::debug("\$retval = '\$retval'\n");
     }

     my $qryres = $sqlhan->execute;

     if ($dbshan->err())
     {
          $retval = "$DBI::errstr";
          # Do something with this error message
     }

     # Fetch data
     my @dbrref = @{ $sqlhan->fetchall_arrayref({}) };

     # Commit statement (not really an issue with SELECT but good as a
+n example
     $dbshan->commit();
     if ($dbshan->err())
     {
          $retval = "$DBI::errstr";
          # Do something with this error message
     }

     # Disconnect
     $dbshan->disconnect();
     if ($dbshan->err())
     {
          $retval = "$DBI::errstr";
          # Do something with this error message
     }

     # Display
     foreach my $dbrref (@dbrref)
     {
         print "ROW:";
         my %dbrrec = %$dbrref;
         foreach my $colnam (keys %dbrrec)
         {
             my $colval = $dbrrec{$colnam};
             print "  $colnam = '$colval'";
         }
         print "\n";
     }
}

exit;

__END__
[download]