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