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;