Bugzilla – Attachment 10272 Details for
Bug 8244
Script to find exporter problems
Home
|
New
|
Browse
|
Search
|
[?]
|
Reports
|
Help
|
New Account
|
Log In
[x]
|
Forgot Password
Login:
[x]
[patch]
Bug 8244: New script xt/find-undefined-subroutines.pl
0001-Bug-8244-New-script-xt-find-undefined-subroutines.pl.patch (text/plain), 13.83 KB, created by
Julian Maurice
on 2012-06-14 10:18:57 UTC
(
hide
)
Description:
Bug 8244: New script xt/find-undefined-subroutines.pl
Filename:
MIME Type:
Creator:
Julian Maurice
Created:
2012-06-14 10:18:57 UTC
Size:
13.83 KB
patch
obsolete
>From c6543adf898b0262d9a39d6a99a805551be495a8 Mon Sep 17 00:00:00 2001 >From: Julian Maurice <julian.maurice@biblibre.com> >Date: Thu, 14 Jun 2012 11:53:47 +0200 >Subject: [PATCH] Bug 8244: New script xt/find-undefined-subroutines.pl > >This script tends to detect if Koha scripts use subroutines that are not >correctly exported by modules. This can happen when we have circular >dependencies between modules. >This script does mainly two things: > - It rebuilds the hierarchy of Koha Perl modules and replace all the code > within subroutines by tests (using Test::More). For each subroutine called > in a subroutine, a test is done on if the called subroutine is defined. > If it's defined, then it's called (Tested subroutines are only those > available in Koha Perl modules, not external modules subroutines). > It does almost the same work with Koha Perl scripts, replacing all the > code by tests and calling the subroutines if defined. > - Launch prove on all created Perl scripts. >This results in a summary where failed tests are subroutines that are not >exported, but called without the module name prepended. >--- > xt/find-undefined-subroutines.pl | 369 ++++++++++++++++++++++++++++++++++++++ > 1 file changed, 369 insertions(+) > create mode 100755 xt/find-undefined-subroutines.pl > >diff --git a/xt/find-undefined-subroutines.pl b/xt/find-undefined-subroutines.pl >new file mode 100755 >index 0000000..498b288 >--- /dev/null >+++ b/xt/find-undefined-subroutines.pl >@@ -0,0 +1,369 @@ >+#!/usr/bin/perl >+ >+# Copyright 2012 BibLibre >+# >+# This file is part of Koha. >+# >+# Koha is free software; you can redistribute it and/or modify it under the >+# terms of the GNU General Public License as published by the Free Software >+# Foundation; either version 2 of the License, or (at your option) any later >+# version. >+# >+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY >+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR >+# A PARTICULAR PURPOSE. See the GNU General Public License for more details. >+# >+# You should have received a copy of the GNU General Public License along >+# with Koha; if not, write to the Free Software Foundation, Inc., >+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. >+ >+# This script tends to detect if Koha scripts use subroutines that are not >+# correctly exported by modules. This can happen when we have circular >+# dependencies between modules. >+# This script does mainly two things: >+# - It rebuilds the hierarchy of Koha Perl modules and replace all the code >+# within subroutines by tests (using Test::More). For each subroutine called >+# in a subroutine, a test is done on if the called subroutine is defined. >+# If it's defined, then it's called (Tested subroutines are only those >+# available in Koha Perl modules, not external modules subroutines). >+# It does almost the same work with Koha Perl scripts, replacing all the >+# code by tests and calling the subroutines if defined. >+# - Launch prove on all created Perl scripts. >+# This results in a summary where failed tests are subroutines that are not >+# exported, but called without the module name prepended. >+# >+# This script is NOT perfect (and it can't be, because of Perl complexity) and >+# it can return 'false positives'. But it can permit to detect some problems >+# earlier when, for example, a patch introduces a circular dependency by adding >+# a 'use' in a module. >+ >+use Modern::Perl; >+use PPI; >+ >+use Data::Dumper; >+ >+use File::Basename; >+use File::Path; >+use File::Find; >+use List::MoreUtils qw/uniq/; >+use Getopt::Long; >+use Cwd qw/abs_path/; >+ >+sub usage { >+ return <<USAGE; >+Usage: >+ perl $0 --src-path /path/to/src --dest-path /path/to/dir_to_create >+ >+ --src-path|-s PATH Path where Koha lives (source tree root) >+ --dest-path|-d PATH Where you want to build the hierarchy of tests >+ scripts and modules >+ --verbose|-v Print some progress informations >+ >+ This script tends to detect if Koha scripts use subroutines that are not >+ correctly exported by modules. This can happen when we have circular >+ dependencies between modules. >+ For more information, open the file with a text editor and read the 2nd >+ paragraph of comments. >+USAGE >+} >+ >+my $src_path; >+my $dest_path; >+my $verbose = 0; >+ >+my $options_ok = GetOptions( >+ 'src-path=s' => \$src_path, >+ 'dest-path=s' => \$dest_path, >+ 'verbose' => \$verbose >+); >+ >+if (!$options_ok or !$src_path or !$dest_path) { >+ die usage(); >+} >+ >+# Avoid overwriting the sources >+if (abs_path($src_path) eq abs_path($dest_path)) { >+ die "You cannot choose the same path for --src-path and --dest-path"; >+} >+ >+# Remove trailing slash >+$src_path =~ s|/$||; >+$dest_path =~ s|/$||; >+ >+# Global hash that will contain list of per-modules subroutines >+my $routines; >+ >+# We don't want to test these subroutines >+my @routines_blacklist = qw(new next fetch import delete param); >+# These subroutines causes many fails if CAS or LDAP are disabled because they >+# are not imported in this case >+push @routines_blacklist, qw( >+ check_api_auth_cas >+ checkpw_cas >+ login_cas >+ logout_cas >+ login_cas_url >+ checkpw_ldap >+); >+ >+# Build list of modules >+my @modules; >+find( sub { >+ return $File::Find::prune = 1 if ($_ =~ /^$dest_path$/); >+ return $File::Find::prune = 1 if ($_ =~ /^t$/); >+ return $File::Find::prune = 1 if ($_ =~ /^blib$/); >+ return unless $_ =~ m/\.pm$/; >+ my $file = $File::Find::name; >+ $file =~ s#\.\/##; >+ push @modules, $file; >+}, $src_path ); >+@modules = sort @modules; >+ >+# Search subroutines declared in each module >+for my $module ( @modules ) { >+ say "Loading $module..." if $verbose; >+ my $document = PPI::Document->new($module) or die( "Unable to open file $module" ); >+ my $sub_nodes = $document->find( >+ sub { >+ $_[1]->isa('PPI::Statement::Sub') and $_[1]->name >+ and not $_[1]->isa('PPI::Statement::Scheduled') >+ } >+ ); >+ next unless $sub_nodes; >+ my @sub_names = map { $_ ? $_->name : () } @$sub_nodes; >+ $routines->{$module} = \@sub_names; >+} >+ >+ >+# Transform each module so that each subroutines will only contain tests >+# (no 'real' code inside) and save them in $dest_path >+for my $module ( @modules ) { >+ my $document = PPI::Document->new($module) or die( "Unable to open file $module" ); >+ my $includes = $document->find('PPI::Statement::Include') || []; >+ my @include_module_names; >+ for my $include ( @$includes ) { >+ next unless $include; >+ my $words = $include->find('PPI::Token::Word') || []; >+ for my $w ( @$words ) { >+ push @include_module_names, $w >+ if $w->content =~ /^C4|^Koha/; >+ } >+ } >+ if ( scalar ( @$includes ) ) { >+ my $first_include = @$includes[0]; >+ $first_include->add_element( PPI::Document->new( \";use Test::More;" ) ); >+ } >+ >+ my @list_of_subroutines; >+ while ( my ( $mod, $sub ) = each %$routines ) { >+ push @list_of_subroutines, @$sub >+ if scalar( >+ grep { >+ $mod =~ s/\//::/; >+ $mod =~ s/.pm//; >+ $mod eq $_ >+ } @include_module_names >+ ); >+ } >+ >+ my $sub_nodes = $document->find( >+ sub { >+ $_[1]->isa('PPI::Statement::Sub') and $_[1]->name >+ and not $_[1]->isa('PPI::Statement::Scheduled') >+ } >+ ); >+ $sub_nodes = [] unless $sub_nodes; >+ >+ my $directory = dirname( "$dest_path/$module" ); >+ mkpath $directory; >+ >+ for my $node ( @$sub_nodes ) { >+ next unless $node; >+ my $sub_node = $node->block; >+ >+ my $word_nodes = $sub_node->find( sub { >+ ($_[1]->isa('PPI::Token::Word') and not $_[1]->method_call) >+ or $_[1]->isa('PPI::Statement::Include') >+ } ); >+ next unless $word_nodes; >+ my $content; >+ for my $wn ( @$word_nodes ) { >+ if ($wn->isa('PPI::Statement::Include')) { >+ $content .= "\n" . $wn->content . "\n"; >+ } else { >+ next if ( scalar( grep {$wn->content eq $_} @routines_blacklist ) );; >+ my $ps = $wn->sprevious_sibling; >+ my $ns = $wn->snext_sibling; >+ next if ref $ns eq 'PPI::Token::Operator' >+ and $ns->content eq '->'; >+ next if ref $ps eq 'PPI::Token::Operator' >+ and $ps->content eq '->'; >+ unless ( scalar( grep {$wn->content eq $_} @list_of_subroutines ) ) { >+ next; >+ } >+ next if ref $ns eq 'PPI::Token::Operator' >+ and $ns->content eq '=>'; >+ if (ref $wn->parent eq 'PPI::Statement::Expression' >+ and ref $wn->parent->parent eq 'PPI::Structure::Subscript') { >+ next; >+ } >+ next if $wn->content eq $node->name; # Avoid Deep recursion >+ >+ my $call = $wn->content; >+ $content .= qq{ >+ ok(defined &$call, "In $module: &$call"); >+ if (defined &$call) {&$call;} >+ } >+ } >+ } >+ >+ for my $child ( $sub_node->children ) { >+ $child->remove; >+ } >+ my $new_code = PPI::Token->new(); >+ $new_code->set_content($content); >+ $sub_node->add_element($new_code); >+ >+ } >+ >+ # Save the file >+ say "Saving module $dest_path/$module" if $verbose; >+ $document->save("$dest_path/$module"); >+} >+ >+# Build list of scripts >+my @scripts; >+find( sub { >+ return $File::Find::prune = 1 if ($_ =~ /^t$/); >+ return $File::Find::prune = 1 if ($_ =~ /^$dest_path$/); >+ return unless $_ =~ m/\.pl$/; >+ my $file = $File::Find::name; >+ $file =~ s#\.\/##; >+ push @scripts, $file; >+}, $src_path ); >+@scripts = sort @scripts; >+ >+# Transform each script so that they will only contain tests >+# (no 'real' code inside) and save them in $dest_path >+my @scripts_to_run = (); >+for my $script ( @scripts ) { >+ my $document = PPI::Document->new($script); >+ unless ($document) { >+ # Failed to parse >+ my $src = qq{ >+ use Test::More; >+ ok(0, "Failed to parse script $script"); >+ }; >+ my $new_document = PPI::Document->new(\$src); >+ say "Saving script $dest_path/$script" if $verbose; >+ $new_document->save("$dest_path/$script"); >+ push @scripts_to_run, $script; >+ next; >+ } >+ >+ my $run_this_script = 1; >+ $run_this_script = 0 if $script =~ (m|^misc/kohalib.pl$|); >+ >+ my $sub_nodes = $document->find( >+ sub { >+ $_[1]->isa('PPI::Statement::Sub') and $_[1]->name >+ } >+ ); >+ $sub_nodes = [] unless $sub_nodes; >+ >+ my $directory = dirname( "$dest_path/$script" ); >+ mkpath $directory; >+ >+ my $includes = $document->find( 'PPI::Statement::Include' ) || []; >+ foreach my $include (@$includes) { >+ $include->add_element(PPI::Document->new(\";")); >+ } >+ my $new_document = PPI::Document->new($includes); >+ $new_document->add_element( PPI::Document->new( \"use Test::More;" ) ); >+ >+ my @include_module_names; >+ for my $include ( @$includes ) { >+ next unless $include; >+ my $words = $include->find('PPI::Token::Word'); >+ for my $w ( @$words ) { >+ if ($w->content =~ /^Test::More$/) { >+ $run_this_script = 0; >+ } >+ push @include_module_names, $w >+ if $w->content =~ /^C4|^Koha/; >+ } >+ } >+ >+ my @list_of_subroutines; >+ while ( my ( $mod, $sub ) = each %$routines ) { >+ push @list_of_subroutines, @$sub >+ if scalar( >+ grep { >+ $mod =~ s/\//::/; >+ $mod =~ s/.pm//; >+ $mod eq $_ >+ } @include_module_names >+ ); >+ } >+ >+ my $words = $document->find( sub { >+ $_[1]->isa('PPI::Token::Word') >+ and (not $_[1]->method_call) >+ } ) || []; >+ my @subroutines; >+ for my $wn ( @$words ) { >+ next if not $wn; >+ next if ( scalar( grep {$wn->content eq $_} @routines_blacklist ) ); >+ my $ns = $wn->snext_sibling; >+ my $ps = $wn->sprevious_sibling; >+ next if ref $ns eq 'PPI::Token::Operator' >+ and $ns->content eq '->'; >+ next if ref $ps eq 'PPI::Token::Operator' >+ and $ps eq '->'; >+ unless ( scalar( grep {$wn->content eq $_} @list_of_subroutines ) ) { >+ next; >+ } >+ next if ref $ns eq 'PPI::Token::Operator' >+ and $ns->content eq '=>'; >+ if (ref $wn->parent eq 'PPI::Statement::Expression' >+ and ref $wn->parent->parent eq 'PPI::Structure::Subscript') { >+ next; >+ } >+ push @subroutines, $wn->content; >+ } >+ @subroutines = uniq @subroutines; >+ >+ my @elements; >+ for ( @subroutines ) { >+ my $src = qq { >+ ok (defined &$_, "In $script: &$_"); >+ if (defined &$_){&$_} >+ }; >+ push @elements, PPI::Document->new( \$src ); >+ } >+ # For scripts that have no tests >+ push @elements, PPI::Document->new( \"ok(1);" ); >+ push @elements, PPI::Document->new( \"done_testing;" ); >+ $new_document->add_element( $_ ) for @elements; >+ >+ # Save the file >+ say "Saving script $dest_path/$script" if $verbose; >+ $new_document->save("$dest_path/$script"); >+ push @scripts_to_run, $script if ($run_this_script); >+} >+ >+ >+system("cp C4/Context.pm $dest_path/C4/Context.pm"); >+system("echo '1;' > $dest_path/misc/kohalib.pl"); >+ >+my @includedirs = ( >+ $dest_path, >+ "$dest_path/installer", >+ "$dest_path/C4/SIP", >+ "$dest_path/misc/translator" >+); >+my $includes_param = join(' ', map { "-I$_" } @includedirs); >+my $scripts_param = join(' ', map { "$dest_path/$_" } @scripts_to_run); >+ >+system("prove --trap $includes_param $scripts_param"); >+ >-- >1.7.10 >
You cannot view the attachment while viewing its details because your browser does not support IFRAMEs.
View the attachment on a separate page
.
View Attachment As Diff
View Attachment As Raw
Actions:
View
|
Diff
|
Splinter Review
Attachments on
bug 8244
:
10272
|
10374
|
10542
|
10543
|
10943
|
11346
|
12239
|
13223
|
14415
|
26827