From 06bb160cc7bf2714dd7523ec0d4c721c074735f6 Mon Sep 17 00:00:00 2001 From: Jonathan Druart Date: Tue, 20 Jun 2017 15:12:24 -0300 Subject: [PATCH] Update script to export - export for scripts https://bugs.koha-community.org/show_bug.cgi?id=17600 --- export.pl | 73 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 65 insertions(+), 8 deletions(-) diff --git a/export.pl b/export.pl index 714c032552..655712b26c 100644 --- a/export.pl +++ b/export.pl @@ -1,7 +1,8 @@ use Modern::Perl; use List::MoreUtils qw( uniq ); -my @module_filepaths = ( glob("**/*.pm"), glob("**/**/*.pm") ); +my @module_filepaths = ( glob("**/*.pm"), glob("**/**/*.pm"), glob("**/**/*.pm") ); +my @script_filepaths = ( glob("*.pl"), glob("**/*.pl"), glob("**/**/*.pl") ); my $subroutines; MODULE: for my $module_filepath ( @module_filepaths ) { open my $fh, '<', $module_filepath; @@ -39,9 +40,20 @@ for my $module_filepath ( @module_filepaths ) { } close $fh; } +for my $script_filepath ( @script_filepaths ) { + open my $fh, '<', $script_filepath; + 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->{$script_filepath} }, $module_used if exists $subroutines->{$module_used}; + } + close $fh; +} -my $calls; -#@module_filepaths = ( 'C4/Biblio.pm' ); +my $module_calls; for my $module_filepath ( @module_filepaths ) { open my $fh, '<', $module_filepath; my $module = $module_filepath; @@ -57,16 +69,37 @@ for my $module_filepath ( @module_filepaths ) { 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} }; + push @{ $module_calls->{$module}{$module_used} }, $subroutine; + @{ $module_calls->{$module}{$module_used} } = uniq @{ $module_calls->{$module}{$module_used} }; } } } } close $fh; } +my $script_calls; +for my $script_filepath ( @script_filepaths ) { + open my $fh, '<', $script_filepath; + next unless exists $uses->{$script_filepath}; -for my $module ( keys %$calls ) { + while( my $line = <$fh> ) { + chomp $line; + next unless $line; + next if $line =~ '^use '; + next if $line =~ '^\s*#'; + for my $module_used ( @{ $uses->{$script_filepath} } ) { + for my $subroutine ( @{ $subroutines->{$module_used} } ) { + if ( $line =~ m|$subroutine| ) { + push @{ $script_calls->{$script_filepath}{$module_used} }, $subroutine; + @{ $script_calls->{$script_filepath}{$module_used} } = uniq @{ $script_calls->{$script_filepath}{$module_used} }; + } + } + } + } + close $fh; +} + +for my $module ( keys %$module_calls ) { say $module; my $module_filepath = $module; $module_filepath =~ s|::|/|g; @@ -80,10 +113,10 @@ for my $module ( keys %$calls ) { push @lines, $line; next; } - for my $module_used ( keys %{ $calls->{$module} } ) { + for my $module_used ( keys %{ $module_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} } ) . " );"; + $line = "use $module_used qw( " . join( ' ', @{ $module_calls->{$module}{$module_used} } ) . " );"; } } push @lines, $line; @@ -94,3 +127,27 @@ for my $module ( keys %$calls ) { print $fh join("\n", @lines ) . "\n"; close $fh; } +for my $script_filepath ( keys %$script_calls ) { + say $script_filepath; + my $fh; + open $fh, '<', $script_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 %{ $script_calls->{$script_filepath} } ) { + if ( $line =~ m|^use\s+$module_used| ) { + $line = "use $module_used qw( " . join( ' ', @{ $script_calls->{$script_filepath}{$module_used} } ) . " );"; + } + } + push @lines, $line; + } + close $fh; + + open $fh, '>', $script_filepath; + print $fh join("\n", @lines ) . "\n"; + close $fh; +} -- 2.11.0