MayaChemTools

   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