Mych has asked for the wisdom of the Perl Monks concerning the following question:

I'm new to perl and have inherited a bit of code that I'm trying to add some extra features.

The script is run when a user right clicks on a management alert. Originally the script made one connection to a database to extract the catagory of the asset that had generated the alert.

I wanted to expand on this and pull out of another two databases some more information about the asset. (I had thought about merging the three DBs but they are controlled by different departments).

My first attempt was successful. I had created a ODBC connection to a the FAAD Database on the localhost. This allowed me to extract some extra info. I also made some extra calls to pull some more info from the NTSM DB

I then used basically the same code to connect to another db (CSS) on the localhost using a different ODBC connection. This fails at the first call with the following error...

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

Operation is not allowed when the object is closed.

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

[download]

The relevant snips of code are...

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 b
+ytes 
        LogMaxGens     => 3,              # how many logfile generatio
+ns shall we keep
        
                     #Below are ODBC connection that have been configu
+red on this local machine
                FAAD_DB_DSN     => "Provider=MSDASQL.1;Persist Securit
+y Info=False;Data Source=FAAD",
                CSSD_DB_DSN     => "Provider=MSDASQL.1;Persist Securit
+y Info=False;Data Source=CSSD",
                NTSM_DB_DSN    => "Provider=MSDASQL.1;Password=*******
+*******;Persist Security Info=True;User ID=****;Data Source=ntsm_serv
+er_database;Initial Catalog=Servers",
                STYLE_SHEET    => "stylesheets/Mych_timfo2.xsl",

        );

#=====================================================================
+===================#
#                                        CONFIG                       
+                   #
#=====================================================================
+===================#

[download]

This is the calls to lookup values in the DBs. (eventually I will make these one call per DB.)

# Original line to check NTSM database for hostname. I have hashed thi
+s 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( '[H
+ighest Site Category]', 'InfrastructureData', "server = '$EVENT->{'sl
+ots'}->{'hostname'}'");

# Added 18/03/09 by Mych Dubil a lookup to the FAAD database that extr
+acts several columns of data that we believe will be helpful to OCC a
+nd 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 fr
+om 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 n
+ot 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 $hos
+tN");
      
# The FAAD does have instances where the Machine_Name field has more c
+haracter 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 thi
+s asset

        $EVENT->{'slots'}->{'DEVICE_TYPE'}                     = looku
+p_FAAD_val( '[Sub_Type]',             '[FAAD_Data]', "left([Machine_N
+ame], $L) = '$hostN'");
        $EVENT->{'slots'}->{'OP_SYSTEM'}                     = lookup_
+FAAD_val( '[Operating_System]',    '[FAAD_Data]', "left([Machine_Name
+], $L) = '$hostN'");
        $EVENT->{'slots'}->{'ENVIRONMENT'}                     = looku
+p_FAAD_val( '[Environment]',         '[FAAD_Data]', "left([Machine_Na
+me], $L) = '$hostN'");
        $EVENT->{'slots'}->{'NETWORK'}                         = looku
+p_FAAD_val( '[Network]',                 '[FAAD_Data]', "left([Machin
+e_Name], $L) = '$hostN'");
        $EVENT->{'slots'}->{'ASSET_TAG'}                 = lookup_FAAD
+_val( '[Asset_Tag]',         '[FAAD_Data]', "left([Machine_Name], $L)
+ = '$hostN'");
        $EVENT->{'slots'}->{'LOCATION'}                         = look
+up_FAAD_val( '[Location]',             '[FAAD_Data]', "left([Machine_
+Name], $L) = '$hostN'");
        $EVENT->{'slots'}->{'PROJECT'}                         = looku
+p_FAAD_val( '[Project]',                 '[FAAD_Data]', "left([Machin
+e_Name], $L) = '$hostN'");
      
# Note I can make the new call to the NTSM database using $hostN inste
+ad of $EVENT->{'slots'}->{'hostname'}

        $EVENT->{'slots'}->{'NTSM_SLA_CATEGORY'}             = lookup_
+NTSM_val( '[Highest Site Category]',     '[InfrastructureData]', "lef
+t([Server], $L) = '$hostN'");

# Now make some extra calls to extract some other data from a differen
+t table

        $EVENT->{'slots'}->{'NTSM_SERVER_DESCR'}             = lookup_
+NTSM_val( '[ServerDescription]', '[ServerComp]', "left([ServerName], 
+$L) = '$hostN'");
        $EVENT->{'slots'}->{'NTSM_SERVER_LOCATION'}         = lookup_N
+TSM_val( '[ServerLocation]',     '[ServerComp]', "left([ServerName], 
+$L) = '$hostN'");
        $EVENT->{'slots'}->{'NTSM_SERVER_DOMAIN'}         = lookup_NTS
+M_val( '[ServerDomain]',         '[ServerComp]', "left([ServerName], 
+$L) = '$hostN'");
        $EVENT->{'slots'}->{'NTSM_SERVER_SERVICE_NO'}     = lookup_NTS
+M_val( '[ServerServiceNo]',     '[ServerComp]', "left([ServerName], $
+L) = '$hostN'");
        $EVENT->{'slots'}->{'NTSM_SERVER_ASSETNO'}         = lookup_NT
+SM_val( '[AsstNo]',                 '[ServerComp]', "left([ServerName
+], $L) = '$hostN'");
        $EVENT->{'slots'}->{'NTSM_SERVER_NO_OF_USERS'}     = lookup_NT
+SM_val( '[ApproxUsers]',         '[ServerComp]', "left([ServerName], 
+$L) = '$hostN'");
        $EVENT->{'slots'}->{'NTSM_SERVER_IPADDRESS1'}     = lookup_NTS
+M_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_NTS
+M_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 SCRI
+PT WORKS.

        $EVENT->{'slots'}->{'CSS_SLA_CATEGORY'}             = lookup_C
+SSD_val( '[Cover]',                  '[UnixServers]', "left([ServerNa
+me], $L) = '$hostN'");
        $EVENT->{'slots'}->{'CSS_SERVER_DESCR'}             = lookup_C
+SSD_val( '[UseSubType]',              '[UnixServers]', "left([ServerN
+ame], $L) = '$hostN'");
        $EVENT->{'slots'}->{'CSS_SERVER_LOCATION'}         = lookup_CS
+SD_val( '[Building]',              '[UnixServers]', "left([ServerName
+], $L) = '$hostN'");
        $EVENT->{'slots'}->{'CSS_SERVER_NETWORK'}         = lookup_CSS
+D_val( '[Network]',                  '[UnixServers]', "left([ServerNa
+me], $L) = '$hostN'");
        $EVENT->{'slots'}->{'CSS_SERVER_ENVIRONMENT'}     = lookup_CSS
+D_val( '[Environment]',          '[UnixServers]', "left([ServerName],
+ $L) = '$hostN'");
        $EVENT->{'slots'}->{'CSS_SERVER_ASSETNO'}         = lookup_CSS
+D_val( '[AssetNo]',                  '[UnixServers]', "left([ServerNa
+me], $L) = '$hostN'");
        $EVENT->{'slots'}->{'CSS_SERVER_IPADDRESS1'}     = lookup_CSSD
+_val( '[Primary_IP_Address]', '[UnixServers]', "left([ServerName], $L
+) = '$hostN'");
        $EVENT->{'slots'}->{'CSS_SERVER_SERVICE'}         = lookup_CSS
+D_val( '[ServiceID]',              '[UnixServers]', "left([ServerName
+], $L) = '$hostN'");
        $EVENT->{'slots'}->{'CSS_SERVER_OS'}                 = lookup_
+CSSD_val( '[OS]',                      '[UnixServers]', "left([Server
+Name], $L) = '$hostN'");
        $EVENT->{'slots'}->{'CSS_SERVER_OS_VERSION'}     = lookup_CSSD
+_val( '[OS_Version]',              '[UnixServers]', "left([ServerName
+], $L) = '$hostN'");
        $EVENT->{'slots'}->{'CSS_SERVER_TEAM'}             = lookup_CS
+SD_val( '[Team]',                      '[UnixServers]', "left([Server
+Name], $L) = '$hostN'");
    



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

[download]

A series of calls to each database (again not pretty will consolidate to one call eventually)...

# 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, $crite
+ria);

   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, $crite
+ria);

   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, $crite
+ria);

   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 connecti
+on
   #


   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{D
+EBUG} > 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->LastErro
+r(),"\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{DEB
+UG} > 3;
          LogIt( $fhDEBUG,"Value: ". $rs->Fields($i)->value) if $CONFI
+G{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 );
}

[download]

Finally although not the problem I've included it as it's called several times - the logging 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." .  ( $CurrGen
+eration+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]  : (${[ calle
+r(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{"subrouti
+ne"}, $Message);
}

[download]

As mentioned my ammendemnts (calls to the FAAD DB and extra calls to the NTSM DB) work. Using the same method I used to connect to the FAAD DB I added more code to make calls to the CSS DB. This fails at the first call.

Any help appreciated

Replies are listed 'Best First'.
Re: OLE exception from ADODB.Connection
by ELISHEVA (Prior) on Apr 06, 2009 at 14:02 UTC

    My guess is that your "closed" connection was never opened in the first place. The lines below to open the connection (excerpted from your code) have no error checking before or after them to make sure the connection is valid. If the connection can't be created, your program continues merrily as if everything was OK. You could be miles away from the original code that created the connection before you ever see problems.

      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

    [download]

    Logging isn't enough. It only reports problems, it doesn't change the program flow to account for them.

    Might be a good idea to add some error checking code and throw an exception or at least return undef immediately after the connection creation code when the connection fails.

    Best, beth

[reply]
[d/l]
[select]

      Thanks Beth and Annon,

      I've ammended the code to log the conn status, as recommended by both of you, to see if I am making a connection. (BTW I tested the connection using the 'Test connection' at the end of the ODBC wizzard and that's fine.

      The ammedments are...

         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

   # Added 07/04/09 on recomendation (Perl Monks) a check to see if DB
+ connection was really successfull.
   
   my $connStatus ="Not Set"

   if($conn->{State} == adStateOpen) {
     $connStatus = "Connection was a success";
     }
     else {
     $connStatus = "Connection failed because ";
     $connStatus .= $conn->Errors(0)->{Description};
     }


   #LogIt( $fhDEBUG, "COMPLETE: Opening ADODB connection") if $CONFIG{
+DEBUG} > 3;
   #changed above line to log status of connection

   LogIt( $fhDEBUG, $connStatus) if $CONFIG{DEBUG} > 3;

   # End of 07/04/09 changes

      [download]

      I also commented out all the extra sql lookups so that I was only making one lookup per DB... unfortunately the error now is... 

      CGI Timeout
The specified CGI application exceeded the allowed time for processing
+. The server has deleted the process.

      [download]

      Nothing is logged to the DEBUG file at all

      I'll try some more experimenting... meanwhile if someone can spot something I've obviously missed out...let me know.

      Mych
      I have not failed... just found 100 ways that don't work YET!
[reply]
[d/l]
[select]

        All, Thanks

        As you all rightly pointed out. I was not logging useful info in my debug file. The problem was a permissions issue to the DB. All DB's apart from CSSD had dbreader rights assigned to the IIS_User. My Bad.

        Mych
        I have not failed... just found 100 ways that don't work YET!
[reply]
Re: OLE exception from ADODB.Connection
by Anonymous Monk on Apr 06, 2009 at 13:59 UTC
    So its here right? 
       LogIt( $fhDEBUG, "Opening ADODB connection") if $CONFIG{DEBUG} > 3;

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

   LogIt( $fhDEBUG, "COMPLETE: Opening ADODB connection") if $CONFIG{D
+EBUG} > 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->LastErro
+r(),"\n";
   }

    [download]
    and it fails for CSS DB right? You never check if     $conn->Open($DSN); succeeded, so when it fails for CSS DB, you try to Execute , but you can't because it failed( probably account permissions). See http://www.xav.com/perl/Windows/windows_script_components.html 
         if($conn->{State} == adStateOpen) {
     $status = "Connection was a success";
     }
     else {
     $status = "Connection failed because ";
     $status .= $conn->Errors(0)->{Description};
     }

    [download]
[reply]
[d/l]
[select]
[reply]

Back to Seekers of Perl Wisdom