Home Original page

Can anyone decode this Perl code, please?

Jane Austine janeaustine50 at hotmail.com
Tue Jan 21 22:07:33 EST 2003 
I am reading Object-Oriented Reengineering Patterns. I really enjoy
this book. On p.177, however, there is a perl code, which is all Greek
to me. Can anyone here translate it into a pseudo-code or a python
code(literal translation might do)?

Thank you so much.

#! /usr/bin/env perl -w
#duplocForCPP.pl - detect duplicated lines of code (algorithm only)
# Synopsis: duplocForCPP.pl filename ...
# Takes code (or other) files and collects all line numbers of lines
# equal to each other within these files. The algorithm is linear(in
# space and time) to the number of lines in input.

$equivalenceClassMinimalSize =1;
$slidingWindowSize=5;
$removeKeywords=0;
@keywords=qw(if
	then
	else
	for
	{
	}
);

$keywordsRegExp=hoin '|', at keywords;

@unwantedlines=qw( else
	return
	return;
	return result;
	}else{
		#else
		#endif
		{
		}
		;
	};
);
push @unwantedLines, @keyswords;

@unwantedlines{@unwantedlines}=(1) x @unwantedLines;

$totalLines=0;
$emptyLines=0;
$codeLines=0;
@currentLines=();
@currentLineNos=();
%eqLines=();
$inComment=0;

$start=(times)[0];

while(<>) {
	chomp;
	$totalLines++;

	# remove comments of type /* */ 
	my $codeOnly='';
	while (($inComment && m|\*/|) || (!$inComment && m|/\*|)) {
		unless($inComment) { $codeOnly .=$` }
		$inComment=!$inComment;
		$_=$';
	}
	$codeOnly .= $_ unless $inComment;
	$_=$codeOnly;
	
	s|//.*$||;
	s/\s+//g;
	s/$keywordsRegExp//og if $removeKeywords;

	#remove empty and unwanted lines
	if (((!$_ && $emptyLines++)
		|| (defined $unwantedLInes{$_} && $codeLines++)) { next }

	$codeLines++;
	push @currentLines, $_;
	push @currentLineNos, $.;
	if ($slidingWIndowSize < @currentLines) {
		shift @currentLines;
		shift @currentLineNos;
	}

	# print STDERR "Line $totalLInes >$_<\n";

	my $lineToBeCompared = join '', @currentLines;
	my $lineNumbersCompared="<$ARGV>"; 
	$lineNumbersCompared .=join '/', @currentLineNos;
	# print STDERR "$lineNumbersCompared\n";
	if ($bucketRef = $eqLines{$lineToBeCompared}) {
		push @$bucketRef, $lineNumbersCompared;
	} else {
		$eqLines{$lineToBeCompared}= [ $lineNumbersCompared ];
	}

	if (eof) { close ARGV } #Reset linenumber-count for next file
}

$end=(times)[0];
$processingTime=$end-$start;

#print the equivalence classes

$numOfMarkedEquivClasses=0;
$numOfMakredElements=0;
foreach $line (sort { length $a <=> length $b } keys %eqLines) {
	if (scalar @{$eqLines{$line}} > $equivalenceClassMinimalSize) {
		$numOfMarkedEquivClaases++;
		$numOfMarkedElements += scalar @{$eqLines{$line}};
		print "Lines: $line\n";
		print "Locations: @{$eqLines{$line}}\n\n";
	}
}

print "\n\n\n";
...(a few more lines of print)
More information about the Python-list mailing list