|
Line 0
Link Here
|
| 0 |
- |
1 |
use Modern::Perl; |
|
|
2 |
use List::MoreUtils qw( uniq ); |
| 3 |
|
| 4 |
my @module_filepaths = ( glob("**/*.pm"), glob("**/**/*.pm") ); |
| 5 |
my $subroutines; |
| 6 |
MODULE: for my $module_filepath ( @module_filepaths ) { |
| 7 |
open my $fh, '<', $module_filepath; |
| 8 |
my $module = $module_filepath; |
| 9 |
$module =~ s|/|::|g; |
| 10 |
$module =~ s|\.pm$||; |
| 11 |
my $found_EXPORT_OK; |
| 12 |
while( my $line = <$fh> ) { |
| 13 |
chomp $line; |
| 14 |
$found_EXPORT_OK = 1 |
| 15 |
if $line =~ m|EXPORT_OK|; |
| 16 |
next unless $line =~ '^sub '; |
| 17 |
my $subroutine = $line; |
| 18 |
$subroutine =~ s|^sub ([\w]+).*|$1|; |
| 19 |
$subroutine =~ s|\s.*||; |
| 20 |
push @{ $subroutines->{$module} }, $subroutine; |
| 21 |
} |
| 22 |
delete $subroutines->{$module} unless $found_EXPORT_OK; |
| 23 |
close $fh; |
| 24 |
} |
| 25 |
|
| 26 |
my $uses; |
| 27 |
for my $module_filepath ( @module_filepaths ) { |
| 28 |
open my $fh, '<', $module_filepath; |
| 29 |
my $module = $module_filepath; |
| 30 |
$module =~ s|/|::|g; |
| 31 |
$module =~ s|\.pm$||; |
| 32 |
while( my $line = <$fh> ) { |
| 33 |
chomp $line; |
| 34 |
next if $line !~ m|^use Koha::| and $line !~ m|^use C4::|; |
| 35 |
my $module_used = $line; |
| 36 |
$module_used =~ s|^use ([\w:]+)\s.*|$1|; |
| 37 |
$module_used =~ s|^use ([\w:]+);.*|$1|; |
| 38 |
push @{ $uses->{$module} }, $module_used if exists $subroutines->{$module_used}; |
| 39 |
} |
| 40 |
close $fh; |
| 41 |
} |
| 42 |
|
| 43 |
my $calls; |
| 44 |
#@module_filepaths = ( 'C4/Biblio.pm' ); |
| 45 |
for my $module_filepath ( @module_filepaths ) { |
| 46 |
open my $fh, '<', $module_filepath; |
| 47 |
my $module = $module_filepath; |
| 48 |
$module =~ s|/|::|g; |
| 49 |
$module =~ s|\.pm$||; |
| 50 |
next unless exists $uses->{$module}; |
| 51 |
|
| 52 |
while( my $line = <$fh> ) { |
| 53 |
chomp $line; |
| 54 |
next unless $line; |
| 55 |
next if $line =~ '^use '; |
| 56 |
next if $line =~ '^\s*#'; |
| 57 |
for my $module_used ( @{ $uses->{$module} } ) { |
| 58 |
for my $subroutine ( @{ $subroutines->{$module_used} } ) { |
| 59 |
if ( $line =~ m|$subroutine| ) { |
| 60 |
push @{ $calls->{$module}{$module_used} }, $subroutine; |
| 61 |
@{ $calls->{$module}{$module_used} } = uniq @{ $calls->{$module}{$module_used} }; |
| 62 |
} |
| 63 |
} |
| 64 |
} |
| 65 |
} |
| 66 |
close $fh; |
| 67 |
} |
| 68 |
|
| 69 |
for my $module ( keys %$calls ) { |
| 70 |
say $module; |
| 71 |
my $module_filepath = $module; |
| 72 |
$module_filepath =~ s|::|/|g; |
| 73 |
$module_filepath .= '.pm'; |
| 74 |
my $fh; |
| 75 |
open $fh, '<', $module_filepath or die "something went wrong $!"; |
| 76 |
my @lines; |
| 77 |
while ( my $line = <$fh> ) { |
| 78 |
chomp $line; |
| 79 |
unless ( $line =~ m|^use\s+| ) { |
| 80 |
push @lines, $line; |
| 81 |
next; |
| 82 |
} |
| 83 |
for my $module_used ( keys %{ $calls->{$module} } ) { |
| 84 |
next if $module_used eq $module; |
| 85 |
if ( $line =~ m|^use\s+$module_used| ) { |
| 86 |
$line = "use $module_used qw( " . join( ' ', @{ $calls->{$module}{$module_used} } ) . " );"; |
| 87 |
} |
| 88 |
} |
| 89 |
push @lines, $line; |
| 90 |
} |
| 91 |
close $fh; |
| 92 |
|
| 93 |
open $fh, '>', $module_filepath; |
| 94 |
print $fh join("\n", @lines ) . "\n"; |
| 95 |
close $fh; |
| 96 |
} |