From be487db6806ecbd55e7f1fbdb717371ee37e36bd Mon Sep 17 00:00:00 2001 From: Jonathan Druart Date: Mon, 5 Dec 2016 12:11:42 +0000 Subject: [PATCH] [DO NOT PUSH] Script to export the subroutines used This ugly script has been used to generate the last patch https://bugs.koha-community.org/show_bug.cgi?id=17600 --- export.pl | 96 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 96 insertions(+) create mode 100644 export.pl diff --git a/export.pl b/export.pl new file mode 100644 index 0000000..714c032 --- /dev/null +++ b/export.pl @@ -0,0 +1,96 @@ +use Modern::Perl; +use List::MoreUtils qw( uniq ); + +my @module_filepaths = ( glob("**/*.pm"), glob("**/**/*.pm") ); +my $subroutines; +MODULE: for my $module_filepath ( @module_filepaths ) { + open my $fh, '<', $module_filepath; + my $module = $module_filepath; + $module =~ s|/|::|g; + $module =~ s|\.pm$||; + my $found_EXPORT_OK; + while( my $line = <$fh> ) { + chomp $line; + $found_EXPORT_OK = 1 + if $line =~ m|EXPORT_OK|; + next unless $line =~ '^sub '; + my $subroutine = $line; + $subroutine =~ s|^sub ([\w]+).*|$1|; + $subroutine =~ s|\s.*||; + push @{ $subroutines->{$module} }, $subroutine; + } + delete $subroutines->{$module} unless $found_EXPORT_OK; + close $fh; +} + +my $uses; +for my $module_filepath ( @module_filepaths ) { + open my $fh, '<', $module_filepath; + my $module = $module_filepath; + $module =~ s|/|::|g; + $module =~ s|\.pm$||; + while( my $line = <$fh> ) { + chomp $line; + next if $line !~ m|^use Koha::| and $line !~ m|^use C4::|; + my $module_used = $line; + $module_used =~ s|^use ([\w:]+)\s.*|$1|; + $module_used =~ s|^use ([\w:]+);.*|$1|; + push @{ $uses->{$module} }, $module_used if exists $subroutines->{$module_used}; + } + close $fh; +} + +my $calls; +#@module_filepaths = ( 'C4/Biblio.pm' ); +for my $module_filepath ( @module_filepaths ) { + open my $fh, '<', $module_filepath; + my $module = $module_filepath; + $module =~ s|/|::|g; + $module =~ s|\.pm$||; + next unless exists $uses->{$module}; + + while( my $line = <$fh> ) { + chomp $line; + next unless $line; + next if $line =~ '^use '; + next if $line =~ '^\s*#'; + for my $module_used ( @{ $uses->{$module} } ) { + for my $subroutine ( @{ $subroutines->{$module_used} } ) { + if ( $line =~ m|$subroutine| ) { + push @{ $calls->{$module}{$module_used} }, $subroutine; + @{ $calls->{$module}{$module_used} } = uniq @{ $calls->{$module}{$module_used} }; + } + } + } + } + close $fh; +} + +for my $module ( keys %$calls ) { + say $module; + my $module_filepath = $module; + $module_filepath =~ s|::|/|g; + $module_filepath .= '.pm'; + my $fh; + open $fh, '<', $module_filepath or die "something went wrong $!"; + my @lines; + while ( my $line = <$fh> ) { + chomp $line; + unless ( $line =~ m|^use\s+| ) { + push @lines, $line; + next; + } + for my $module_used ( keys %{ $calls->{$module} } ) { + next if $module_used eq $module; + if ( $line =~ m|^use\s+$module_used| ) { + $line = "use $module_used qw( " . join( ' ', @{ $calls->{$module}{$module_used} } ) . " );"; + } + } + push @lines, $line; + } + close $fh; + + open $fh, '>', $module_filepath; + print $fh join("\n", @lines ) . "\n"; + close $fh; +} -- 2.1.4