Software error:
<lookup> died something went wrong: OLE exception from "ADODB.Connection":

Operation is not allowed when the object is closed.

Win32::OLE(0.1707) error 0x800a0e78
    in METHOD/PROPERTYGET "Execute"

##</code><code>##

use strict;
use CGI::Carp qw(fatalsToBrowser);
use Data::Dumper;
use IO::Handle;
use XML::Simple;
use CGI qw( :cgi-lib );
use Win32::ODBC;
use Win32::OLE;
use Win32::OLE::Const 'Microsoft ActiveX Data Objects';
use vars qw( %CONFIG );
use POSIX qw( strftime );




#========================================================================================#
#                                        CONFIG                                          #
#========================================================================================#
%CONFIG = ( 	DEBUG          => 10,
		LogDir         => "C:\\Inetpub\\wwwroot\\smart\\logs",
		ErrorLog       => "Mych_smart_v0.01.ERROR.log",
		DebugLog       => "Mych_smart_v0.01.DEBUG.log",
		LogMaxSz       => 1 * (1024 ** 2),    # max log file size in bytes 
		LogMaxGens     => 3,		      # how many logfile generations shall we keep
		
					 #Below are ODBC connection that have been configured on this local machine
                FAAD_DB_DSN	 => "Provider=MSDASQL.1;Persist Security Info=False;Data Source=FAAD",
                CSSD_DB_DSN	 => "Provider=MSDASQL.1;Persist Security Info=False;Data Source=CSSD",
                NTSM_DB_DSN    => "Provider=MSDASQL.1;Password=**************;Persist Security Info=True;User ID=****;Data Source=ntsm_server_database;Initial Catalog=Servers",
                STYLE_SHEET    => "stylesheets/Mych_timfo2.xsl",

		);

#========================================================================================#
#                                        CONFIG                                          #
#========================================================================================#

##</code><code>##

# Original line to check NTSM database for hostname. I have hashed this out and changed it so that the '$EVENT->{'slots'}->{'hostname'}' is now substitued by 
# the extracted $hostN see my comments of 18/03/09

#    $EVENT->{'slots'}->{'DEVICE_SLA_CATEGORY'} = lookup_NTSM_val( '[Highest Site Category]', 'InfrastructureData', "server = '$EVENT->{'slots'}->{'hostname'}'");

# Added 18/03/09 by Mych Dubil a lookup to the FAAD database that extracts several columns of data that we believe will be helpful to OCC and other Resolvers
# Added a latch into the NTSM Database to pull out more than just the Highest Site Category
# Added 31/03/09 by Mych Dubil a lookup to the CSS data imported in from their spreadsheets


# First I need to use a regexp on the '$EVENT->{'slots'}->{'hostname'}' so that I only get the first part of the hostname e.g. RTR345 and not RTR345.company.co.uk

	  my $hostF = $EVENT->{'slots'}->{'hostname'};
	  
	  $_ = ".";
	  
	  $hostF =~ /\b([A-Za-z0-9]+)\b/;
	  
	  my $hostN = $1;
	  
	  LogIt( $fhDEBUG, "regexp to extract hostname $hostF down to $hostN");
	  
# The FAAD does have instances where the Machine_Name field has more character than the hostname so I'm going to only check the 
# same number of characters as in the first part of the host array

	  my $L = length($hostN);
	  
	  LogIt( $fhDEBUG, "length of $hostN is $L");
	  
# The next lines are calls to check what we have in the FAAD db on this asset

		$EVENT->{'slots'}->{'DEVICE_TYPE'} 					= lookup_FAAD_val( '[Sub_Type]', 			'[FAAD_Data]', "left([Machine_Name], $L) = '$hostN'");
		$EVENT->{'slots'}->{'OP_SYSTEM'} 					= lookup_FAAD_val( '[Operating_System]',	'[FAAD_Data]', "left([Machine_Name], $L) = '$hostN'");
		$EVENT->{'slots'}->{'ENVIRONMENT'} 					= lookup_FAAD_val( '[Environment]', 		'[FAAD_Data]', "left([Machine_Name], $L) = '$hostN'");
		$EVENT->{'slots'}->{'NETWORK'} 						= lookup_FAAD_val( '[Network]', 				'[FAAD_Data]', "left([Machine_Name], $L) = '$hostN'");
		$EVENT->{'slots'}->{'ASSET_TAG'} 				= lookup_FAAD_val( '[Asset_Tag]', 		'[FAAD_Data]', "left([Machine_Name], $L) = '$hostN'");
		$EVENT->{'slots'}->{'LOCATION'} 						= lookup_FAAD_val( '[Location]', 			'[FAAD_Data]', "left([Machine_Name], $L) = '$hostN'");
		$EVENT->{'slots'}->{'PROJECT'} 						= lookup_FAAD_val( '[Project]', 				'[FAAD_Data]', "left([Machine_Name], $L) = '$hostN'");
	  
# Note I can make the new call to the NTSM database using $hostN instead of $EVENT->{'slots'}->{'hostname'}

		$EVENT->{'slots'}->{'NTSM_SLA_CATEGORY'} 			= lookup_NTSM_val( '[Highest Site Category]', 	'[InfrastructureData]', "left([Server], $L) = '$hostN'");

# Now make some extra calls to extract some other data from a different table

		$EVENT->{'slots'}->{'NTSM_SERVER_DESCR'} 			= lookup_NTSM_val( '[ServerDescription]', '[ServerComp]', "left([ServerName], $L) = '$hostN'");
		$EVENT->{'slots'}->{'NTSM_SERVER_LOCATION'} 		= lookup_NTSM_val( '[ServerLocation]', 	'[ServerComp]', "left([ServerName], $L) = '$hostN'");
		$EVENT->{'slots'}->{'NTSM_SERVER_DOMAIN'} 		= lookup_NTSM_val( '[ServerDomain]', 		'[ServerComp]', "left([ServerName], $L) = '$hostN'");
		$EVENT->{'slots'}->{'NTSM_SERVER_SERVICE_NO'} 	= lookup_NTSM_val( '[ServerServiceNo]', 	'[ServerComp]', "left([ServerName], $L) = '$hostN'");
		$EVENT->{'slots'}->{'NTSM_SERVER_ASSETNO'} 		= lookup_NTSM_val( '[AsstNo]', 				'[ServerComp]', "left([ServerName], $L) = '$hostN'");
		$EVENT->{'slots'}->{'NTSM_SERVER_NO_OF_USERS'} 	= lookup_NTSM_val( '[ApproxUsers]', 		'[ServerComp]', "left([ServerName], $L) = '$hostN'");
		$EVENT->{'slots'}->{'NTSM_SERVER_IPADDRESS1'} 	= lookup_NTSM_val( '[IPAddress1]', 			'[ServerComp]', "left([ServerName], $L) = '$hostN'");
		$EVENT->{'slots'}->{'NTSM_SERVER_SVR_STATUS'}	= lookup_NTSM_val( '[SvrStatus]', 			'[ServerComp]', "left([ServerName], $L) = '$hostN'");
		$EVENT->{'slots'}->{'NTSM_SERVER_OS_VERSION'} 	= lookup_NTSM_val( '[OSVersion]', 			'[ServerComp]', "left([ServerName], $L) = '$hostN'");

# Now make a similar call to the CSS database
# IF I COMMENT OUT THE LINES BELOW ASSOCIATED WITH THE CSS DB THE SCRIPT WORKS.

		$EVENT->{'slots'}->{'CSS_SLA_CATEGORY'} 			= lookup_CSSD_val( '[Cover]', 				 '[UnixServers]', "left([ServerName], $L) = '$hostN'");
		$EVENT->{'slots'}->{'CSS_SERVER_DESCR'} 			= lookup_CSSD_val( '[UseSubType]', 			 '[UnixServers]', "left([ServerName], $L) = '$hostN'");
		$EVENT->{'slots'}->{'CSS_SERVER_LOCATION'} 		= lookup_CSSD_val( '[Building]', 			 '[UnixServers]', "left([ServerName], $L) = '$hostN'");
		$EVENT->{'slots'}->{'CSS_SERVER_NETWORK'} 		= lookup_CSSD_val( '[Network]', 				 '[UnixServers]', "left([ServerName], $L) = '$hostN'");
		$EVENT->{'slots'}->{'CSS_SERVER_ENVIRONMENT'} 	= lookup_CSSD_val( '[Environment]', 		 '[UnixServers]', "left([ServerName], $L) = '$hostN'");
		$EVENT->{'slots'}->{'CSS_SERVER_ASSETNO'} 		= lookup_CSSD_val( '[AssetNo]', 				 '[UnixServers]', "left([ServerName], $L) = '$hostN'");
		$EVENT->{'slots'}->{'CSS_SERVER_IPADDRESS1'} 	= lookup_CSSD_val( '[Primary_IP_Address]', '[UnixServers]', "left([ServerName], $L) = '$hostN'");
		$EVENT->{'slots'}->{'CSS_SERVER_SERVICE'} 		= lookup_CSSD_val( '[ServiceID]', 			 '[UnixServers]', "left([ServerName], $L) = '$hostN'");
		$EVENT->{'slots'}->{'CSS_SERVER_OS'} 				= lookup_CSSD_val( '[OS]', 					 '[UnixServers]', "left([ServerName], $L) = '$hostN'");
		$EVENT->{'slots'}->{'CSS_SERVER_OS_VERSION'} 	= lookup_CSSD_val( '[OS_Version]', 			 '[UnixServers]', "left([ServerName], $L) = '$hostN'");
		$EVENT->{'slots'}->{'CSS_SERVER_TEAM'} 			= lookup_CSSD_val( '[Team]', 					 '[UnixServers]', "left([ServerName], $L) = '$hostN'");
	



# End of changes made 18/03/09 by Mych Dubil


##</code><code>##

# used to lookup_values from the NTSM database
sub lookup_NTSM_val
{
	LogIt( $fhDEBUG, "=x" x 40 ); # so we can see the start of a new "run"
   LogIt( $fhDEBUG,"Entering sub:lookup_NTSM_val args: @_") if $CONFIG{DEBUG} > 3;
   my $cols     = shift;  # comma sep
   my $table    = shift;
   my $criteria = shift;

   LogIt( $fhDEBUG,"calling: lookup( $cols, $table, $criteria);") if $CONFIG{DEBUG}>1;


   my $results = lookup($CONFIG{"NTSM_DB_DSN"},  $cols, $table, $criteria);

   LogIt( $fhDEBUG, "lookup_NTSM_val got result \"" . $results->{$cols} . "\"") if $CONFIG{DEBUG}>1;

   
   return( $results->{ $cols });

}

# used to lookup_values from the FAAD database
sub lookup_FAAD_val
{
	LogIt( $fhDEBUG, "=x" x 40 ); # so we can see the start of a new "run"
   LogIt( $fhDEBUG,"Entering sub:lookup_FADD_val args: @_") if $CONFIG{DEBUG} > 3;
   my $cols     = shift;  # comma sep
   my $table    = shift;
   my $criteria = shift;

   LogIt( $fhDEBUG,"calling: lookup( $cols, $table, $criteria);") if $CONFIG{DEBUG}>1;


   my $FAADval = lookup($CONFIG{"FAAD_DB_DSN"},  $cols, $table, $criteria);

   LogIt( $fhDEBUG, "lookup_FADD_val got result \"" . $FAADval->{$cols} . "\"") if $CONFIG{DEBUG}>1;

   
   return( $FAADval->{ $cols });

}

# used to lookup_values from the CSS database
sub lookup_CSSD_val
{
	LogIt( $fhDEBUG, "=x" x 40 ); # so we can see the start of a new "run"
   LogIt( $fhDEBUG,"Entering sub:lookup_CSSD_val args: @_") if $CONFIG{DEBUG} > 3;
   my $cols     = shift;  # comma sep
   my $table    = shift;
   my $criteria = shift;

   LogIt( $fhDEBUG,"calling: lookup( $cols, $table, $criteria);") if $CONFIG{DEBUG}>1;


   my $CSSDval = lookup($CONFIG{"CSSD_DB_DSN"},  $cols, $table, $criteria);

   LogIt( $fhDEBUG, "lookup_CSSD_val got result \"" . $CSSDval->{$cols} . "\"") if $CONFIG{DEBUG}>1;

   
   return( $CSSDval->{ $cols });

}

sub lookup
{
   LogIt( $fhDEBUG, "Entering sub:lookup args: @_") if $CONFIG{DEBUG} > 3;
   my $DSN      = shift;	# comma sep
   my $cols     = shift;  
   my $table    = shift;
   my $criteria = shift;

   my $result;

   # Let's create the Connection object used to establish the connection
   #


   my $conn = Win32::OLE->CreateObject('ADODB.Connection');

   # Open a connection using the SQL Server OLE DB Provider
   #

   LogIt( $fhDEBUG, "Opening ADODB connection") if $CONFIG{DEBUG} > 3;

   $conn->Open(<<EOF);
$DSN
EOF

   LogIt( $fhDEBUG, "COMPLETE: Opening ADODB connection") if $CONFIG{DEBUG} > 3;

   #

   my $sql =<<SQL;
   SELECT $cols
   FROM   $table
   WHERE  $criteria
SQL


   map { LogIt( $fhDEBUG, $_ )} split /\n/, $sql  if $CONFIG{DEBUG} > 3;
   my $rs = $conn->Execute($sql);
   LogIt( $fhDEBUG, "COMPLETE: executing SQL") if $CONFIG{DEBUG} > 3;

   if( !defined( $rs ) ){
      LogIt( $fhDEBUG,"something went wrong: ", Win32::OLE->LastError());
      LogIt( $fhERROR, "something went wrong: ", Win32::OLE->LastError());
      die "<lookup> died something went wrong: ", Win32::OLE->LastError(),"\n";
   }
  

   while( ! $rs->EOF) 
   {
      my $i= 0;
      COL:
      foreach my $col (split /,/, $cols)
      {

          next COL unless $col =~ /\w+/;
          LogIt( $fhDEBUG,"getting val for \$col $col") if $CONFIG{DEBUG} > 3;
          LogIt( $fhDEBUG,"Value: ". $rs->Fields($i)->value) if $CONFIG{DEBUG} > 3;


          $result->{$col} = $rs->Fields($i)->value;
          trim( $result->{$col});
          $i++;
      }
   $rs->MoveNext;
   }

   LogIt( $fhDEBUG, "Closing ADODB connection") if $CONFIG{DEBUG} > 3;
   
   $conn->Close();
   
   #commented out because this doesn't log correctly.... Dumper output is split over multipul lines
   #LogIt( $fhDEBUG,"". Dumper $result) if $CONFIG{DEBUG};
   ( map { LogIt( $fhDEBUG,"". $_ ) } split /\n/, Dumper $result ) if $CONFIG{DEBUG}  > 3;
   return( $result );
}

##</code><code>##

#==========  more robust logging  ===============#
sub OpenLog
{
	my $Log = shift; # logfile to OPEN

	my $LogCurrSize;
	$LogCurrSize = -s $Log || 0;
	if( $LogCurrSize  <  $CONFIG{ LogMaxSz } )
	{
		# below the max log file size, so just open it

		open( FILE, ">>$Log" ) or die "Unable to APPEND to log ($Log) : $!\n";
	}
	else
	{
		# were over the max size. we need to open a new logfile
		# we need to rotate the logs before we create a new one
		# log   moves to Log.1
		# log.1 moves to log.2 
		# .....
		# log.n is removed

		# first remove the oldest log if it exists
		if ( -e "$Log.${CONFIG{ LogMaxGens }}")
		{
			unlink( "$Log.${CONFIG{ LogMaxGens }}" ) or die "Unable to remove $Log.${CONFIG{ LogMaxGens }} : $!\n";
		}

		my $CurrGeneration = $CONFIG{ LogMaxGens };
		while ( --$CurrGeneration )
		{
			# if the current generation exist the rename it
			if( -e "$Log.$CurrGeneration" )
			{
				rename( "$Log.$CurrGeneration", ("$Log." .  ( $CurrGeneration+1)) ) or die "Unable to move $Log.$CurrGeneration to $Log.",( $CurrGeneration+1)," : $!\n";

			}
		}

		rename( "$Log", "$Log.1" ) or die "unable to move $Log to $Log.1 : $!\n";

		open( FILE, ">$Log" ) or die "Unable to CREATE log ($Log) : $!\n";

	}
	return( *FILE ); # return the filehandle
}

sub LogIt
{
	my $fhLog    = shift;     # file handle to write the message to
	my $Message  = shift;	  # message to write to the logfile

        my %caller_info;
        
        @caller_info{"package","filename","line","subroutine","hasargs","wantarray","evaltext","is_required","hints", "bitmask", "hinthash"} = caller(0);
#       @caller_info{                            "subroutine"                                                                              } = defined( ${[ caller(1) ]}[3]) ? ${[ caller(1) ]}[3]  : (${[ caller(0) ]}[3] =~ s/::LogIt//);
        if ( defined( ${[ caller(1) ]}[3]) )
        {
             $caller_info{ "subroutine" }   = ${[ caller(1) ]}[3];
        }
        else
        {
             my ($temp_sub) = ${[ caller(0) ]}[3];
             $temp_sub      =~ s/::LogIt//;
             $caller_info{ "subroutine" }   = $temp_sub;
        }
        
	my ($strDate ) = strftime("%Y-%m-%d %H:%M:%S", localtime());

	printf $fhLog ( "%-20s   %-25s   %-5s   %-25s   %s\n", $strDate, $caller_info{"filename"}, $caller_info{"line"}, $caller_info{"subroutine"}, $Message);
}