Subversion Repositories DevTools

#! perl
########################################################################
# Copyright (c) VIX TECHNOLOGY (AUST) LTD
#
# Module name   : JatsRmApi
# Module type   : Makefile system
# Compiler(s)   : n/a
# Environment(s): jats
#
# Description   : Provides common access function to:
#                       The Release Manager
#                       The Deployment Manager Databases
#                       The ClearQuest Database    
#
#                 Note: The interface provided is constrained
#                       by the existing usage.
#
#                       This is an attempt to provide common accessor
#                       functions to open and close a connection
#
#                Note: This is not a class
#                      The connection WILL NOT be released if the
#                      containing variables go out of scope, BUT the
#                      underlying connection is a class and it WILL release
#                      the connection.
#
#......................................................................#

require 5.006_001;

use strict;
use warnings;

package JatsRmApi;
use JatsError;
use DBI;

our (@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);
use Exporter;

$VERSION = 1.00;
@ISA = qw(Exporter);

# Symbols to autoexport (:DEFAULT tag)
@EXPORT = qw(
            connectRM
            disconnectRM

            connectDM
            disconnectDM

            connectCQ
            disconnectCQ
            );

#
#   Globals to contain connection information
#
our $GBE_RM_LOCATION;
our $GBE_RM_USERNAME;
our $GBE_RM_PASSWORD;

our $GBE_DM_LOCATION;
our $GBE_DM_USERNAME;
our $GBE_DM_PASSWORD;

our $GBE_CQ_LOCATION;
our $GBE_CQ_USERNAME;
our $GBE_CQ_PASSWORD;

#-------------------------------------------------------------------------------
# Function        : ValidateRef
#
# Description     : Ensure that the user has passed a valid reference
#
# Inputs          : $fname      - Function name for error reporting
#                   $ref        - Data to test
#
# Returns         : Will error on error
#

sub ValidateRef
{
    my ($fname, $ref) = @_;

    Error("$fname: No parameter passed") unless ( $ref );

    my $rtype = ref($ref) || 'Simple Type';
    Error("$fname: Must pass a scalar REF, not a $rtype") unless ( $rtype =~ m/SCALAR|REF/ );
}

#-------------------------------------------------------------------------------
# Function        : GetConnData
#
# Description     : Determine the connection data for either RM or DM
#
# Inputs          : $fname  - Caller function
#                   @rest   - 3 EnvVars to process
#
# Returns         : An array of 3 variables
#                   location, username, password
#
sub GetConnData
{
    my ($fname, @rest) = @_;
    my @result;

    foreach my $var ( @rest )
    {
        my $val = $ENV{$var};
        Error( "Environment Variable '$var' not defined." ) unless ( $val );
        push @result, $val;
    }

    Verbose ("$fname:",
             "Database: $result[0]",
             "Username: $result[1]",
             "Password: $result[2]");

    return @result;
}

#-------------------------------------------------------------------------------
# Function        : connectRM
# Function        : connectDM
#
# Description     : Connect to the RM/DM database
#
# Inputs          : gref        - Reference to a scalar that will hold
#                                 the database connection class data
#
#                                 If 'undef' this function will create
#                                 the connection. Otherwise the function
#                                 will simply return.
#
#                   opt_verbose - Verbose connection
#
# Returns         : 
#
sub connectRM
{
    my ($gref, $opt_verbose) = @_;
    connectDB('connectRM', $gref, $opt_verbose, 'GBE_RM_LOCATION', 'GBE_RM_USERNAME', 'GBE_RM_PASSWORD');
}

sub connectDM
{
    my ($gref, $opt_verbose) = @_;
    connectDB('connectDM', $gref, $opt_verbose, 'GBE_DM_LOCATION', 'GBE_DM_USERNAME', 'GBE_DM_PASSWORD');
}

sub connectCQ
{
    my ($gref, $opt_verbose) = @_;
    connectDB('connectCQ', $gref, $opt_verbose, 'GBE_CQ_LOCATION', 'GBE_CQ_USERNAME', 'GBE_CQ_PASSWORD');
}


sub connectDB
{
    my ($fname, $gref, $opt_verbose, @parms) = @_;

    #
    #   Sanity Check user parameters
    #
    ValidateRef( $fname, $gref);
    my @condata = GetConnData( $fname , @parms);
    my $location = $condata[0];

    unless ( $$gref )
    {
        $$gref = DBI->connect(@condata, {verbose => $opt_verbose});

        unless ( defined $$gref )
        {
            Error("$fname: Database [$location]",
                  "Reported Error[$DBI::errstr]");
        }

        Verbose("$fname: Connected to database [$location]");
    }
    else
    {
        Warning ("$fname: Connection Already open");
    }
}

#-------------------------------------------------------------------------------
# Function        : disconnectRM
# Function        : disconnectDM
# Function        : disconnectCQ
#
# Description     : Disconnect from the DM/RM/CQ database
#
# Inputs          : gref        - Reference to a scalar that will hold
#                                 the database connection class data
#
#                                 If not 'undef' this function will disconnect
#                                 the connection. Otherwise the function
#                                 will simply return.
#

sub disconnectRM
{
    disconnectDB( 'disconnectRM', @_);
}

sub disconnectDM
{
    disconnectDB( 'disconnectDM', @_);
}

sub disconnectCQ
{
    disconnectDB( 'disconnectCQ', @_);
}

sub disconnectDB
{
    my ($fname, $gref) = @_;

    #
    #   Sanity Check user parameters
    #
    ValidateRef( $fname, $gref);
    
    Verbose("$fname: Disconnect from database");
    if ( $$gref )
    {
        $$gref->disconnect() || Warning ("$fname:Disconnect failed");
        $$gref = undef;
    }
    else
    {
        Warning("$fname: Connection not open");
    }
}

1;