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

I have a problem with the debugger. I have a wrapper code that I want to enhance. The problem is that in one of the use statments it loads a module, and when that module is loaded the wrapper script starts even though I use perl -d. Any ideas? Here comes the wrapper code:
use strict; use Getopt::Std; use ImportLib::ImportLib; use ImportLib::DBWrapper; use Getopt::Long; use File::Copy; print "nisse";
when the ImportLib::ImportLib module is loaded the whole wrapper program starts and "nisse" is printed and perl leaces the program. Below follows the code of the module, I post the code of the whole module even thou it's kind of long (since I have not made it), but I assume that the problem resides in the beginning or the end of the code

###################################################################### +### # $Date: 2008/04/22 $ # $Revision: #4 $ # $Build: 8.2.080618.1558 $ # ###################################################################### +### package ImportLib::ImportLib; require 5.6.0; BEGIN{ use strict; use File::Spec; use Config; use FindBin qw( $Bin ); use ImportLib::Constants; require Exporter; our( $VERSION, @EXPORT, @ISA ); $VERSION = '#4'; @ISA = qw( Exporter ); require ImportLib::Configuration; require ImportLib::Logging; require ImportLib::Utilities; if( $ENV{ 'CRIMS_PERL_ENV_INI' } ne '1' && !$::disableRestart ){ local $SIG{ __WARN__ } = sub{}; local $SIG{ __DIE__ } = sub{}; my $cmd = join( '*', @ARGV ); if( $cmd =~ /(\*|^)\-i\**(.+?)(\*|$)/ ){ eval{ initConfig( $2 ); }; } else { eval{ initConfig(); } } if( $@ ){ print STDERR $@; $::die = $@; } else { if( getOS() eq 'WINDOWS' ){ ( system( $Config{ 'perlpath' }, "-x", $0, map { "\"$_\"" +} @ARGV ) == 0 ) || ( $::die = 1 ); } else { ( system( $Config{ 'perlpath' }, $0, @ARGV ) == 0 ) || ( +$::die = 1 ); } if( !$::die ){ exit; } } } } if( $::die ){ exit 255; } use strict; use File::Glob ':glob'; require ImportLib::Translation; our( $VERSION, @EXPORT, $exceptions ); $VERSION = '#4'; push @EXPORT, qw( $exceptions ); # Initialize random number seed srand(); #===================================================================== +===== # # Set of routines to change and expand the initialization file # #===================================================================== +===== # Change or Set value in initialization file # # Parameter # iniFile file name # sectionName name of section # keyName name of key to set # value value to set to # sub setProfileString{ my( $iniFile, $sectionName, $keyName, $value ) = @_; my( @newContents, $curSection, $curKey, $curValue, $line, $comments +, $done, $tmpFile ); $tmpFile = $iniFile . '_' . randID(); $sectionName = uc( $sectionName ); open( IN, $iniFile ) || exception( "Unable to open $iniFile: $!" ); $curSection = ''; $done = ''; $comments = ''; while( <IN> ){ if( /^\s*#/ || /^\s*$/ ){ $comments .= $_; next; } $line = $_; if( !$done ){ s/#.*$//; # remove comments s/^\s*//; s/\s*$//; if( m/^\s*\[\s*(\S*)\s*\]\s*$/ ){ # At the beginning of new section and key was not found. if( $curSection eq $sectionName ){ push @newContents, "$keyName=$value\n"; $done = 1; } else { $curSection = uc $1; } } elsif ( $curSection eq $sectionName ){ ($curKey, $curValue) = split /\s*=\s*/, $_, 2; if( $curKey && uc( $curKey ) eq uc( $keyName ) ){ $line = "$keyName = $value\n"; $done = 1; } } } push @newContents, $comments.$line; $comments = ''; } # At End of File without finding key if( !$done ){ # Section was not found, print section name before key value pai +r if( !( $curSection eq $sectionName ) ){ push @newContents, "\n"; push @newContents, "[$sectionName]\n"; } # Currently in relevant section, only print the key, value pair. push @newContents, "$keyName = $value\n"; } close IN || exception( "Unable to close $iniFile: $!" ); open( OUT, ">".$tmpFile ) || exception( "Unable to open $tmpFile: $!" ); print OUT @newContents; close OUT || exception( "Unable to close $tmpFile: $!" ); rename( $tmpFile, $iniFile ); } push @EXPORT, qw( &setProfileString ); # Expands all perl values to constants in initialization file -- this +is necessary for CTM app to properly run, but there should # be some way to avoid placing the passwords into the file # # Parameters # iniFile original file name # newIniFile new file name # sub expandIniFile{ my( $iniFile, $newIniFile ) = @_; my( $tmpFile, $newIni, $key, $value ); $iniFile = makeFilePath( '', $iniFile ); $newIniFile = makeFilePath( '', $newIniFile ); $tmpFile = $newIniFile . '_' . randID(); open( IN, $iniFile ) || exception( "Unable to open $iniFile: $!" ); open( OUT, ">".$tmpFile ) || exception( "Unable to open $newIniFile: $!" ); while( <IN> ){ next if( /^\s*#/ || /^\s*$/ ); s/#.*$//; # remove comments s/^\s*//; s/\s*$//; if( /\=/ ){ ($key, $value) = split( /\s*=\s*/, $_, 2 ); $value = dynamicValue( $value, 1 ); if( defined( $value ) && $value =~ /\S/ ){ print OUT "$key = $value\n"; } } else { print OUT $_, "\n"; } } close IN || exception( "Unable to close $iniFile: $!" ); close OUT || exception( "Unable to close $newIniFile: $!" ); rename( $tmpFile, $newIniFile ); } push @EXPORT, qw( &expandIniFile ); #===================================================================== +===== # # Other routines # #===================================================================== +===== # Waits for specified file to appear # # Parameters # file file path # timeout how long to wait in seconds # sub waitForFile{ my( $file, $timeout ) = @_; my( $time ); return 1 if( -e $file ); print "Waiting for file $file."; $| = 1; do{ $file = getFileCase( $file ); if( -e $file ){ print "\n"; $| = 0; return $time; } sleep 60; print "."; $time += 60; } until( $time > $timeout ); print "\n"; $| = 0; exception( "Timeout occured waiting for $file after $timeout second +s" ); } push @EXPORT, qw( &waitForFile ); # This is a hack to match the table name to the stored procedure name # # Parameters # table table name # # To Do: # These things should be consistent in the database # sub isProcEnabled{ my( $table ) = @_; $table = uc $table; my $shortName = uc( getConfig( 'ImportTableShortNames', $table ) ); # Default short name for non-import tables if( $shortName eq '' || !defined( $shortName ) ){ $shortName = uc( $table ); $shortName =~ s/^CSM_//; $shortName =~ s/^CS_//; $shortName =~ s/^TS_//; $shortName =~ s/^PMA_//; $shortName =~ s/^IMP_//; $shortName =~ s/^EXP_//; } if( $shortName eq "SECURITY_BLOOM" && ( getConfig( 'IMP_FEED_TABLE' +, 'SECURITY' ) || getConfig( 'IMP_FEED_TABLE', 'SECURITY_SOURCE' ) ) +){ return 1; } # Run tax lot if delta or normal tax lot import is enabled if( $shortName eq 'TAX_LOT' && getConfig( 'IMP_FEED_TABLE', 'TAX_LO +T_DELTA' ) ){ return 1; } # Run position if delta or normal position import is enabled if( $shortName eq 'POSITION' && getConfig( 'IMP_FEED_TABLE', 'POSIT +ION_DELTA' ) ){ return 1; } return getConfig( 'IMP_FEED_TABLE', $shortName ); } push @EXPORT, qw( &isProcEnabled ); # Format a value as specified, logging any major variances between val +ue and specified format # # Parameters # column column name # value value to be formatted # typeRef Array reference containing type, length, precision, +and scale # sub formatValue { my( $column, $row, $value, $typeRef ) = @_; if( !defined( $typeRef ) || !$typeRef ){ if( $value =~ /[+-]?\d*\.?\d*/ ){ $value =~ s/(\.\d*?)0+$/$1/; # rm trailing zeros $value =~ s/^\+//; # rm '+' sign $value =~ s/\.$//; # rm trailing decimal point if now expose +d $value =~ s/^\-0$/0/; # change -0 to 0 (can occur with round +ing)\ } return $value; } if( $$typeRef[0] eq 'VARCHAR' && length( $value ) > $$typeRef[1] ){ exception( "Data exception in $column row $row: String truncatio +n, value '$value'", 'WRN', 'LD' ); $value = substr( $value, 0, $$typeRef[1] ); $exceptions++; } elsif( $$typeRef[0] eq 'NUMERIC' || $$typeRef[0] eq 'LONG' ){ # Check to make sure value is numeric if( $value !~ /^\s*[+-]?\d*\.?\d*(e[+-]?\d+)?\s*$/i ){ exception( "Data exception in $column row $row: Non-numeric d +ata, value '$value'", 'WRN', 'LD' ); $value = ''; $exceptions++; } else { my $length = $$typeRef[2]; if( $$typeRef[3] != 0 ){ $length++; } if( $value < 0 ){ $length++; } # Format to correct scale $value = sprintf( "%." . $$typeRef[3] . "f", $value ); # Check Precision if( length( $value ) > $length ){ exception( "Data exception in $column row $row: Numeric pr +ecision too large for column, value $value", 'WRN', 'LD' ); $value = ''; $exceptions++; } else { $value =~ s/(\.\d*?)0+$/$1/; # rm trailing zeros $value =~ s/\.$//; # rm trailing decimal point if now exp +osed $value =~ s/^\-0$/0/; # change -0 to 0 (can occur with ro +unding) } } } elsif( $$typeRef[0] eq 'DATE' ){ # Enforce format: YYYYMMDD HH:MM:SS if( $value !~ /^(\d{8})( \d\d:\d\d:\d\d)?$/ || $1 < 19000000 ){ exception( "Data exception in $column row $row: Invalid date +format, value '$value'", 'WRN', 'LD' ); $value = ''; $exceptions++; } } elsif( $$typeRef[0] eq 'REAL' ){ if( $value !~ /^\s*[+-]?\d*\.?\d*(e[+-]?\d+)?\s*$/ ){ exception( "Data exception in $column row $row: Non-numeric d +ata, value '$value'", 'WRN', 'LD' ); $value = ''; $exceptions++; } $value =~ s/(\.\d*?)0+$/$1/; # rm trailing zeros $value =~ s/^\+//; # rm '+' sign $value =~ s/^0+(\d+)/$1/; # rm initial zeros $value =~ s/\.$//; # rm trailing decimal point if now exposed $value =~ s/^\-0$/0/; # change -0 to 0 (can occur with rounding +) } return $value; } push @EXPORT, qw( &formatValue ); # Create CRD-default file name # # For Exports: # (customer_cd).(feedcode).(filetype).(sequencenumber) # For Imports: # (feedcode).(filetype).(sequencenumber) # # Parameters: # type import/export table name # sub standardFileName{ my( $table ) = @_; my( $type, $feedCd, $sequenceId, $customerCd, $name ); # # Retrieve loader file names from database -- this should be done o +nce only # if( isTrue( getConfig( 'GLOBAL', 'EXPORT_RUN' ) ) ){ $type = $table; } else { if( !%{ getConfigSection( 'LOADER_FILES' ) } ){ addConfigDefinitionsFromDB( 'CRD', 'cs_dict_tables', "'LOADER +_FILES'", 'table_name', 'loader_file', 'loader_file IS NOT NULL' ); } $type = getConfig( 'LOADER_FILES', $table ); } # # Default to table name minus any prefixes # if( !defined( $type ) || $type !~ /\S/ ){ $type = lc( $table ); $type =~ s/^csm_//; $type =~ s/^cs_//; $type =~ s/^ts_//; $type =~ s/^pma_//; $type =~ s/^imp_//; $type =~ s/^exp_//; $type =~ s/import_//; $type =~ s/(^|_)([a-z])/$1\U$2/g; } $feedCd = getConfig( 'GLOBAL', 'FEEDCODE' ); $sequenceId = getConfig( 'GLOBAL', 'SequenceID' ); $customerCd = getConfig( 'CSM_PARAMETER', 'CUSTOMER_CD' ); $name = ''; if( $customerCd && isTrue( getConfig( 'GLOBAL', 'EXPORT_RUN' ) ) ){ $name = $customerCd."."; } if( $feedCd ){ $name .= $feedCd."."; } $name .= $type; if( $sequenceId ){ $name .= ".".$sequenceId; } return $name } push @EXPORT, qw( &standardFileName ); # Launch remote version of script # # Parameters: # type type of run (COMPLIANCE, ...) # cmd command # argv argument list # sub launchRemote{ my( $type, $cmd, $param_2, @argv ) = @_; my( $os, $rcp, $rsh, $remoteHost, $remoteLogId, $remoteDir, $remote +Perl, $remoteIni, $logFile, $error ); my( $dbWrapper, $dbh, $sql, $beginTime, $result, $param_2_abort, $t +ime, $timeout ); $dbWrapper = ImportLib::DBWrapper -> new(); $dbh = $dbWrapper -> getHandle(); ( undef, undef, $cmd ) = File::Spec -> splitpath( $cmd ); $os = getOS(); $remoteHost = requireParameter( $type, 'Host_Name' ); $remoteLogId = requireParameter( $type, 'Host_User' ); $remoteDir = requireParameter( $type, 'Host_Directory' ); $remoteDir =~ s/\\/\\\\/g; $remotePerl = requireParameter( $type, 'Host_Perl' ); $remotePerl =~ s/\\/\\\\/g; $remoteIni = getConfig( $type, 'Host_Ini_File' ); $remoteIni =~ s/\\/\\\\/g; # determine correct remote shell command if( $os eq "HPUX" ){ $cmd = "remsh $remoteHost -l $remoteLogId -n $remotePerl $remote +Dir/bin/$cmd"; } elsif( $os eq "SOLARIS" ){ $cmd = "remsh $remoteHost -l $remoteLogId -n $remotePerl $remote +Dir/bin/$cmd"; } elsif( $os eq "WINDOWS" ){ $cmd = "rsh.exe $remoteHost -l $remoteLogId -n $remotePerl $remo +teDir\\bin\\$cmd"; } else { exception( "Unknown operating system: $os" ); } $cmd .= " -l @argv"; # # Remove specification of local cm_batch.ini and replace with remot +e version # $cmd =~ s/\s+\-i\s*\S+//g; if( $remoteIni ){ $cmd .= " -i $remoteIni"; } # # Get current server time # if( $dbWrapper -> isOracle() ){ $sql = "SELECT 'to_date(' || to_char(sysdate,'YYYYMMDDHH24MISS') + || ',''YYYYMMDDHH24MISS'')' FROM dual"; $beginTime = $dbh -> selectrow_array( $sql ); } else { $sql = "SELECT convert(varchar, getdate(), 109) FROM dual"; $beginTime = $dbh -> selectrow_array( $sql ); $beginTime = "'$beginTime'"; } debug( "System Command", $cmd, 'cmd' ); open( CMD, "$cmd -l |" ) || exception( "Unable to execute remote run: $!" ); $logFile = makeFilePath( getConfig( 'GLOBAL', 'DIRECTORY_LOG' ), ge +tConfig( 'GLOBAL', 'LOG_FILE' ) ); open( LOG, ">>$logFile" ) || exception( "Unable to open $logFile: $!" ); # # Log both to terminal and log file # $error = 2; while( <CMD> ){ print; print LOG; if( $error == 2 ){ $error = 0; } # Look for any explicit errors if( /Error\s*\:/ ){ $error = 1; } } close CMD || exception( "Error executing remote run: $!" ); if( $error ){ exception( "Error executing remote run" ); } # # If no explicit errors, look for successful message from script # sometimes rsh exits before remote process exits # if( $param_2 ){ $dbh = $dbWrapper -> getHandle(); # Should probably be feeding this in as parameter, but don't wan +t to touch # other scripts for now. $param_2_abort = $param_2; $param_2_abort =~ s/\_Finish//i; $param_2_abort .= '_Abort'; $timeout = getConfig( $type, 'Remote_Timeout', 3600 ); $time = 0; while( 1 ){ # Look for success message in database for time after beginni +ng timestamp $sql = "SELECT count(*) FROM cs_message_log WHERE param_2 = ' +$param_2' AND timestamp > $beginTime"; $result = $dbh -> selectrow_array( $sql ); if( $result >= 1 ){ return 1; } else { $sql = "SELECT count(*) FROM cs_message_log WHERE param_2 += '$param_2_abort' AND timestamp > $beginTime"; $result = $dbh -> selectrow_array( $sql ); if( $result >= 1 ){ exception( "Remote process aborted" ); } } if( ( $time%300 ) == 0 ){ report( "Checking for remote process status" ); } $time += 30; sleep 30; if( $time > $timeout ){ exception( "Timeout reached. Remote process status is in +determidate" ); } } } } push @EXPORT, qw( &launchRemote ); # Print out correct version of usage message # # Parameters: # msg Usage message # type ERR, WRN, or MSG (optional) # sub usage{ my( $msg, $type ) = @_; ( undef, undef, my $script ) = File::Spec -> splitpath( $0 ); if( getOS() eq 'WINDOWS' ){ $script =~ s/\.pl//; } $msg =~ s/\$0/$script/g; my $out; if( $type eq 'MSG' ){ $out = 'S'; } else { $out = 'SL'; } exception( $msg, $type, $out ); exit if( $type eq 'MSG' ); } push @EXPORT, qw( &usage ); # Backup import/export files # # Parameters: # feedCode feed code # sequenceID file sequence number # files array of additional files to backup # sub backupFiles{ my( $feedCode, $sequenceID, @files ) = @_; my( $dbh, $maxDays, $dir, $backupDirectory, $currName, $currPath, $ +baseFileNameRE, $tgtPath, $error ); $maxDays = getConfig( 'GLOBAL', 'MAXBAKDIRAGE', 7 ); $baseFileNameRE = '^(\\w+\\.)?'.$feedCode."\\.\\w+"; if( defined( $sequenceID ) && $sequenceID ne '' ){ $sequenceID = "." . '0' x ( 10 - length( $sequenceID ) ) . $sequ +enceID; $baseFileNameRE .= $sequenceID; } else { $sequenceID = ''; } $baseFileNameRE .= '(.delta)?$'; if( isTrue( getConfig( 'GLOBAL', 'EXPORT_RUN' ) ) ){ report( "Backing up export directories" ); $dir = getConfig( 'GLOBAL', 'DIRECTORY_EXPORT' ); $backupDirectory = makeFilePath( $dir, $feedCode.".EXPORT".$sequ +enceID.".bak" ); } else { report( "Backing up import directories" ); $dir = getConfig( 'GLOBAL', 'DIRECTORY_IMPORT' ); $backupDirectory = makeFilePath( $dir, $feedCode.".IMPORT".$sequ +enceID.".bak" ); } # Create the backup directory if necessary if( !( -d $backupDirectory ) ){ mkdir( $backupDirectory ) || exception( "Error making directory $backupDirectory: $!" ); } # move the appropriate files and purge OLD backup directories opendir( DIR, $dir ) || exception( "Unable to open directory $dir: $!" ); while( defined( $currName = readdir( DIR ) ) ){ # . or .. or .aaa... next if( $currName =~ m/^\./ ); $currPath = makeFilePath( $dir, $currName ); # don't delete directory we are to fill next if( $currPath eq $backupDirectory ); if( -d $currPath ){ # delete if it's an old backup directory if( ( -M $currPath ) > $maxDays && ( $currName =~ m/\.bak$/ ) + && ( -w $currPath ) ){ report( "Removing directory $currPath" ); File::Path::rmtree( $currPath ); } } elsif( -f $currPath && ( $currName =~ m!$baseFileNameRE!i || ( defined( $sequenceID ) && $currName =~ m!status$se +quenceID$!i ) ) ){ if( !-w $currPath ){ $error++; next; } rename( $currPath, makeFilePath( $backupDirectory, $currName +) ) || exception( "Error moving file $currName to backup director +y: $!", 'WRN' ); } } closedir DIR; # Move any additional files specified in function call foreach $currPath ( @files, @::BACKUP_FILES ){ ( undef, undef, $currName ) = File::Spec -> splitpath( $currPath + ); $currPath = getFileCase( $currPath ); if( -e $currPath ){ if( !-w $currPath ){ $error++; next; } $tgtPath = makeFilePath( $backupDirectory, $currName ); if( -e $tgtPath ){ $tgtPath .= '.2'; } rename( $currPath, $tgtPath ) || exception( "Error moving file $currPath to backup direc +tory: $!.", 'WRN' ); } } if( $error ){ exception( 'Failed to backup one or more files', 'WRN' ); } } push @EXPORT, qw( &backupFiles ); # Adds a file to the list of files to be backed up # # Parameters: # files # sub addBackupFile{ push @::BACKUP_FILES, @_; } push @EXPORT, qw( &addBackupFile ); # Get correct case for a file name # # Input # filePath path to file # sub getFileCase{ my( $filePath ) = @_; my( $fileCase ); # Case only matters for UNIX if( getOS() ne 'WINDOWS' ){ my( $fileCase ) = bsd_glob( "$filePath*", GLOB_NOCASE ); if( $fileCase && $filePath =~ /^$fileCase$/i ){ return $fileCase } } # Return original case if file cannot be found return $filePath; } push @EXPORT, qw( &getFileCase ); # Log all system calls for debugging # # Parameters # cmd Command # label Label for debugging files # sub systemLogged{ my( $cmd, $label ) = @_; $label = 'System Command' if( !$label ); if( getConfig( 'GLOBAL', 'DEBUG' ) ){ debug( $label, $cmd, 'cmd' ); } $! = 0; my $ret = system( splitArgs( $cmd ) ); if( $! && $ret != 0 ){ exception( "Unable to execute '$cmd': $!" ); } return $ret; } push @EXPORT, qw( &systemLogged ); 1;

I hope some one can tell me why this is happening, becase I would really want to be able to use the debugger while I extend the functionality.

Replies are listed 'Best First'.
Re: Debugger problem (TFM)
by tye (Sage) on Jun 08, 2010 at 01:22 UTC

    If you want to debug the loading of a module, it is best to just add $DB::single= 1; just before the part of the module that you want to debug.

    That and another alternative is explained at perldebug - Debugging compile time statements.

    - tye        

Re: Debugger problem
by Anonymous Monk on Jun 07, 2010 at 21:45 UTC

    Try reducing the problem to a minimal set of code that still exhibits the issue.

    You've got WAY too much in there. Cut out everything that isn't required to demonstrate the problem.

    For example, you said it seems to be related to loading a module. Try deleting everything except the "use module" and a print "Hello World". If that doesn't have a problem, then try adding functions back one at a time until the problem happens again.

    A best guess, followed by binary search is a very good method to find the problem fast.