problems with perl threads in debugger

dherzhau wrote on Mon Sep 10 17:38:46 MEST 2007:
Hi,

I'm working with Perl threads and try to debug a Perl script. Unfortunately
the debugger dies with an IOException. This Exception occurs repeatingly
on starting the second thread.

Environment:

Windows XP
Perl 5.8.8.819 (activestate)
EPIC 0.6.12

If I run the script from eclipse without debug the threads are created.

Best regards

Dirk
jploski wrote on Mon Sep 10 18:21:37 MEST 2007:
There's no multithreading support in EPIC (i.e. the stack trace is managed
for a single thread only). Post the script, anyway, maybe the IOExceptions
you mention can be avoided.
dherzhau wrote on Tue Sep 11 11:11:17 MEST 2007:
Hi , thx a lot for your support.Here is the script:

it requires a text file with the following content:

select '1' 
from dual;
select '2' from dual;
select '3' from dual;


#!/usr/local/bin/perl -w
#  csdbperf.pl
#
#  Synopsis:  executes multiple sqls in parallel
#
#  usage:  perl csdbperf.pl -db syltst4 -user test -pass secret -debug y
-file d:\\mysql.txt
#
#          db [string]    		: is the database identifier for the database
connection
#          user [string] 	 	: is the user wich connects to the database
#          pass [string]  		: is the password of the user for the database
connection
#          debug [y]      		: if enabled gives some information to STDOUT
#          file [string]                : specified sql file
#	   Version  0.1                 :         Initial coding
#
use strict;

use warnings;
use DBI;
use DBD::Oracle;
use threads;
use Thread::Queue;

use POSIX qw/uname/;
use Getopt::Long;
use Sys::Hostname;

# Script
use vars qw($VERSION $SCRIPT $outfile $debug $logfile $logging );
use vars qw($user $db $password $file $schema $schemapassword $setup);
use vars qw($dbh $c1 $maxthreads);
use vars qw(@CPUDAT @IODAT $hostname $tc);

$VERSION = 0.1;
$SCRIPT  = "csdb2perf.pl";

sub init();
sub main();
sub oraconnect($ $ $);
sub sql();
sub elogit($ $);

my $queue = Thread::Queue->new;

init();
main();

#------------------------------------------------------------------------------
# NAME                  : init                               Date : 31.07.2007
# Description           : init of the script
# call                  : init()
# Author                : herzhaus
#------------------------------------------------------------------------------
sub init() {

    # Unbuffer STDOUT
    $|++;
    GetOptions(
        "file=s",   => \$file
        ,
        "user=s",   => \$user
        ,
        "schema=s", => \$schema,

        "pass=s",  => \$password
        ,
        "db=s",    => \$db
        ,
        "setup=s", => \$setup
        ,
        "debug=s", => \$debug
    );
    elogit( 'INFO', "Start subroutine init" );

    if ( !defined $file && !defined $setup ) {
        elogit( 'WARN', "SAR defaultdatsets are used!" );

    }

    if ( !defined $user || !defined $password || !defined $db ) {

        elogit( 'ERROR', "Database settings (user/password/db) are required!"
);
        exit -1;

    }
    $tc = 0;

    if ( !defined $maxthreads ) { $maxthreads = 4 }

    elogit( 'INFO', "Stop subroutine init" );
}

#------------------------------------------------------------------------------
# NAME          : elogit                                      Date : 17.01.2007
# Description   : write loginfo for debug
# call          : elogit(loglevel, logtext)
# Author        : herzhaus
#------------------------------------------------------------------------------
sub elogit($ $) {
    my $loglevel = shift;
    my $text     = shift;

    my ( $sek, $min, $std, $tag, $mon, $jahr, $wtag, $jtag, $sz ) = localtime();
    $sek = "0$sek" if ( $sek < 10 );
    $min = "0$min" if ( $min < 10 );
    $tag = "0$tag" if ( $tag < 10 );
    $mon = "0$mon" if ( $mon < 10 );
    $mon++;
    $jahr += 1900;
    if ( !defined $debug ) {
        $debug = 'n';
    }
    if (    $debug eq 'y'
         or substr( $loglevel, 0, 3 ) eq 'ERR'
         or substr( $loglevel, 0, 4 ) eq 'WARN' )
    {
        print "[$jahr.$mon.$tag $std:$min:$sek][$SCRIPT/$VERSION] [$loglevel]
$text\n";
    }
}

#------------------------------------------------------------------------------
# NAME			: connect								  Date : 19.01.2007
# Description  	: connects to the database
# call		    : connect (database user password)
# Author		: herzhaus
#------------------------------------------------------------------------------
sub oraconnect($ $ $) {
    elogit( 'INFO', "Start subroutine oraconnect" );
    my $db       = shift;
    my $user     = shift;
    my $password = shift;

    my $mymode = 0;

    if ( $user eq ' sys ' ) {
        $mymode = 2;
    }
    else {
        $mymode = 0;
    }

    $dbh = DBI->connect(
                         "dbi:Oracle:$db",
                         $user,
                         $password,
                         {
                           ora_session_mode => $mymode,
                           RaiseError       => 1,
                           PrintError       => 1,
                           AutoCommit       => 0
                         }
    );

    if ( defined $dbh ) {
        $c1 = $dbh->do("alter session set optimizer_index_cost_adj = 10");
        $c1 = $dbh->do("alter session set optimizer_max_permutations = 10000");
        $c1 = $dbh->do("ALTER SESSION FORCE PARALLEL QUERY");

    }
    else {

        elogi t( ' ERROR ', "   Failed login with username $user at $_ ~$DBI::errstr~"
);

        if ( $DBI::errstr =~ /ORA-01017|ORA-1017|ORA-01004|ORA-01005/ )
{

            elogit( "ERROR", "Login error $DBI::errstr ! maybe wrong login
credentials with username $user at $_ !\n" );

        }
        elsif ( $DBI::errstr =~ /ORA-12224/ ) {
            elogit(

                   "ERROR",
"You received an ORA-12224, which usually means the listener is down, or
your connection definition in your tnsnames.ora file is incorrect. Check
both of these things and try again with username $user at $_."
            );

        }
        elsif ( $DBI::errstr =~ /ORA-01034/ ) {
            elogit(
                "ERROR",
"You received an ORA-01034, which usually means the database is down. Check
to be sure the database is up and try againwith username $user at $_."
            );
        }
        elsif ( $DBI::errstr =~ /ORA-01090/ ) {
            elogit(
                "ERROR",
"You received an ORA-01090, which means the database is in the process of
coming down with username $user at $_."
            );
        }
        elsif ( $DBI::errstr =~ /ORA-12154/ ) {
            elogit(
                "ERROR",
"You received an ORA-12154, which probably means you have a mistake in your
TNSNAMES.ORA file for the database that you chose with username $user at
$_."
            );

        }
        elsif ( $DBI::errstr =~ /ORA-12505/ ) {
            elogit(
                "ERROR",
"You received an ORA-12505, which probably means you have a mistake in your
TNSNAMES.ORA file for the database that you chose, or the database you are
trying to connect to is not defined to the listener that is running on that
node with username $user at $_."
            );
        }
        elsif ( $DBI::errstr =~ /ORA-12545/ ) {
            elogit(
                "ERROR",
"You received an ORA-12545, which probably means you have a mistake in your
TNSNAMES.ORA file for the database that you chose. (Possibly the node name)
with username $user at $_."
            );
        }
        else {
            elogit( "ERROR", "Login error $DBI::errstr ! maybe wrong login
credentials with username $user at $_ !\n" );
        }
    }
    elogit( 'INFO', "\t Connected to $db as $user with $password" );
    elogit( 'INFO', "Stop subroutine oraconnect" );

}

#------------------------------------------------------------------------------
# NAME          : main                                        Date : 30.07.2007
# Description   : the work starts here
# call          : main()
# Author        : herzhaus
#------------------------------------------------------------------------------

sub main() {
    elogit( 'INFO', "Start subroutine main" );
    use vars qw($mytime $myusr $mysys $mywio $myidle);
    use vars qw($mydevice $mybusy $myavque $myrws $myblks $myavwait $myavserv
$otime);
    use vars qw($mypos $myday $mymonth $myyear);

    my $thr;

    $hostname = hostname();

    for ( my $i = 1 ; $i <= $maxthreads ; $i++ ) {
        elogit( 'INFO', "Thread " . $tc . " created" );
        $queue->enqueue("mystart");
        $thr = threads->create( \&sql );
    }

    #$thr = new Thread \&sql();    #, qw(Param1 Param2 $Param3);
    if ( defined $file ) {
        open( INFILE, "$file" )
          or die("The file [$file] caused a problem. Reason: $!.");

        my $mysql = '';

        while ( my $line =  ) {
            chomp($line);
            elogit( 'INFO', "\t LINE : $line \n" );
            if ( $line =~ m/;/ ) {
                chomp($mysql);
                $mysql = $mysql . substr( $line, 0, index( $line, ';' )
);
                elogit( 'INFO', "\t ENQUE : $mysql \n" );
                $queue->enqueue("$mysql");
                $mysql = '';
            }
            else {
                $mysql = $mysql . $line;
            }
        }

        for ( my $i = 1 ; $i <= $maxthreads ; $i++ ) {
            elogit( 'INFO', "\t Thread stop issued" );
            $queue->enqueue("mystop");
        }
        $queue->enqueue(undef);

        if ( defined $thr ) {
            $thr->join;
        }

    }
    elogit( 'INFO', "Stop subroutine main" );
}

#------------------------------------------------------------------------------
# NAME          : insertSARdata                                  Date :
20.08.2007
# Description   : the work starts here
# call          : insertSARdata(date)
# Author        : herzhaus
#------------------------------------------------------------------------------

sub sql() {
    elogit( 'INFO', "Start subroutine sql" );

    my $sql = '';

    $tc = $tc + 1;

    while ( $sql = $queue->dequeue ) {
        if ( $sql eq "mystart" ) {
            oraconnect( $db, $user, $password );
        }
        elogit( 'INFO', "\t SQL: $sql " );

        if ( defined $dbh && $sql ne "mystart" ) {
            if ( $sql ne "mystop" ) {
          
                $c1 = $dbh->prepare("$sql") or die "Couldn' t prepare statement:
" . $dbh->errstr;

                if ( defined $c1 ) {
                    $c1->execute or die $dbh->errstr;

                    elogit( 'INFO', "\t open cursor " );

                    while ( my @zeile = $c1->fetchrow_array() ) {
                        if (@zeile) {
                            elogit( 'INFO', "\t LIST: @zeile thread: " .
++$tc . " \n \n" );
                        }
                    }
                     
                    $c1->finish;

                }
            }
            if ( defined $dbh && $sql eq "mystop" ) {
                elogit( 'INFO', "\t disconnect");
                $dbh->disconnect;
            }
        }
    }

    elogit( 'INFO', "Stop subroutine sql" );

}

jploski wrote on Tue Sep 11 20:50:33 MEST 2007:
I don't have access to Oracle or the installed drivers, so I can't try out
your script as it is, sorry. If you can modify it so that it doesn't require
Oracle but still has the incorrect behavior, I will have another look.

Note: The above is an archived snapshot of a forum thread. Use the original thread at sf.net to post comments.