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