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 |
} |