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


line stmt bran cond sub pod time code
1             package YAML::DBH;
2 2     2   51124 use strict;
  2         6  
  2         71  
3 2     2   12 use Exporter;
  2         4  
  2         116  
4 2     2   8140 use DBI;
  2         60704  
  2         141  
5 2     2   3244 use DBD::mysql;
  0            
  0            
6             use Carp;
7             use YAML;
8             use vars qw(@EXPORT_OK %EXPORT_TAGS @ISA $VERSION @errstr);
9             @ISA = qw/Exporter/;
10             @EXPORT_OK = qw(yaml_dbh);
11             %EXPORT_TAGS = ( all => \@EXPORT_OK );
12             $VERSION = sprintf "%d.%02d", q$Revision: 1.8 $ =~ /(\d+)/g;
13              
14              
15              
16             sub yaml_dbh {
17            
18             # 0) MAIN VARIABLES OF INTEREST
19              
20             # 0.a) the argument
21             my $arg = $_[0] or croak('yaml_dbh() missing path to yaml file argument');
22              
23             # 0.b) the main arguments to open a connect via DBI are dbsource, username, and password
24             my ( $dbsource, $username, $password );
25              
26             # 0.c) what we explore inside is the conf data hashref
27             my $conf;
28              
29              
30              
31              
32             # 1) RESOLVE THE CONF HASHREF ITSELF
33             # figure out conf data, if conf was passed as a hashref or a path string
34              
35             # 1.a) if a ref, assume a conf ref was passed (hash or array, could be both?)
36             if ( ref $arg ){
37             $conf = $arg;
38             }
39             # 1.b) otherwise assume the argument is a path string to a yaml file
40             else {
41             $conf = YAML::LoadFile($arg)
42             or croak("yaml_dbh(), cant YAML LoadFile: '$arg'");
43             }
44              
45              
46              
47              
48             # 2) SCAN THE CONF HASHREF FOR REQ CONNECT DATA
49             # 2.a) try mysql
50             if( ! (($dbsource, $username, $password) = _findkeys_mysql($conf)) ){
51              
52             # 2.b) try sqlite
53             ( $dbsource, $username, $password ) = _findkeys_sqlite($conf)
54              
55             # 2.c) or croak
56             or croak("yaml_dbh() Cannot find proper params in arg '$arg' to connect via sqlite or mysql, errs: ".join(', ',@errstr));
57             }
58              
59              
60              
61             # 3) OPEN DB HANDLE
62             my $dbh = DBI->connect(
63             $dbsource,
64             $username,
65             $password
66             ) or die;
67              
68             return $dbh;
69             }
70              
71              
72             sub _findkeys_mysql {
73             my $conf = shift;
74              
75              
76             my $username = _findkey( $conf => qw(username uname user dbuser dbusername) )
77             or push @errstr, "missing username";
78            
79             my $hostname = _findkey( $conf => qw(hostname host dbhost dbhostname) ) || 'localhost';
80              
81             my $password = _findkey( $conf => qw(password dbpass dbpassword passw dbpassw pass))
82             or push @errstr, "missing password";
83            
84             my $database = _findkey( $conf => qw(database dbname databasename))
85             or push @errstr, "missing database name";
86              
87             my $dbdriver = _findkey( $conf => qw(dbdriver driver db_driver) ) || 'mysql';
88              
89             (@errstr and scalar @errstr) and (warn("Errors: @errstr") and return);
90              
91             ### $database
92             ### $hostname
93             ### $username
94             ### $password
95             ### $dbdriver
96              
97             my $dbsource = "DBI:$dbdriver:database=$database;host=$hostname";
98             ### $dbsource
99              
100             return( $dbsource, $username, $password);
101             }
102              
103             sub _findkeys_sqlite {
104             my $conf = shift;
105              
106             my $abs_sqlite = _findkey( $conf => qw(abs_db abs_sqlite) )
107             or ((push @errstr, "missing abs_sqlite") and return);
108              
109             my $dbdriver = _findkey( $conf => qw(dbdriver driver db_driver) ) || 'SQLite';
110              
111             my $dbsource = "dbi:$dbdriver:dbname=$abs_sqlite";
112             ### $dbsource
113              
114             return ($dbsource,'','');
115             }
116              
117              
118              
119             # pass it the conf hash ref, and a list of possible case insensitive key matches
120             sub _findkey {
121             my $_hashref = shift;
122              
123             # convert the hashref
124             my $c;
125             map { $c->{lc($_)} = $_hashref->{$_} } keys %$_hashref;
126            
127             for my $_poss ( @_ ){
128             my $poss = lc($_poss);
129             if (exists $c->{$poss}){
130             return $c->{$poss};
131             }
132             }
133             return;
134              
135             }
136              
137             1;
138              
139              
140             __END__