Attachment 57954 Details for Bug 17600 – [DO NOT PUSH] Script to export the subroutines used

[patch] [DO NOT PUSH] Script to export the subroutines used

DO-NOT-PUSH-Script-to-export-the-subroutines-used.patch (text/plain), 3.62 KB, created by Jonathan Druart on 2016-12-05 12:14:13 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: Jonathan Druart

Created: 2016-12-05 12:14:13 UTC

Size: 3.62 KB

patch

obsolete

>From be487db6806ecbd55e7f1fbdb717371ee37e36bd Mon Sep 17 00:00:00 2001
>From: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
>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

Actions: View | Diff | Splinter Review

Attachments on bug 17600: 57394 | 57950 | 57951 | 57952 | 57953 | 57954 | 61994 | 61995 | 61996 | 61997 | 61998 | 62209 | 62210 | 62211 | 62212 | 62213 | 62940 | 62941 | 62942 | 62943 | 62958 | 62959 | 64387 | 64388 | 64389 | 64390 | 64391 | 64392 | 64466 | 64467 | 64468 | 64469 | 64470 | 64471 | 64472 | 64473 | 64474 | 64475 | 64476 | 121309 | 121310 | 121311 | 121312 | 121313 | 121314 | 122360 | 122361 | 122362 | 122363 | 122364 | 122365 | 122869 | 122884 | 122945 | 123194 | 123195 | 123196 | 123200 | 123210 | 123281 | 123283 | 123284 | 123325 | 123417 | 123418 | 123419 | 123420 | 123565 | 124866 | 125059 | 125063 | 125064 | 125066 | 126640 | 127056 | 127918