получение ошибки памяти при запуске сценария perl

Question

Я очень плохо разбираюсь в используемом здесь сценарии perl. Это сделал старый разработчик.

У меня есть сценарий «deploykit.pl»

он внутренне вызывает «OracleSqlHelper.pm»

use strict;
no warnings 'misc';

package OracleSqlHelper;

use DBI;
BEGIN {
 eval 'use DBD::Oracle qw(:ora_types)' or print "Oracle DBD not installed\n";
}

my $log;
my $env;

sub new
{
   my $class = shift;
   my $self = {};

   bless $self;

   $self->{classname} = ref( $self );
   $self->{connectstring} = ref( $self );
   $self->{schema} = "";
   $self->{password} = "";
   $self->{tnsname} = "";
   $self->{db_handle} = "";

   return bless $self, $class;

}

# -------------------------------------
# Set Log
# -------------------------------------
sub set_log
{
   my $self = shift;
   $log = shift;
}

#-----------------------------------------------------------------
# set_env
# Set the env variable to point to the configuration file parameters
#-----------------------------------------------------------------
sub set_env
{
   my $self = shift;
   $env = shift;
}

#-----------------------------------------------------------------
# set_schema
#-----------------------------------------------------------------
sub set_schema
{
   my $self = shift;
   $self->{schema} = shift;
}

#-----------------------------------------------------------------
# set_password
#-----------------------------------------------------------------
sub set_password
{
   my $self = shift;
   my $pwd  = shift;

   my $temppwd = "\"" . $pwd . "\"";

   $self->{password} = $temppwd;
}

#-----------------------------------------------------------------
# set_tnsname
#-----------------------------------------------------------------
sub set_tnsname
{
   my $self = shift;
   $self->{tnsname} = shift;
}

#-----------------------------------------------------------------
# Disconnect from the database
#-----------------------------------------------------------------
sub db_disconnect
{
   my $self = shift;

   my $method = "db_disconnect";
   $log->log( "*** Enter $method in OracleSqlHelper ***" );

   $self->{db_handle}->disconnect;
}

#-----------------------------------------------------------------
# check_install
# Determine if the Oracle libraries are installed
# Return 0 (false) if the modules are NOT installed
# If the modules aren't then this module should not be used.
#-----------------------------------------------------------------
sub check_install
{
   my $self   = shift;
   my $retval = 0;

   my $method = "check_install";
   $log->log( "*** Enter $method in OracleSqlHelper ***" );

   my $res = `perldoc -l DBD::Oracle`;

   $log->log( "Check Install Result: $res" );

   if ( $res )
   {
      $retval = 1;
   }
   else
   {
      $log->log( "==============================" );
      $log->log( "WARNING:" );
      $log->log( "Oracle DBI Components not installed on this host" );
      $log->log( "==============================" );
   }

   return $retval;
}

#-----------------------------------------------------------------
# initialize
#-----------------------------------------------------------------
sub initialize
{
   my $self     = shift;
   my $tns      = shift;
   my $schema   = shift;
   my $password = shift;

   my $method = "initialize";
   $log->log( "*** Enter $method in $self->{classname} ***" );

   $self->set_password( $password );
   $self->set_schema( $schema );
   $self->set_tnsname( $tns );

   $self->log_credentials();

   $self->set_db_handle();

}

#-----------------------------------------------------------------
# initialize_using_step
# A SQL step should have the tns alias, the schema name and the password set
#-----------------------------------------------------------------
sub initialize_using_step
{
   my $self = shift;
   my $step = shift;

   my $method = "initialize_using_step";
   $log->log( "*** Enter $method in $self->{classname} ***" );

   $self->set_tnsname ( $env->get_tns( $step->{schema}, $step->{database} ) );
   $self->set_schema  ( $step->{schema} );
   $self->set_password( $step->{password} );

   $self->log_credentials();

   if ( ( not $self->{tnsname} ) or ( not $self->{schema} ) or ( not $self->{password} ) )
   {

      $log->log( "========================================" );
      $log->log( "Exception:" );
      $log->log( "Could not get valid database parameters in OracleSqlHelper" );
      $log->log( "One or more of the following values are Null" );
      $log->log( "Database: Schema: Password" );
      $log->log( "========================================" );
      $log->send_err_log();
      die "Will not be able to set the db_handle in OracleSqlHelper";

   }

   $self->set_db_handle();

}

#-----------------------------------------------------------------
#
#-----------------------------------------------------------------
sub log_credentials
{
   my $self = shift;

   my $tns = $self->{tnsname}   ? $self->{tnsname}  : "<null>";
   my $sch = $self->{schema}    ? $self->{schema}   : "<null>";
   my $pwd = $self->{password}  ? $self->{password} : "<null>";

   $log->log( "SqlHelper Credentials: DB: [$tns] Schema: [$sch]" );
   print "Password: [$pwd]\n";

}


#-----------------------------------------------------------------
# set_db_handle
#-----------------------------------------------------------------
sub set_db_handle
{
   my $self = shift;

   my $method = "set_db_handle";
   $log->log( "*** Enter $method in $self->{classname} ***" );

   $self->{db_handle} = DBI->connect( "dbi:Oracle:$self->{tnsname}", $self->{schema}, $self->{password},
                           { AutoCommit => 0,
                             PrintError => 0,
                             RaiseError => 0,
                             LongReadLen => 20000 }


       ) or do {
               $log->set_logerr( "on" );
               $log->log( "==================================" );
               $log->log( "Exception:" );
               $log->log( "In OracleSqlHelper:set_db_handle" );
               my $estr = DBI->errstr;
               $log->log( "DatbaseError: $estr" );
               $log->log( "==================================" );
               $log->send_err_log();
               die "Can't connect: ". DBI->errstr."\n"; };

               $self->{db_handle}->{RaiseError} = 1;
#   END
#   {
#      $log->log( "END" );
#   }

}

#-----------------------------------------------------------------
# verify_supplemental_logging
# Parameters: A SQL step.  Contains the parameters tns, schema, password
# Step has the tns alias, the schema and the password
#-----------------------------------------------------------------
sub verify_supplemental_logging
{
   my $self = shift;
   my $step = shift;

   my $retval = 0;

   my $method  = "check_supplemental_logging";
   $log->log( "*** Enter $method in $self->{classname} ***" );

   $self->initialize_using_step( $step );

   my $sqlcmd = "SELECT SUPPLEMENTAL_LOG_DATA_MIN FROM V\$DATABASE";

   $retval = $self->execute_sql( $sqlcmd );

   $self->db_disconnect();

   return $retval;

}


#-----------------------------------------------------------------
# verify_log_mode
# Parameters: A SQL step.  Contains the parameters tns, schema, password
# Returns the query result
# Step has the tns alias, the schema and the password
#-----------------------------------------------------------------
sub verify_log_mode
{
   my $self = shift;
   my $step = shift;

   my $retval = 0;

   my $method  = "check_supplemental_logging";
   $log->log( "*** Enter $method in $self->{classname} ***" );

   $self->initialize_using_step( $step );

   my $sqlcmd = "SELECT LOG_MODE FROM V\$DATABASE";

   $retval = $self->execute_sql( $sqlcmd );

   $self->db_disconnect();

   return $retval;

}

#-----------------------------------------------------------------
# execute_sql
# Query result MUST be one row only
#-----------------------------------------------------------------
sub execute_sql
{
   my $self = shift;
   my $query = shift;

   my $db_result = "";

   #------------------------------------------------
   # db_handle needs to be set
   #------------------------------------------------
   my $query_handle = $self->{db_handle}->prepare($query);

   $query_handle->execute();
   $query_handle->bind_columns(undef, \$db_result);

   $query_handle->fetch();

   return $db_result;
}

#-----------------------------------------------------------------
#    $stat = "WC_PVH.get_lates_status( \"ods_bug\" )";
#-----------------------------------------------------------------
sub get_deploy_status
{
   my $self   = shift;
   my $module = shift;

   my $statval;

   eval
   {
      my $func = $self->{db_handle}->prepare( q{
        BEGIN
            :stat := WC_PVH.get_latest_status( p_type => :parameter1 );
        END;
        } );

    $func->bind_param( ":parameter1", $module );
    $func->bind_param_inout( ":stat", \$statval, 50 );
    $func->execute;

   };

    return $statval;
}

#-----------------------------------------------------------------
#    $stat = "WC_PVH.get_lates_status( \"ods_bug\" )";
#-----------------------------------------------------------------
sub set_deploy_status
{
   my $self   = shift;
   my $module = shift;
   my $value  = shift;

   my $method  = "set_deploy_status";
   my $pmodule = "p_" . $module;

   $log->log( "*** Enter $method in $self->{classname} ***" );
   $log->log( "Will set $pmodule to [$value]" );

   my $func = $self->{db_handle}->prepare( qq(BEGIN WC_PVH.update_version(  $pmodule => ? ); END; ) );

   $func->bind_param( 1, $value );

   if( $@ )
   {
       warn "Execution of stored procedure failed: $DBI::errstr\n";
       $self->{db_handle}->rollback;
   }

   $func->execute;
   $self->{db_handle}->commit;
}

#-----------------------------------------------------------------
# get_latest_version
# Note that the db_handle needs to be set prior to calling this method
#-----------------------------------------------------------------
sub get_latest_version
{
   my $self   = shift;
   my $method = "get_latest_version";

   $log->log( "*** Enter $method in $self->{classname} ***" );

   my $statval;

   if ( not $self->{db_handle} )
   {
      $log->log( "Db_handle not set in $self->{classname}.  Cannot process query" );
      return;
   }

    eval
    {
     my $func = $self->{db_handle}->prepare( q{
        BEGIN
            :stat := WC_PVH.get_latest_version();
        END;
    } );

    $func->bind_param_inout( ":stat", \$statval, 50 );
    $func->execute;

    return $statval;

   };

}

#-----------------------------------------------------------------
# set_latest_version
# WC_PVH.update_version( p_patch_version => '&1');
#-----------------------------------------------------------------
sub set_latest_version
{
   my $self   = shift;
   my $value  = shift;

   my $method  = "set_latest_version";

   $log->log( "*** Enter $method in $self->{classname} ***" );
   $log->log( "Setting kit version to [$value]" );

   my $func = $self->{db_handle}->prepare( qq(BEGIN WC_PVH.update_version(  p_patch_version => ? ); END; ) );

   $func->bind_param( 1, $value );

   if( $@ )
   {
       warn "Execution of stored procedure failed: $DBI::errstr\n";
       $self->{db_handle}->rollback;
   }

   $func->execute;
   $self->{db_handle}->commit;
}

#-----------------------------------------------------------------
# Connect
# PrintError  => 0,      # Force errors to generate warnings
# RaiseError  => 0,      # Force DBI errors to generate a perl error
# LongReadLen => 20000,  # Max length for LONG and LOB fetches, set to some reasonable value. Default is 80 ;-)
#-----------------------------------------------------------------
sub get_multiple_rows
{
   my $self = shift;

   my $VALID_COUNT = 0;

    #------------------------------------------------
    # Make sure the PROJECT_NAME is valid & active
    #------------------------------------------------
    my $query = "select patch_version, patch_date from patch_version_history";

    my $stmt = $self->{db_handle}->prepare($query);
    $stmt->execute();

   # Fetch the data
   while (my ($ver, $pdate) = $stmt->fetchrow_array)
   {
      print "Version: $ver  Dt: $pdate\n";
   }

   $stmt->finish();
}

#-------------

1; 

Работал тот же код другая машина с perl 5.10, не работает на perl 5.16

Я не знаю, как проверить пакеты, которые он использует для DBI. Я пробовал использовать старую версию perl 5.8 на отказавшем хосте все еще та же ошибка

ОШИБКА

2020-07-09 06:41:19 In StatusHelper: Db: [GGATE01_XXXX] Schema: [USERNAME]  Pwd: [*******]
2020-07-09 06:41:19 *** Enter set_db_handle in OracleSqlHelper ***
2020-07-09 06:41:19
Memory fault

код deploy.pl

# -----------------------------
use Step;
use ConfigFile;
use Date::Manip;
use Spreadsheet::Read;
use Logger;
use StepHelper;
use FileHelper;
use KitHelper;
use Rpd11gHelper;
use DacHelper;
use OdsHelper;
use OdiHelper;
use KMDW_Helper;
use StatusHelper;
use OracleSqlHelper;



# -------------------------------
# Instantiate a StatusHelper
# The StatusHelper can use OracleSqlHelper methods
# It is imperative that the log & env be set as the sqlHelper will use these for instantiation
# Note that if Oracle:DBD components are not installed, the StatusHelper will used std Sql files
# -------------------------------
 
 my $statusHelper = new StatusHelper();

   $statusHelper->set_log( $log );
   $statusHelper->set_env( $env );
   $statusHelper->set_kitHelper( $kitHelper );
   $statusHelper->set_sqlHelper();





elsif ( $install_env eq "ods_host" )
   {
      my $odsHelper = new OdsHelper( $env, $install_env, $ods_param, $phase );

      $odsHelper->set_refresh( $dev_refresh );
      $odsHelper->set_log( $log );
      $odsHelper->set_stepHelper  ( $stepHelper );
      $odsHelper->set_statusHelper( $statusHelper );
      $odsHelper->set_sqlHelper   ();
      $odsHelper->deploy();

   }

Answer 1

Похоже, вы забыли простую команду «использовать CGI;»

Без вызова нового экземпляра!

Удачи ...

ps: An ответ гораздо важнее протокола, который не распознается простым человеком. Мне это кажется средним возрастом и никогда не будет признаком разговора, ориентированного на будущее.