|
Lines 1-7
Link Here
|
| 1 |
use Modern::Perl; |
1 |
use Modern::Perl; |
| 2 |
use List::MoreUtils qw( uniq ); |
2 |
use List::MoreUtils qw( uniq ); |
| 3 |
|
3 |
|
| 4 |
my @module_filepaths = ( glob("**/*.pm"), glob("**/**/*.pm") ); |
4 |
my @module_filepaths = ( glob("**/*.pm"), glob("**/**/*.pm"), glob("**/**/*.pm") ); |
|
|
5 |
my @script_filepaths = ( glob("*.pl"), glob("**/*.pl"), glob("**/**/*.pl") ); |
| 5 |
my $subroutines; |
6 |
my $subroutines; |
| 6 |
MODULE: for my $module_filepath ( @module_filepaths ) { |
7 |
MODULE: for my $module_filepath ( @module_filepaths ) { |
| 7 |
open my $fh, '<', $module_filepath; |
8 |
open my $fh, '<', $module_filepath; |
|
Lines 39-47
for my $module_filepath ( @module_filepaths ) {
Link Here
|
| 39 |
} |
40 |
} |
| 40 |
close $fh; |
41 |
close $fh; |
| 41 |
} |
42 |
} |
|
|
43 |
for my $script_filepath ( @script_filepaths ) { |
| 44 |
open my $fh, '<', $script_filepath; |
| 45 |
while( my $line = <$fh> ) { |
| 46 |
chomp $line; |
| 47 |
next if $line !~ m|^use Koha::| and $line !~ m|^use C4::|; |
| 48 |
my $module_used = $line; |
| 49 |
$module_used =~ s|^use ([\w:]+)\s.*|$1|; |
| 50 |
$module_used =~ s|^use ([\w:]+);.*|$1|; |
| 51 |
push @{ $uses->{$script_filepath} }, $module_used if exists $subroutines->{$module_used}; |
| 52 |
} |
| 53 |
close $fh; |
| 54 |
} |
| 42 |
|
55 |
|
| 43 |
my $calls; |
56 |
my $module_calls; |
| 44 |
#@module_filepaths = ( 'C4/Biblio.pm' ); |
|
|
| 45 |
for my $module_filepath ( @module_filepaths ) { |
57 |
for my $module_filepath ( @module_filepaths ) { |
| 46 |
open my $fh, '<', $module_filepath; |
58 |
open my $fh, '<', $module_filepath; |
| 47 |
my $module = $module_filepath; |
59 |
my $module = $module_filepath; |
|
Lines 57-72
for my $module_filepath ( @module_filepaths ) {
Link Here
|
| 57 |
for my $module_used ( @{ $uses->{$module} } ) { |
69 |
for my $module_used ( @{ $uses->{$module} } ) { |
| 58 |
for my $subroutine ( @{ $subroutines->{$module_used} } ) { |
70 |
for my $subroutine ( @{ $subroutines->{$module_used} } ) { |
| 59 |
if ( $line =~ m|$subroutine| ) { |
71 |
if ( $line =~ m|$subroutine| ) { |
| 60 |
push @{ $calls->{$module}{$module_used} }, $subroutine; |
72 |
push @{ $module_calls->{$module}{$module_used} }, $subroutine; |
| 61 |
@{ $calls->{$module}{$module_used} } = uniq @{ $calls->{$module}{$module_used} }; |
73 |
@{ $module_calls->{$module}{$module_used} } = uniq @{ $module_calls->{$module}{$module_used} }; |
| 62 |
} |
74 |
} |
| 63 |
} |
75 |
} |
| 64 |
} |
76 |
} |
| 65 |
} |
77 |
} |
| 66 |
close $fh; |
78 |
close $fh; |
| 67 |
} |
79 |
} |
|
|
80 |
my $script_calls; |
| 81 |
for my $script_filepath ( @script_filepaths ) { |
| 82 |
open my $fh, '<', $script_filepath; |
| 83 |
next unless exists $uses->{$script_filepath}; |
| 68 |
|
84 |
|
| 69 |
for my $module ( keys %$calls ) { |
85 |
while( my $line = <$fh> ) { |
|
|
86 |
chomp $line; |
| 87 |
next unless $line; |
| 88 |
next if $line =~ '^use '; |
| 89 |
next if $line =~ '^\s*#'; |
| 90 |
for my $module_used ( @{ $uses->{$script_filepath} } ) { |
| 91 |
for my $subroutine ( @{ $subroutines->{$module_used} } ) { |
| 92 |
if ( $line =~ m|$subroutine| ) { |
| 93 |
push @{ $script_calls->{$script_filepath}{$module_used} }, $subroutine; |
| 94 |
@{ $script_calls->{$script_filepath}{$module_used} } = uniq @{ $script_calls->{$script_filepath}{$module_used} }; |
| 95 |
} |
| 96 |
} |
| 97 |
} |
| 98 |
} |
| 99 |
close $fh; |
| 100 |
} |
| 101 |
|
| 102 |
for my $module ( keys %$module_calls ) { |
| 70 |
say $module; |
103 |
say $module; |
| 71 |
my $module_filepath = $module; |
104 |
my $module_filepath = $module; |
| 72 |
$module_filepath =~ s|::|/|g; |
105 |
$module_filepath =~ s|::|/|g; |
|
Lines 80-89
for my $module ( keys %$calls ) {
Link Here
|
| 80 |
push @lines, $line; |
113 |
push @lines, $line; |
| 81 |
next; |
114 |
next; |
| 82 |
} |
115 |
} |
| 83 |
for my $module_used ( keys %{ $calls->{$module} } ) { |
116 |
for my $module_used ( keys %{ $module_calls->{$module} } ) { |
| 84 |
next if $module_used eq $module; |
117 |
next if $module_used eq $module; |
| 85 |
if ( $line =~ m|^use\s+$module_used| ) { |
118 |
if ( $line =~ m|^use\s+$module_used| ) { |
| 86 |
$line = "use $module_used qw( " . join( ' ', @{ $calls->{$module}{$module_used} } ) . " );"; |
119 |
$line = "use $module_used qw( " . join( ' ', @{ $module_calls->{$module}{$module_used} } ) . " );"; |
| 87 |
} |
120 |
} |
| 88 |
} |
121 |
} |
| 89 |
push @lines, $line; |
122 |
push @lines, $line; |
|
Lines 94-96
for my $module ( keys %$calls ) {
Link Here
|
| 94 |
print $fh join("\n", @lines ) . "\n"; |
127 |
print $fh join("\n", @lines ) . "\n"; |
| 95 |
close $fh; |
128 |
close $fh; |
| 96 |
} |
129 |
} |
| 97 |
- |
130 |
for my $script_filepath ( keys %$script_calls ) { |
|
|
131 |
say $script_filepath; |
| 132 |
my $fh; |
| 133 |
open $fh, '<', $script_filepath or die "something went wrong $!"; |
| 134 |
my @lines; |
| 135 |
while ( my $line = <$fh> ) { |
| 136 |
chomp $line; |
| 137 |
unless ( $line =~ m|^use\s+| ) { |
| 138 |
push @lines, $line; |
| 139 |
next; |
| 140 |
} |
| 141 |
for my $module_used ( keys %{ $script_calls->{$script_filepath} } ) { |
| 142 |
if ( $line =~ m|^use\s+$module_used| ) { |
| 143 |
$line = "use $module_used qw( " . join( ' ', @{ $script_calls->{$script_filepath}{$module_used} } ) . " );"; |
| 144 |
} |
| 145 |
} |
| 146 |
push @lines, $line; |
| 147 |
} |
| 148 |
close $fh; |
| 149 |
|
| 150 |
open $fh, '>', $script_filepath; |
| 151 |
print $fh join("\n", @lines ) . "\n"; |
| 152 |
close $fh; |
| 153 |
} |