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

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

Return to bug 17600