View | Details | Raw Unified | Return to bug 17600
Collapse All | Expand All

(-)a/export.pl (-9 / +65 lines)
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
}

Return to bug 17600