Beefy Boxes and Bandwidth Generously Provided by pair Networks
Come for the quick hacks, stay for the epiphanies.
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??

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


In reply to Re: Searching for duplication in legacy code (updated) by haukex
in thread Searching for duplication in legacy code by yulivee07

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having an uproarious good time at the Monastery: (4)
As of 2024-04-23 17:18 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found