Hi yulivee07,
I've done a bit of work with PPI and there is a chance it could be useful to you. This was an interesting question to me so I went off and whipped something up (Update: that means please consider this a beta) that finds identical subs, perhaps it's useful to you. PPI could also be used for more powerful identification of duplicated code.
Update: I split the two example files out of the script and turned it into a usable standalone version. Apparently PPI isn't keeping track of the filenames, so instead of figuring out exactly why that is I just added the filename tracking myself; otherwise the code is basically the same as the previously posted version.
File one.pl
#!/usr/bin/env perl
use warnings;
use strict;
sub add { # I am a comment
my $x = shift;
my $y = shift;
my $sum = $x + $y;
return $sum;
}
sub subtr { return shift - shift; }
sub foo { return 'foo'.shift }
File two.pl
#!/usr/bin/perl
use warnings;
use strict;
sub add {
my $x = shift;
my $y = shift;
my $sum = $x + $y;
return $sum;
}
sub subtract {
return shift-shift; # Hello, World
}
sub foo {
my $x = shift;
return "foo$x";
}
And the script:
#!/usr/bin/env perl
use warnings;
use strict;
use PPI;
use Digest::SHA qw/sha1_hex/;
die "Usage: $0 FILENAMES\n" unless @ARGV;
my %subs;
for my $filename (@ARGV) {
my $doc = PPI::Document->new($filename);
$doc->index_locations;
for my $sub (get_subs($doc)) {
my $key = sha1_hex(delete $sub->{code});
$sub->{file} = $filename;
push @{ $subs{$key} }, $sub;
}
}
#use Data::Dump 'pp'; pp \%subs; # Debug
for my $val (values %subs) {
next unless @$val>1;
print "Potential Duplicates:\n";
for my $sub (@$val) {
printf "\tsub %s in file %s, line %d, col %d\n",
$sub->{name}, $sub->{file}//"unknown",
$sub->{loc}[0], $sub->{loc}[1];
}
}
sub get_subs {
my ($ppi_node) = @_;
my @subs;
for my $sub (@{ $ppi_node->find('Statement::Sub') }) {
next if $sub->forward;
my $str = $sub->block->content;
my $doc = PPI::Document->new(\$str);
# remove "insignificant" elements, note this isn't perfect,
# e.g. some significant whitespace may be removed
$doc->prune( sub { ! $_[1]->significant } );
push @subs, {name=>$sub->name, loc=>$sub->location,
code=>$doc->serialize};
}
return @subs;
}
Output:
$ ./subdupes.pl one.pl two.pl
Potential Duplicates:
sub add in file one.pl, line 5, col 1
sub add in file two.pl, line 5, col 1
Potential Duplicates:
sub subtr in file one.pl, line 11, col 1
sub subtract in file two.pl, line 11, col 1
Hope this helps,
-- Hauke D