Subversion Repositories DevTools

#!/usr/bin/perl -w

########################################################################
# Copyright (C) 2008 ERG Limited, All rights reserved
#
# Module name   : commonExports.pm
# Module type   : Perl module file
# Compiler(s)   : n/a
# Environment(s): windows (dos), unix (solaris and linux)
#
# Description   : Contains functions and global variables that are
#                 commonly exported to be used by other scripts.
#                 In particular schemadump.pl and ddlfile.pl use
#                 this file.               
#
# History       : Created by Haydon Knight May 2008
#
# Usage         : n/a
#
########################################################################

#######################################################################
# Use stuff
#######################################################################

package commonExports;
require 5.6.1;
use strict;
use warnings;
use Exporter;

our @ISA = qw{ Exporter };
our($global) = "any global variable";

#######################################################################
# Function prototypes
#######################################################################

sub readArray($);
sub writeArray($@);
sub openLog();
sub runCommand($@);
sub drunCommand($@);
sub quoteCommand(@);
sub logprint($);
sub hchomp;
sub finish();
sub isOneOf($\@);
sub toUnixLineEnds($);
sub createDirectories($@);

sub getTopBotDirs($);

#######################################################################
# Constant global variables
#######################################################################

our $subSectionSplitter = "-- new object type path is: SCHEMA_EXPORT/";
our $UNIX = ($ENV{'OS'} && $ENV{'OS'} =~ m/win/i) ? 0 : 1;

#######################################################################
# Other global variables
#######################################################################

our $verbose = 0; # numeric argument - 1 for 'on'; '2' for high verbosity; '3' for max
our $logFile;

#######################################################################
# Hash tables - these are specific to the release manager database
#               and need to be adjusted if running this script on other databases
#######################################################################

# This hash is used to determine which types of SQL objects should be
# extracted to individual files, rather than just writing out one big
# file for all.  e.g. each synonym gets its own file, but all
# se_post_schema_procobjact things get lumped in allData.sql
our %wantToExtract;

$wantToExtract{'synonym/synonym'} = 1;
$wantToExtract{'type/type'} = 1;
$wantToExtract{'sequence/sequence'} = 1;
$wantToExtract{'table/table'} = 1;
$wantToExtract{'function/function'} = 1;
$wantToExtract{'procedure/procedure'} = 1;
$wantToExtract{'view/view'} = 1;
$wantToExtract{'package/package_body'} = 1;
$wantToExtract{'table/index'} = 1;
$wantToExtract{'package/package_spec'} = 1;
$wantToExtract{'table/se_tbl_fbm_index_index'} = 1;

#######################################################################
# Export everything
#######################################################################

# List of default exports
our @EXPORT = qw{ $subSectionSplitter $UNIX             $logFile      $verbose
                  %wantToExtract
                  readArray           writeArray        openLog       runCommand     drunCommand
                  quoteCommand        logprint          hchomp        finish         isOneOf
                  toUnixLineEnds      createDirectories getTopBotDirs };

# List of available non-default exports
our @EXPORT_OK = qw{ };

#######################################################################
# Generic function definitions 
#######################################################################

#-------------------------------------------------------------------------------
# Function  : writeArray
#
# Purpose   : Writes an array to disk
#
# Arguments : $filename (i) - file to write out to
#             @lines (i) - lines to be written out
#
# Returns   : nothing
#
# Notes     : Calls toUnixLineEnds()
#
sub writeArray($@)
{
    my ($filename, @lines) = @_;

    open( D, ">$filename") or die "Could not open '$filename' for writing\n";
    foreach my $line (@lines)
    {
        $line .= "\n" unless $line =~ m/\n$/;
        print D $line;
    }
    close( D );

    toUnixLineEnds( $filename );
}



#-------------------------------------------------------------------------------
# Function  : readArray
#
# Purpose   : Reads in an array from disk
#
# Arguments : $filename (i) - file to read from
#
# Returns   : @lines - lines returned
#
# Notes     : Lines will not have '\n' in them.
#
sub readArray($)
{
    my ($filename) = @_;

    my @lines;

    open( SRCFILE, $filename);    
    while( <SRCFILE> )
    {
        s~[\n\r]+$~~;
        push @lines, $_;
    }
    close( SRCFILE );

    return hchomp @lines;
}


#-------------------------------------------------------------------------------
# Function  : openLog
#
# Purpose   : Opens the log file if $logFile has been set
#
# Arguments : none
#
# Returns   : Nothing
#
# Notes     :
#
sub openLog()
{
    die "Could not open logfile '$logFile'\n" if( $logFile && !open(LOGFILE,">$logFile") );
}


#-------------------------------------------------------------------------------
# Function  : isOneOf
#
# Purpose   : Returns true is a string is a member of an array of strings
#
# Arguments : $cand (i) - Candidate string
#             $refElite(i) - reference to @elite - Array of strings (the elite list)
#
# Returns   : Either 1 or 0 depending on whether candidate is one of the elite list.
#
# Notes     :
#
sub isOneOf($\@)
{
    my ($cand, $refElite) = @_;

    foreach my $elitemember (@$refElite)
    {
        return 1 if $cand eq $elitemember;
    }

    return 0;
}


#-------------------------------------------------------------------------------
# Function  : logprint
#
# Purpose   : Prints comments
#
# Arguments : $s (i) - string to be printed
#
# Returns   : nothing
#
# Notes     : Prints to screen if verbose
#             Prints to log if logfile specified on command line
#
sub logprint($)
{
    my ($s) = @_;
    $s =~ s~[\n\r]$~~;
    print "Log: $s\n" if( $verbose );
    print LOGFILE "Log: $s\n" if( $logFile );
}


#-------------------------------------------------------------------------------
# Function  : finish
#
# Purpose   : closes log file handle and provides return value for script
#
# Arguments : none
#
# Returns   : none
#
# Notes     :
#
sub finish()
{
    logprint("Bye!");
    close LOGFILE if $logFile;
    exit( 0 );
}


#-------------------------------------------------------------------------------
# Function  : hchomp
#
# Purpose   : Remove newline characters from the end of a string
#
# Arguments : A single string, or an array of strings
#
# Returns   : Input without newline characters
#
# Notes     :
#
sub hchomp
{
    return @_ unless @_;

    my @stuff = @_;
    
    foreach my $a (@stuff)
    {
        $a =~ s~[\n\r]+$~~;
    }
    
    return ( (scalar(@stuff) == 1) ? $stuff[0] : @stuff );
}


#-------------------------------------------------------------------------------
# Function  : toUnixLineEnds
#
# Purpose   : Converts a file to have unix line endings
#
# Arguments : $filename (i) - file to convert
#
# Returns   : nothing
#
# Notes     : Reads in, gets rid of all '\r'; writes back out
#
sub toUnixLineEnds($)
{
    my ($filename) = @_;

    my $fileChars;
    
    open( FILEIN, $filename) or die "Could not open '$filename' for reading\n";
    $fileChars .= $_ while( <FILEIN> );
    close( FILEIN );

    $fileChars =~ s~\r~~g;

    open( FILEOUT, ">$filename") or die "Could not open '$filename' for writing\n";
    binmode FILEOUT;
    print FILEOUT $fileChars;
    close( FILEOUT );
}


#-------------------------------------------------------------------------------
# Function  : createDirectories
#
# Purpose   : mkdir's directories
#
# Arguments : $basedir (i) - prepend this path onto each of @subDirs before making them
#             @subDirs (i) - directories to be made
#
# Returns   : nothing
#
# Notes     : recursively works so can be passed in stuff like "a/b" where neither
#             directory a nor b currently exists.
#
sub createDirectories($@)
{
    my ($basedir, @subDirs) = @_;
    
    foreach my $subDir (@subDirs)
    {
        my @dirys = split(/\//,$subDir);
        my $diryString;
    
        foreach my $diry (@dirys)
        {
            $diryString .= "$diry/";
            mkdir "$basedir/$diryString" unless -e "$basedir/$diryString";
        }
    }

}


#-------------------------------------------------------------------------------
# Function  : runCommand
#
# Purpose   : Runs a command in the shell
#
# Arguments : $cmd (i) - command to run.  Basically this is all arguments that should
#                        not be quoted.
#             @args (i) - additional arguments.  These are all quoted, so be careful
#                         when passing in wildcard arguments.
#
# Returns   : The shell stdout output of the command
#
# Notes     :
#
sub runCommand($@)
{
    my ($cmd, @args) = @_;

    my $fullCmd = $cmd;
    $fullCmd .= " " . quoteCommand(@args) if @args;

    logprint "Running command '$fullCmd'";
    return hchomp `$fullCmd`;
}


#-------------------------------------------------------------------------------
# Function  : drunCommand
#
# Purpose   : Used for debugging - call when you don't want to run a command
#
# Arguments : See runCommand
#
# Returns   : An empty string.
#
# Notes     : drunCommand = don't run command.  Just like runCommand(), but doesn't run the
#             command.
#
sub drunCommand($@)
{
    my ($cmd, @args) = @_;

    my $fullCmd = $cmd;
    $fullCmd .= " " . quoteCommand(@args) if @args;

    logprint "Not running command '$fullCmd'";
    return "";
}


#-------------------------------------------------------------------------------
# Function  : quoteCommand
#
# Purpose   : Quotes its arguments
#
# Arguments : @words (i) - words to be surrounded by double quotes
#
# Returns   : $quotedCommand - words quoted and joined
#
# Notes     :
#
sub quoteCommand(@)
{
    my @words = @_;
    my $quotedCommand;

    foreach my $word (@words)
    {
        $quotedCommand .= qq("$word" );
    }
    return $quotedCommand;
}

#######################################################################
# Function definitions specific to scripts related to release manager database
#######################################################################

#-------------------------------------------------------------------------------
# Function  : getTopBotDirs
#
# Purpose   : Strip out the two directories from input string
#
# Arguments : $fullDiry (i) - a string e.g. of form 'TABLE/INDEX/STATISTICS/INDEX_STATISTICS'
#
# Returns   : $topDir - first directory
#             $botDir - directory within $topDir
#
# Notes     : Code is hardwired with special case handling for release manager database
#
sub getTopBotDirs($)
{
    my ($fullDiry) = @_;

    ###############################################################
    # From input string we extract the first word and the last word, where we split on a slash
    # i.e. for the string 'TABLE/INDEX/STATISTICS/INDEX_STATISTICS'
    # we get 'TABLE' and 'INDEX_STATISTICS'
    # The only objects not uniquely identified by their first and last argument
    # are TABLE/INDEX/INDEX and TABLE/INDEX/SE_TBL_FBM_INDEX_INDEX/INDEX
    # For those we do a special case

    my @dirys = split( /\//, $fullDiry);
    
    die "getTopBotDirs(): Could not parse any words from input string!"
        unless( @dirys );
    
    my $topDir = $dirys[0];
    my $botDir = $dirys[-1];
    
    $botDir = $dirys[-2] if( $dirys[0] =~ m/^TABLE$/i && $dirys[-1] =~ m/^INDEX$/i );

    return ($topDir, $botDir);
}

#######################################################################
# Final true value
#######################################################################

1;