1 package DBUtil; 2 # 3 # $RCSfile: DBUtil.pm,v $ 4 # $Date: 2015/02/28 20:47:02 $ 5 # $Revision: 1.34 $ 6 # 7 # Author: Manish Sud <msud@san.rr.com> 8 # 9 # Copyright (C) 2015 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 29 use strict; 30 use Exporter; 31 use Carp; 32 use DBI; 33 use TextUtil; 34 35 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); 36 37 @ISA = qw(Exporter); 38 @EXPORT = qw(DBConnect DBDisconnect DBFetchSchemaTableNames DBSetupDescribeSQL DBSetupSelectSQL DBSQLToTextFile); 39 @EXPORT_OK = qw(); 40 %EXPORT_TAGS = (all => [@EXPORT, @EXPORT_OK]); 41 42 # Connect to a specified database... 43 sub DBConnect { 44 my($DBDriver, $DBName, $DBHost, $DBUser, $DBPassword) = @_; 45 my($DBHandle, $DataSource); 46 47 if ($DBDriver eq "Oracle") { 48 $DataSource = qq(DBI:$DBDriver:$DBHost); 49 } 50 else { 51 $DataSource = qq(DBI:$DBDriver:database=$DBName); 52 if ($DBHost) { 53 $DataSource .= qq(;host=$DBHost); 54 } 55 } 56 57 # Don't raise the error; otherwise, DBI functions termiates on encountering an error. 58 # All terminations decisions are made outside of DBI functions... 59 $DBHandle = DBI->connect($DataSource, $DBUser, $DBPassword, { RaiseError => 0, AutoCommit => 0 }) or croak "Couldn't connect to database..."; 60 61 return $DBHandle; 62 } 63 64 # Disconnect from a database... 65 sub DBDisconnect { 66 my($DBHandle) = @_; 67 68 $DBHandle->disconnect or carp "Couldn't disconnect from a database..."; 69 } 70 71 # Fetch all table name for a database schema... 72 sub DBFetchSchemaTableNames { 73 my($DBDriver, $DBHandle, $SchemaName) = @_; 74 my(@SchemaTableNames, $SQL, $SQLHandle); 75 76 @SchemaTableNames = (); 77 78 $SchemaName = (defined $SchemaName && length $SchemaName) ? $SchemaName : ""; 79 80 if ($DBDriver eq "mysql") { 81 # Switch schemas... 82 $SQL = qq(USE $SchemaName); 83 $SQLHandle = $DBHandle->prepare($SQL) or return @SchemaTableNames; 84 $SQLHandle->execute or return @SchemaTableNames; 85 $SQLHandle->finish or return @SchemaTableNames; 86 87 # Setup to fetch table names... 88 $SQL = qq(SHOW TABLES); 89 } 90 elsif ($DBDriver eq "Oracle") { 91 $SQL = qq(SELECT SEGMENT_NAME FROM DBA_SEGMENTS WHERE OWNER = '$SchemaName' AND SEGMENT_TYPE = 'TABLE' ORDER BY SEGMENT_NAME); 92 } 93 elsif ($DBDriver =~ /^(Pg|Postgres)$/i) { 94 $SQL = qq(SELECT TABLE_NAME FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_SCHEMA = '$SchemaName'); 95 } 96 $SQLHandle = $DBHandle->prepare($SQL) or return @SchemaTableNames; 97 $SQLHandle->execute or return @SchemaTableNames; 98 99 my(@RowValues, $TableName); 100 while (@RowValues = $SQLHandle->fetchrow_array) { 101 $TableName = ($DBDriver =~ /^(mysql|Oracle)$/i) ? uc($RowValues[0]) : $RowValues[0]; 102 if (defined $TableName && length $TableName) { 103 push @SchemaTableNames, $TableName; 104 } 105 } 106 $SQLHandle->finish or return @SchemaTableNames; 107 108 return @SchemaTableNames; 109 } 110 111 # Setup describe SQL statement... 112 sub DBSetupDescribeSQL { 113 my($DBDriver, $TableName, $SchemaName); 114 my($DescribeSQL); 115 116 $DBDriver = ""; $TableName = ""; $SchemaName = ""; 117 if (@_ == 3) { 118 ($DBDriver, $TableName, $SchemaName) = @_; 119 } 120 else { 121 ($DBDriver, $TableName) = @_; 122 } 123 $TableName = (defined $TableName && length $TableName) ? $TableName : ""; 124 $SchemaName = (defined $SchemaName && length $SchemaName) ? $SchemaName : ""; 125 126 $DescribeSQL = ($SchemaName) ? ("DESCRIBE " . "$SchemaName" . ".$TableName") : "DESCRIBE $TableName"; 127 128 if ($DBDriver eq "Oracle") { 129 $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'); 130 if ($SchemaName) { 131 $DescribeSQL .= qq( AND OWNER = '$SchemaName'); 132 } 133 $DescribeSQL .= qq( ORDER BY COLUMN_ID); 134 } 135 elsif ($DBDriver =~ /^(Pg|Postgres)$/i) { 136 $DescribeSQL = qq(SELECT COLUMN_NAME "Column_Name", data_type "Data_Type" FROM information_schema.columns WHERE table_name ='$TableName'); 137 if ($SchemaName) { 138 $DescribeSQL .= " and table_schema = '$SchemaName'"; 139 } 140 } 141 142 return $DescribeSQL; 143 } 144 145 # Setup describe SQL statement... 146 sub DBSetupSelectSQL { 147 my($DBDriver, $TableName, $SchemaName); 148 my($SelectSQL); 149 150 $DBDriver = ""; $TableName = ""; $SchemaName = ""; 151 if (@_ == 3) { 152 ($DBDriver, $TableName, $SchemaName) = @_; 153 } 154 else { 155 ($DBDriver, $TableName) = @_; 156 } 157 $TableName = (defined $TableName && length $TableName) ? $TableName : ""; 158 $SchemaName = (defined $SchemaName && length $SchemaName) ? $SchemaName : ""; 159 160 $SelectSQL = ($SchemaName) ? ("SELECT * FROM " . "$SchemaName" . ".$TableName") : "SELECT * FROM $TableName"; 161 162 return $SelectSQL; 163 } 164 165 # Prepare and execute a SQL statement and write out results into 166 # a text file. 167 sub DBSQLToTextFile { 168 my($DBHandle, $SQL, $TextFile, $OutDelim, $OutQuote, $ExportDataLabels, $ExportLOBs, $ReplaceNullStr); 169 my($SQLHandle, $Status); 170 171 $Status = 1; 172 $ExportDataLabels = 1; 173 $ExportLOBs = 0; 174 $ReplaceNullStr = ""; 175 if (@_ == 8) { 176 ($DBHandle, $SQL, $TextFile, $OutDelim, $OutQuote, $ExportDataLabels, $ExportLOBs, $ReplaceNullStr) = @_; 177 } 178 elsif (@_ == 7) { 179 ($DBHandle, $SQL, $TextFile, $OutDelim, $OutQuote, $ExportDataLabels, $ExportLOBs) = @_; 180 } 181 elsif (@_ == 6) { 182 ($DBHandle, $SQL, $TextFile, $OutDelim, $OutQuote, $ExportDataLabels) = @_; 183 } 184 else { 185 ($DBHandle, $SQL, $TextFile, $OutDelim, $OutQuote) = @_; 186 } 187 188 # Execute SQL statement... 189 $SQLHandle = $DBHandle->prepare($SQL) or return $Status; 190 $SQLHandle->execute() or return $Status; 191 192 my($FieldsNum, @FieldNames, @RowValues, @ColNumsToExport, @ColLabels, $ColNum, $ColLabelsLine, @Values, $Value, $ValuesLine); 193 194 $Status = 0; 195 # Figure out which column numbers need to be exported... 196 $FieldsNum = $SQLHandle->{NUM_OF_FIELDS}; 197 @FieldNames = @{$SQLHandle->{NAME}}; 198 @ColNumsToExport = (); 199 if ($ExportLOBs) { 200 @ColNumsToExport = (0 .. $#FieldNames); 201 } 202 else { 203 my(@FieldTypes, @FieldTypeNames, $Type, $TypeName); 204 @FieldTypes = @{$SQLHandle->{TYPE}}; 205 @FieldTypeNames = map { scalar $DBHandle->type_info($_)->{TYPE_NAME} } @FieldTypes; 206 for $ColNum (0 .. $#FieldNames) { 207 if ($FieldTypeNames[$ColNum] !~ /lob|bytea/i ) { 208 push @ColNumsToExport, $ColNum; 209 } 210 } 211 } 212 213 if ($ExportDataLabels) { 214 # Print out column labels... 215 @ColLabels = (); 216 for $ColNum (@ColNumsToExport) { 217 push @ColLabels, $FieldNames[$ColNum]; 218 } 219 $ColLabelsLine = JoinWords(\@ColLabels, $OutDelim, $OutQuote); 220 print $TextFile "$ColLabelsLine\n"; 221 } 222 # Print out row values... 223 while (@RowValues = $SQLHandle->fetchrow_array) { 224 @Values = (); 225 for $ColNum (@ColNumsToExport) { 226 if (defined($RowValues[$ColNum]) && length($RowValues[$ColNum])) { 227 $Value = $RowValues[$ColNum]; 228 } 229 else { 230 $Value = $ReplaceNullStr ? $ReplaceNullStr : ""; 231 } 232 push @Values, $Value; 233 } 234 $ValuesLine = JoinWords(\@Values, $OutDelim, $OutQuote); 235 print $TextFile "$ValuesLine\n"; 236 } 237 $SQLHandle->finish or return $Status; 238 $Status = 0; 239 240 return $Status; 241 } 242