#!/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; }