A half cooked code for Siebel Memory leak (Parent child Nullfication issue)

This is an extension to the code Mr. Timur wrote for nullification. The current code is still under development and users may get errors/issues with the code.


http://siebelunleashed.com/wp-content/uploads/2011/09/SiebelOVAPerlScript.txt


The code coverage for the wide range of pattern is not addressed. I am novice to PERL and has limitation to explore more on regular expression etc.


The main intention of the script is to identify the sequence of the Nullification. Child objects are supposed to get nullified before parent objects.

The code is still to modified to get the full feature. However the output generated will give an indication on the possible objects were the Parent nullification is done prior to the child.

This is a non-commercial piece of code, developed to enhance the original feature covered
http://siebelunleashed.com/memory-leaks-siebel/

As mentioned, it is to thoroughly tested, take backup of original files if you required to run this

# parselst.pl – Script to analyze flat files with data. I’ve used “@objtypes” array to hold information about variables. I’ve analyzed nearly 5MB of flat file less that 1 minute. If you need to analyze nearly 100-MB of flat files, for performance consideration you can implement “if … elseif … elseif“ conditional statement, it will work more faster.

Get the code from dropbox for avoiding any HTML tag issues.

https://www.dropbox.com/s/tznvjo65w086wka/scr2.pl?dl=0



######################################################################################
##
## Script description: script parses all *.lst* files in particular directory
## and print problem statement survey in out.csv file
##
## Original concept and Author: Timur Vafin, timur.vafin@gmail.com
##
## Date: 06.08.2011
## Modified for the Nullification Order check for BC and BO
## Krishna Kumar kks.krishna@gmail.com
## Date: 08.02.2017
######################################################################################
# initial directory for input lst files

use List::MoreUtils q(any);
my $dir = ".\\tmp";
######################################################################################
opendir (LSTDIR, "$dir") or die "Cannot open directory \"$dir\": ($!).\n";
my @files = grep(/\.lst/,readdir(LSTDIR));
closedir (LSTDIR);


my %objsvar;
my %objsvarc;


# to get the line number for each coding sessions
 $lineNum;

my $id;
my $cflg = 0;
my $const =1;
my @objtypes = ( 'this.BusComp',
'ActiveBusComp',
'GetBusComp',
'this.BusObject',
'ActiveBusObject',
'GetBusObject',
);

foreach my $file (@files) {
open (FILE,"<", "$dir\\$file") or die "Cannot open file \"$dir\\$file\": ($!).\n";
while (my $line = ) {

$line =~ s/\n//;
#print("Line details test:$line\n");
if ($line =~ m/^Siebel Repository/ ) {
#initialise the linenumber to the respective file
$lineNum=0;

$id = join (';',split (/[ \t]+;/,$line));
#print ("ID values\t: $id ");
# Comment flag
} elsif ($line =~ m/=.*\/\*/) {
print "SKIPPED LINE:\n";
$lineNum++;
#print "\t$line\n";
} elsif ($line =~ m/\/\*/ && $line !~ m/\*\//) {
$cflg = 1;
$lineNum++;
} elsif ($line =~ m/\*\// ) {
$cflg = 0;
$lineNum++;
} else {
$lineNum++;

#print("\n$id  \t; $lineNum");
# Search for variables
foreach my $objtype (@objtypes) {
if ($line =~ m/=.*($objtype)/ && !$cflg) {
$line =~ s/^[ \t]*//;
$line =~ s/var[ \t]*//;
$line =~ s/[ \t]*=.*//;
$line =~ s/:.*//;
$line =~ s/\(//g;
$line =~ s/\)//g;
if ($line !~ m/\[|if|return|while|^\&\&|^\|\|/ && $line !~ m/^\/\/|\/\*/) {
if ($line =~ m/=/) {
$line =~ s/[ \t]*//g;
foreach my $litem (split('=',$line)) {
#print("$litem\n");
# push(@{$objsvar{$id}},$litem . "\;$objtype");
# push(@{$parentobj{$id}},$litem . "\;$objtype;$lineNum");
# push(@{$childobj{$id}},$litem . "\;$objtype;$lineNum");
};
} else {
#print ("Line content 1 :$line\t$id\n");
push(@{$objsvar{$id}},$line . "\;$objtype;$lineNum");



};
};
};

# Search for variables that become null
#This code is to check the details on the variable checks, other assignments.
if ($line =~ m/=[ \t]*null/ && !$cflg) {
$line =~ s/^[ \t]*//;
$line =~ s/[ \t]*=[ \t]*null.*//;
if ($line !~ m/\[|^var[ \t]*|if|return|while|^\&\&|^\|\|/ && $line !~ m/^\/\/|\/\*/) {
if ($line =~ m/=/) {
$line =~ s/[ \t]*//g;
foreach my $litem (split('=',$line)) {
# $lineNum++;
#print ("Line content 1 :$litem\n");

#push(@{$objsvarc{$id}},$litem . "\;null");
#push(@{$parentobj{$id}},$litem . "\;$.");

#push(@{$childobj{$id}},$litem . "\;$objtype;$.");

};
} else {

# this  part of line contain BC Buscomp variables from all the variables values (declaration, assignments, nullification across the applications
#print ("\n". $line);
push(@{$objsvarc{$id}},$line . "\;null;". "$lineNum");
# push(@{$parentobj{$id}},$line . "\;$objtype;$.");
};
};
};

};#Modified the for loop to get the objtype value to the push function for the parentobj
};
};
close (FILE);
};
# Print problem Stements
open (CSV,">","$dir\\..\\out.csv") or die "Cannot create file \"$dir\\out.csv\": ($!).\n";
print CSV "Siebel Repository Name;Object Type;Object Name;Function;Last Change Date;Open Variable;Assignment Method\n";
foreach my $id (sort keys %objsvar) {
foreach my $val (@{$objsvar{$id}}) {
my $tmp = (split(';',$val))[0] . "\;null";
my $check = grep (/$tmp/,@{$objsvarc{$id}});

if ( $check == 0 ) {
print CSV "$id;$val\n";
};
};
};
close (CSV);

# Print problem Stements
open (CSV,">","$dir\\..\\out_null_order.csv") or die "Cannot create file \"$dir\\out8.csv\": ($!).\n";
open (CSVPC,">","$dir\\..\\out3.csv") or die "Cannot create file \"$dir\\out4.csv\": ($!).\n";
print CSV "Siebel Repository Name;Object Type;Object Name;Function;Last Change Date;Nullified Variable;Linenum\n";
print CSVPC"Siebel Repository Name;Object Type;Object Name;Function;Last Change Date;Open Variable;Assignment Method;Linenum\n";

# my $iNum=0;
foreach my $id ( sort keys %objsvar) {
# $iNum++;
foreach my $val (@{$objsvar{$id}}) {
# $iNum++;
my $tmp = (split(';',$val))[0] . "\;null";
#print ("Temp  \t $tmp\n");
my $check = grep (/$tmp/,@{$objsvarc{$id}});
# my @lin = $objsvarc{$id};




# print join(",", @stooge_last_names{});


# print join(", ", @lin);
# print ("\n@lin\n");
# print ("Check   \t $check\t Temp   \t$tmp \t$id \n");
#print ("\n Testing  \t". @{$objsvarc{$id}}  ."\t". $iNum);
# my $nullLinnum =
#print ("@{$objsvarc{$id}}");
if ( $check != 0 ) {

#print CSV "$id;$val\n";


};
};
};
############################
#foreach my $ids (sort keys %parentobj) {
# foreach my $val (@{$parentobj{$ids}}) {
# my $tmp = (split(';',$val))[0] . "\;null";
# my $lnnum = (split(';',$val))[2];
# #print ("Temp  \t $tmp\n");
# my $check = grep (/$tmp/,@{$objsvarc{$ids}});
# #print ("Check   \t $check\n");
# if ( $check != 0 ) {
# print CSVPC "$ids,$val,$lnnum\n"; };
#};
#};



  foreach my $id ( sort keys %objsvarc) {
# $iNum++;
foreach my $val (@{$objsvarc{$id}}) {
# $iNum++;
my $tmp1 = (split(';',$val))[2];
my $tmp2 = (split(';',$val))[0];

print CSV "$id;$tmp2;$tmp1\n";
};
};

  

close (CSV);
close(CSVPC);