1 package DBUtil;
   2 #
   3 # $RCSfile: DBUtil.pm,v $
   4 # $Date: 2008/04/25 00:00:45 $
   5 # $Revision: 1.19 $
   6 #
   7 # Author: Manish Sud <msud@san.rr.com>
   8 #
   9 # Copyright (C) 2004-2008 Manish Sud. All rights reserved.
  10 #
  11 # This file is part of MayaChemTools.
  12 #
  13 # MayaChemTools is free software; you can redistribute it and/or modify it under
  14 # the terms of the GNU Lesser General Public License as published by the Free
  15 # Software Foundation; either version 3 of the License, or (at your option) any
  16 # later version.
  17 #
  18 # MayaChemTools is distributed in the hope that it will be useful, but without
  19 # any warranty; without even the implied warranty of merchantability of fitness
  20 # for a particular purpose.  See the GNU Lesser General Public License for more
  21 # details.
  22 #
  23 # You should have received a copy of the GNU Lesser General Public License
  24 # along with MayaChemTools; if not, see <http://www.gnu.org/licenses/> or
  25 # write to the Free Software Foundation Inc., 59 Temple Place, Suite 330,
  26 # Boston, MA, 02111-1307, USA.
  27 #
  28 use 5.006;
  29 use strict;
  30 use Exporter;
  31 use Carp;
  32 use DBI;
  33 use TextUtil;
  34 
  35 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  36 
  37 $VERSION = '1.00';
  38 @ISA = qw(Exporter);
  39 @EXPORT = qw(DBConnect DBDisconnect DBFetchSchemaTableNames DBSetupDescribeSQL DBSetupSelectSQL DBSQLToTextFile);
  40 @EXPORT_OK = qw();
  41 %EXPORT_TAGS = (all  => [@EXPORT, @EXPORT_OK]);
  42 
  43 # Connect to a specified database...
  44 sub DBConnect {
  45   my($DBDriver, $DBName, $DBHost, $DBUser, $DBPassword) = @_;
  46   my($DBHandle, $DataSource);
  47 
  48   if ($DBDriver eq "Oracle") {
  49     $DataSource = ($DBName && $DBHost) ? (qq(DBI:$DBDriver:sid=$DBName;host=$DBHost)) : (qq(DBI:$DBDriver:$DBHost));
  50   }
  51   else {
  52     $DataSource = qq(DBI:$DBDriver:database=$DBName);
  53     if ($DBHost) {
  54       $DataSource .= qq(;host=$DBHost);
  55     }
  56   }
  57 
  58   # Don't raise the error; otherwise, DBI functions termiates on encountering an error.
  59   # All terminations decisions are made outside of DBI functions...
  60   $DBHandle = DBI->connect($DataSource, $DBUser, $DBPassword, { RaiseError => 0, AutoCommit => 0 }) or croak "Couldn't connect to database...";
  61 
  62   return $DBHandle;
  63 }
  64 
  65 # Disconnect from a database...
  66 sub DBDisconnect {
  67   my($DBHandle) = @_;
  68 
  69   $DBHandle->disconnect or carp "Couldn't disconnect from a database...";
  70 }
  71 
  72 # Fetch all table name for a database schema...
  73 sub DBFetchSchemaTableNames {
  74   my($DBDriver, $DBHandle, $SchemaName) = @_;
  75   my(@SchemaTableNames, $SQL, $SQLHandle);
  76 
  77   @SchemaTableNames = ();
  78 
  79   $SchemaName = (defined $SchemaName && length $SchemaName) ? uc $SchemaName : "";
  80 
  81   if ($DBDriver eq "mysql") {
  82     # Switch schemas...
  83     $SQL = qq(USE $SchemaName);
  84     $SQLHandle = $DBHandle->prepare($SQL) or return @SchemaTableNames;
  85     $SQLHandle->execute or return @SchemaTableNames;
  86     $SQLHandle->finish or return @SchemaTableNames;
  87 
  88     # Setup to fetch table names...
  89     $SQL = qq(SHOW TABLES);
  90   }
  91   elsif ($DBDriver eq "Oracle") {
  92     $SQL = qq(SELECT SEGMENT_NAME FROM DBA_SEGMENTS WHERE OWNER = '$SchemaName' AND SEGMENT_TYPE = 'TABLE' ORDER BY SEGMENT_NAME);
  93   }
  94   $SQLHandle = $DBHandle->prepare($SQL) or return @SchemaTableNames;
  95   $SQLHandle->execute or return @SchemaTableNames;
  96 
  97   my(@RowValues, $TableName);
  98   while (@RowValues = $SQLHandle->fetchrow_array) {
  99     $TableName = uc $RowValues[0];
 100     if (defined $TableName && length $TableName) {
 101       push @SchemaTableNames, $TableName;
 102     }
 103   }
 104   $SQLHandle->finish or return @SchemaTableNames;
 105 
 106   return @SchemaTableNames;
 107 }
 108 
 109 # Setup describe SQL statement...
 110 sub DBSetupDescribeSQL {
 111   my($DBDriver, $TableName, $SchemaName);
 112   my($DescribeSQL);
 113 
 114   $DBDriver = ""; $TableName = ""; $SchemaName = "";
 115   if (@_ == 3) {
 116     ($DBDriver, $TableName, $SchemaName) = @_;
 117   }
 118   else {
 119     ($DBDriver, $TableName) = @_;
 120   }
 121   $TableName = (defined $TableName && length $TableName) ? uc $TableName : "";
 122   $SchemaName = (defined $SchemaName && length $SchemaName) ? uc $SchemaName : "";
 123 
 124   $DescribeSQL = ($SchemaName) ? ("DESCRIBE " . "$SchemaName" . ".$TableName") : "DESCRIBE $TableName";
 125 
 126   if ($DBDriver eq "Oracle") {
 127     $DescribeSQL = qq(SELECT COLUMN_NAME "Column_Name", DECODE(NULLABLE, 'N','Not Null','Y','Null') "Null", DATA_TYPE "Data_Type", DATA_LENGTH "Data_Length", DATA_PRECISION "Data_Precision" FROM DBA_TAB_COLUMNS WHERE TABLE_NAME = '$TableName');
 128     if ($SchemaName) {
 129       $DescribeSQL .= qq( AND OWNER = '$SchemaName');
 130     }
 131     $DescribeSQL .= qq( ORDER BY COLUMN_ID);
 132   }
 133 
 134   return $DescribeSQL;
 135 }
 136 
 137 # Setup describe SQL statement...
 138 sub DBSetupSelectSQL {
 139   my($DBDriver, $TableName, $SchemaName);
 140   my($SelectSQL);
 141 
 142   $DBDriver = ""; $TableName = ""; $SchemaName = "";
 143   if (@_ == 3) {
 144     ($DBDriver, $TableName, $SchemaName) = @_;
 145   }
 146   else {
 147     ($DBDriver, $TableName) = @_;
 148   }
 149   $TableName = (defined $TableName && length $TableName) ? uc $TableName : "";
 150   $SchemaName = (defined $SchemaName && length $SchemaName) ? uc $SchemaName : "";
 151 
 152   $SelectSQL = ($SchemaName) ? ("SELECT * FROM " . "$SchemaName" . ".$TableName") : "SELECT * FROM $TableName";
 153 
 154   return $SelectSQL;
 155 }
 156 
 157 # Prepare and execute a SQL statement and write out results into
 158 # a text file.
 159 sub DBSQLToTextFile {
 160   my($DBHandle, $SQL, $TextFile, $OutDelim, $OutQuote, $ExportDataLabels, $ExportLOBs, $ReplaceNullStr);
 161   my($SQLHandle, $Status);
 162 
 163   $Status = 1;
 164   $ExportDataLabels = 1;
 165   $ExportLOBs = 0;
 166   $ReplaceNullStr = "";
 167   if (@_ == 8) {
 168     ($DBHandle, $SQL, $TextFile, $OutDelim, $OutQuote, $ExportDataLabels, $ExportLOBs, $ReplaceNullStr) = @_;
 169   }
 170   elsif (@_ == 7) {
 171     ($DBHandle, $SQL, $TextFile, $OutDelim, $OutQuote, $ExportDataLabels, $ExportLOBs) = @_;
 172   }
 173   elsif (@_ == 6) {
 174     ($DBHandle, $SQL, $TextFile, $OutDelim, $OutQuote, $ExportDataLabels) = @_;
 175   }
 176   else {
 177     ($DBHandle, $SQL, $TextFile, $OutDelim, $OutQuote) = @_;
 178   }
 179 
 180   # Execute SQL statement...
 181   $SQLHandle = $DBHandle->prepare($SQL) or return $Status;
 182   $SQLHandle->execute() or return $Status;
 183 
 184   my($FieldsNum, @FieldNames, @RowValues, @ColNumsToExport, @ColLabels, $ColNum, $ColLabelsLine, @Values, $Value, $ValuesLine);
 185 
 186   $Status = 0;
 187   # Figure out which column numbers need to be exported...
 188   $FieldsNum = $SQLHandle->{NUM_OF_FIELDS};
 189   @FieldNames = @{$SQLHandle->{NAME}};
 190   @ColNumsToExport = ();
 191   if ($ExportLOBs) {
 192     @ColNumsToExport = (0 .. $#FieldNames);
 193   }
 194   else {
 195     my(@FieldTypes, @FieldTypeNames, $Type, $TypeName);
 196     @FieldTypes = @{$SQLHandle->{TYPE}};
 197     @FieldTypeNames = map { scalar $DBHandle->type_info($_)->{TYPE_NAME} } @FieldTypes;
 198     for $ColNum (0 .. $#FieldNames) {
 199       if ($FieldTypeNames[$ColNum] !~ /lob/i ) {
 200 	push @ColNumsToExport, $ColNum;
 201       }
 202     }
 203   }
 204 
 205   if ($ExportDataLabels) {
 206     # Print out column labels...
 207     @ColLabels = ();
 208     for $ColNum (@ColNumsToExport) {
 209       push @ColLabels, $FieldNames[$ColNum];
 210     }
 211     $ColLabelsLine = JoinWords(\@ColLabels, $OutDelim, $OutQuote);
 212     print $TextFile "$ColLabelsLine\n";
 213   }
 214   # Print out row values...
 215   while (@RowValues = $SQLHandle->fetchrow_array) {
 216     @Values = ();
 217     for $ColNum (@ColNumsToExport) {
 218       if (defined($RowValues[$ColNum]) && length($RowValues[$ColNum])) {
 219 	$Value = $RowValues[$ColNum];
 220       }
 221       else {
 222 	$Value = $ReplaceNullStr ? $ReplaceNullStr : "";
 223       }
 224       push @Values, $Value;
 225     }
 226     $ValuesLine = JoinWords(\@Values, $OutDelim, $OutQuote);
 227     print $TextFile "$ValuesLine\n";
 228   }
 229   $SQLHandle->finish or return $Status;
 230   $Status = 0;
 231 
 232   return $Status;
 233 }
 234