Guest User

Untitled

a guest
Jul 22nd, 2018
90
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.54 KB | None | 0 0
  1. #!/usr/bin/env perl
  2. #
  3. # Code Duplication Analyzer
  4. # --------------------------
  5. #
  6. # Qui-Quic-Quick-and-Dirty-ly coded and
  7. # I noticed that this approach does not
  8. # return the trustful results.
  9. #
  10. #
  11. use 5.010;
  12. use Storable;
  13. use warnings;
  14. use strict;
  15.  
  16. local $| = 1;
  17.  
  18. my $FILE = shift;
  19. my $cont = do { open my $fh, "<", $FILE or die; local $/; <$fh> };
  20. my @SYNTAX_SEQ = ();
  21. my %SYNTAX_TABLE = ();
  22. my %SYNTAX_MAP = ();
  23. my @STACK = ();
  24.  
  25. @SYNTAX_SEQ = $cont =~ m{([a-z_][a-z0-9_]*)}gi;
  26. $SYNTAX_TABLE{$_}++ for @SYNTAX_SEQ;
  27.  
  28. my $i = 0; for (keys %SYNTAX_TABLE) {
  29. $SYNTAX_TABLE{$_} = $i;
  30. $SYNTAX_MAP{$i} = $_;
  31. $i++;
  32. }
  33.  
  34. @SYNTAX_SEQ = map { $SYNTAX_TABLE{$_} } @SYNTAX_SEQ;
  35.  
  36. #-----
  37.  
  38. use List::Util qw(first);
  39. use Tree::Fast;
  40.  
  41. my $TREE = Tree::Fast->new('root');
  42. my $SEQ = "@SYNTAX_SEQ";
  43.  
  44. sub push_tree {
  45. my ($key_list, $valhash) = @_;
  46. my @key_list = @$key_list;
  47. my $cursor = $TREE;
  48.  
  49. while (my $key = shift @key_list) {
  50. my @children = $cursor->children;
  51. my ($child) = first { my $valhash = $_->value; $valhash->{size} == $key } @children;
  52. unless (defined $child) {
  53. $child = Tree::Fast->new({ seq => '', size => 0 });
  54. $cursor->add_child({}, $child);
  55. }
  56. $cursor = $child;
  57. }
  58. $cursor->set_value($valhash);
  59. }
  60.  
  61. sub recurse_maximum_at {
  62. my ($cur, $size) = @_;
  63. push @STACK, $SYNTAX_SEQ[$cur+$size];
  64.  
  65. my $substr = "@STACK";
  66. my $count = () = ($SEQ =~ m/($substr)/g);
  67.  
  68. push_tree( \@STACK, { seq => $substr, size => $size } );
  69. return recurse_maximum_at( $cur, $size+1 ) if $count > 1 && $cur+$size < $#SYNTAX_SEQ;
  70. return $size;
  71. }
  72.  
  73. sub analyze {
  74. say "analyze a file:";
  75. my $buffer = 0;
  76. for my $i (0 .. $#SYNTAX_SEQ) {
  77. @STACK = ();
  78. print "\rloading... ", $i, " / ", $#SYNTAX_SEQ if $buffer++ % 30 == 0;
  79. recurse_maximum_at( $i, 0 );
  80. }
  81. }
  82.  
  83. sub store_tree {
  84. say "store analyzed information: ";
  85. store $TREE, "$FILE.anal";
  86. }
  87.  
  88. sub retrieve_tree {
  89. say "information retrieved from a file: ";
  90. $TREE = retrieve "$FILE.anal";
  91. }
  92.  
  93. sub dump_tree {
  94. for my $node ($TREE->traverse) {
  95. my $valhash = $node->value;
  96. say "* [", $valhash->{seq}, "]: ", $valhash->{size};
  97. }
  98. }
  99.  
  100. sub dump_string_tree {
  101. for my $node ($TREE->traverse($TREE->LEVEL_ORDER)) {
  102. my $valhash = $node->value;
  103. my @list = map $SYNTAX_MAP{$_}, split " ", $valhash->{seq};
  104. say $valhash->{size}, ": ", "@list" if $valhash->{size} >= 1;
  105. }
  106. }
  107.  
  108. if (-e "$FILE.anal") {
  109. retrieve_tree;
  110. }
  111. else {
  112. analyze;
  113. store_tree;
  114. }
  115.  
  116. #dump_tree;
  117. dump_string_tree;
Add Comment
Please, Sign In to add comment