package DB::DBlib; use DBI; use Carp; use vars (@ISA, @EXPORT_TAGS, %$dbh); $dbh = undef; # package global $DB::DBlib::VERSION='0.10'; require Exporter; @ISA = qw(Exporter); # export nothing by default @EXPORT = (); # export functions by request @EXPORT_OK = qw( DBSelectSQL DBConnect DBExecSQL DBSQLError DBGetRow DBGetRowSet DBGetRowsAll DBGetNext DBGetRowValues DBGetColValues ); # named sets of functions to export %EXPORT_TAGS = ( # Just SQL Parsing Functions Parse => [ qw ( DBSelectSQL )], # Parsing & Execution Functions Execute => [ qw ( DBSelectSQL DBConnect DBExecSQL DBSQLError )], # Parsing, Execution & Row-Processing Functions (e.g. everything) Fetch => [ @EXPORT_OK ], ); ################################################ # SQL Parsing Functions ################################################ sub DBSelectSQL { # takes a hash of named parms: # columns => [@column_names] or $column_name, # from => [@table_names] or $table_name, # where => [@criteria_expressions] or $criteria_expression, # orderby => [@column_names_or_numbers] or $column_name_or_number, # limit => $max_num_of_rows_to_return, # offset => $first_row_number_to_return, # (only if limit >0) # # and (hopefully) returns a formatted SQL statement as a scalar string croak "odd parms passed to DBSelectSQL" if @_%2; my %parms=@_; croak "no from clause" unless $parms{from}; my @from = ref($parms{from})=~/^array/i ? @{$parms{from}} : ($parms{from}); my @cols = exists $parms{columns} ? ref($parms{columns})=~/^array/i ? @{$parms{columns}} : $parms{columns} : ('*'); my @where = $parms{where} ? ref($parms{where})=~/^array/i ? @{$parms{where}} : ($parms{where}) :(); my @groupby = $parms{groupby} ? ref($parms{groupby})=~/^array/i ? @{$parms{groupby}} : ($parms{groupby}) : (); my @having = $parms{having} ? ref($parms{having})=~/^array/i ? @{$parms{having}} : $parms{having} : (); my @orderby = $parms{orderby} ? ref($parms{orderby})=~/^array/i ? @{$parms{orderby}} : $parms{orderby} : (); my ($offset, $limit) = @parms{'offset', 'limit'}; my $distinct = "DISTINCT" if $parms{distinct}; my $sql = "SELECT $distinct \n\t" . join (" ,\n\t", @cols); $sql .= "\n" . "FROM \n\t" . join (" ,\n\t", @from); $sql .= "\n" . "WHERE \n\t" . join (" AND \n\t", @where) if @where; $sql .= ("\n" . "GROUP BY \n\t" . join (" ,\n\t", @groupby)) if @groupby ; $sql .= ("\n" . "HAVING \n\t" . join (" ,\n\t", @having)) if @having; $sql .= ("\n" . "ORDER BY \n\t" . join (" ,\n\t", @orderby)) if @orderby; $sql .= ("\n" . "LIMIT " . ($offset || '0') . ", ".$limit) if $limit; return $sql; } ################################################ # SQL Execution & Error Handling Functions ################################################ sub DBConnect { croak "DBConnect requires named parms (odd parms passed)" if @_%2; my %db = @_; my $or_die = $db{or_die} ? 1 : 0; $dbh = DBI->connect( "DBI:mysql:$db{name}:$db{host}:$db{port}", $db{user}, $db{pass}, { RaiseError => $or_die, PrintError => $or_die, }, ); return $dbh; } sub DBExecSQL { # takes DBSelectSQL style named parms, plus, optionally # debug => 1 to dump: the SQL before execution and "info" after, # and sql => $sqlcommand to bypass the DBSelectSQL call # if $parms{$sql} is not supplied, calls DBSelectSQL # with the other parms to generate an SQL command, # executes the SQL, and returns the DBI statement handle # (this does not fetch the result - see the DBGet* calls for that) croak "odd parms passed to DBExecSQL" if @_%2; croak "no parms passed to DBExecSQL" unless @_; my %parms=@_; my $sql=$parms{sql}; my $debug = $parms{debug}; $sql = &DBSelectSQL(%parms) unless $sql; croak "no sql" unless $sql; if ($debug) { &Header("debug") unless $didheader || $main::didheader; print "

query:

\n", "
", $sql, "

\n"; } $dbh->{RaiseError}=0; my $sth = $dbh->prepare($sql) or &DBSQLError($sql, "prepare failed", $sth); $sth->execute or &DBSQLError($sql, "execute failed", $sth); if ($debug and $dbh->{info}) { &Header("debug") unless $didheader || $main::didheader; print "

info:

\n", "
", $dbh->{info}, "

\n"; } return $sth; } sub DBSQLError { my ($sql, $msg, $query_obj) = @_; &Header("", "SQL Error") unless $didheader or $main::didheader; print "

SQL Error: $msg

\n", 
		$query_obj->err, ": ", $query_obj->errstr, "

\n", "

SQL:

\n$sql\n

\n"; &Footer; } sub Header { my ($heading, $title)=@_; $title = ($title or $heading or $cgi{name}); # %bodytags & %font can be defined here, or in main:: my %bodytags = %main::bodytags; my %font = %main::font; unless ($didheader || $main::didheader) { $didheader++; $main::didheader++; print ( "Content-type: text/html\n\n", "$title\n", "\n", "\n", ); } print $heading? "

$heading

\n" : ''; } sub Footer { print "\n\n\n"; exit; } ################################################ # Row Fetching & Processing (DBGet*) Functions ################################################ sub DBGetRow { # takes DBSelectSQL style named parms # and returns a hash of the first row croak "odd parms passed to DBGetRow" if @_%2; croak "no parms passed to DBGetRow" unless @_; my %parms=@_; my $query=&DBExecSQL(%parms); return %{$query->fetchrow_hashref}; } sub DBGetRowSet { # takes DBSelectSQL style named parms # and returns a reference to the (executed) statement handle croak "odd parms passed to DBGetRowSet" if @_%2; croak "no parms passed to DBGetRowSet" unless @_; my %parms=@_; return &DBExecSQL(%parms); } sub DBGetRowsAll { # takes DBSelectSQL style named parms # and returns an array of hashes of the returned rows croak "odd parms passed to DBGetRowSet" if @_%2; croak "no parms passed to DBGetRowSet" unless @_; my %parms=@_; my $sth = &DBExecSQL(%parms); my (%row, @allrows); while (%row = &DBGetNext($sth)) { push @allrows, {%row}; } return @allrows; } sub DBGetNext { # takes an already-executed DBI statement handle object # does a fetch, and returns a hash of the fetched row my $query=shift or croak "no query passed to DBGetNext"; croak "query not an object" unless ref($query); return %{$query->fetchrow_hashref}; } sub DBGetRowValues { # takes DBSelectSQL style named parms # in list context, returns a list (of just the values) from the first row returned # in scalar context, returns just the first value from the first row returned croak "odd parms passed to DBGetRowValues" if @_%2; croak "no parms passed to DBGetRowValues" unless @_; my %parms=@_; my $query=&DBExecSQL(%parms); return wantarray? @{$query->fetch} : $query->fetch->[0]; } sub DBGetColValues { # takes DBSelectSQL style named parms # returns a list of just the values from the 1st column of a result set croak "odd parms passed to DBGetColValues" if @_%2; croak "no parms passed to DBGetColValues" unless @_; my %parms=@_; my $query=&DBExecSQL(%parms); my (@resultrow, @resultcol); while (@resultrow=@{$query->fetch}){ push @resultcol, $resultrow[0]; } return @resultcol; } 1;