File Coverage

lib/YAML/DBH.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package YAML::DBH;
use strict;
use Exporter;
use DBI;
use DBD::mysql;
use Carp;
use YAML;
use vars qw(@EXPORT_OK %EXPORT_TAGS @ISA $VERSION @errstr);
@ISA = qw/Exporter/;
@EXPORT_OK = qw(yaml_dbh);
%EXPORT_TAGS = ( all => \@EXPORT_OK );
$VERSION = sprintf "%d.%02d", q$Revision: 1.8 $ =~ /(\d+)/g;



sub yaml_dbh {

   # 0) MAIN VARIABLES OF INTEREST

   # 0.a) the argument
   my $arg = $_[0] or croak('yaml_dbh() missing path to yaml file argument');

   # 0.b) the main arguments to open a connect via DBI are dbsource, username, and password
   my ( $dbsource, $username, $password );

   # 0.c) what we explore inside is the conf data hashref
   my $conf;




   # 1) RESOLVE THE CONF HASHREF ITSELF
   # figure out conf data, if conf was passed as a hashref or a path string

   # 1.a) if a ref, assume a conf ref was passed (hash or array, could be both?)
   if ( ref $arg ){
      $conf = $arg;
   }
   # 1.b) otherwise assume the argument is a path string to a yaml file
   else {
      $conf = YAML::LoadFile($arg)
         or croak("yaml_dbh(), cant YAML LoadFile: '$arg'");
   }




   # 2) SCAN THE CONF HASHREF FOR REQ CONNECT DATA
   # 2.a) try mysql
   if( ! (($dbsource, $username, $password) = _findkeys_mysql($conf)) ){

      # 2.b) try sqlite
      ( $dbsource, $username, $password ) = _findkeys_sqlite($conf)

         # 2.c) or croak
         or croak("yaml_dbh() Cannot find proper params in arg '$arg' to connect via sqlite or mysql, errs: ".join(', ',@errstr));
   }



   # 3) OPEN DB HANDLE
   my $dbh = DBI->connect(
      $dbsource,
      $username,
      $password
   ) or die;

   return $dbh;
}


sub _findkeys_mysql {
   my $conf = shift;


   my $username = _findkey( $conf => qw(username uname user dbuser dbusername) )
      or push @errstr, "missing username";

   my $hostname = _findkey( $conf => qw(hostname host dbhost dbhostname) ) || 'localhost';

   my $password = _findkey( $conf => qw(password dbpass dbpassword passw dbpassw pass))
      or push @errstr, "missing password";

   my $database = _findkey( $conf => qw(database dbname databasename))
      or push @errstr, "missing database name";

   my $dbdriver = _findkey( $conf => qw(dbdriver driver db_driver) ) || 'mysql';

   (@errstr and scalar @errstr) and (warn("Errors: @errstr") and return);

   ### $database
   ### $hostname
   ### $username
   ### $password
   ### $dbdriver

   my $dbsource =  "DBI:$dbdriver:database=$database;host=$hostname";
   ### $dbsource

   return( $dbsource, $username, $password);
}

sub _findkeys_sqlite {
   my $conf = shift;

   my $abs_sqlite = _findkey( $conf => qw(abs_db abs_sqlite) )
      or ((push @errstr, "missing abs_sqlite") and return);

   my $dbdriver = _findkey( $conf => qw(dbdriver driver db_driver) ) || 'SQLite';

   my $dbsource = "dbi:$dbdriver:dbname=$abs_sqlite";
   ### $dbsource

   return ($dbsource,'','');
}



# pass it the conf hash ref, and a list of possible case insensitive key matches
sub _findkey {
   my $_hashref = shift;

   # convert the hashref
   my $c;
   map { $c->{lc($_)} = $_hashref->{$_} } keys %$_hashref;

   for my $_poss ( @_ ){
      my $poss = lc($_poss);
      if (exists $c->{$poss}){
         return $c->{$poss};
      }
   }
   return;

}

1;


__END__