       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