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);
