Subversion Repositories DevTools

########################################################################

# 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;