Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to detect exported subs overwrites?

Tags:

perl

Having a next code:

use strict;
use warnings;

use Devel::Peek;
use YAML;

my $s = {a=>'b'};
print Dump($s);

it prints YAML output:

---
a: b

now changing the order of the modules.

use strict;
use warnings;

use YAML;
use Devel::Peek;

my $s = {a=>'b'};
print Dump($s);

it prints:

SV = IV(0x7ff5d2829308) at 0x7ff5d2829318
  REFCNT = 1
  FLAGS = (PADMY,ROK)
  RV = 0x7ff5d2803438
  SV = PVHV(0x7ff5d2808d20) at 0x7ff5d2803438
    REFCNT = 1
    FLAGS = (SHAREKEYS)
    ARRAY = 0x7ff5d243acf0  (0:7, 1:1)
    hash quality = 100.0%
    KEYS = 1
    FILL = 1
    MAX = 7
    Elt "a" HASH = 0x274d838f
    SV = PV(0x7ff5d2804070) at 0x7ff5d2828a00
      REFCNT = 1
      FLAGS = (POK,IsCOW,pPOK)
      PV = 0x7ff5d240e2d0 "b"\0
      CUR = 1
      LEN = 16
      COW_REFCNT = 1
Use of uninitialized value in print at yy line 8.

Both module exports a function Dump so, the last wins.

I have enabled warnings, but it doesn't warn me about the exported functions redefine (overwrite?). It is possible detect and show a warning for such redefines?

like image 457
kobame Avatar asked Jul 26 '14 23:07

kobame


1 Answers

Most interesting question. The problem, I think, lies in the fact that Exporter.pm doesn't have warnings enabled. Here's a simple set of files that demonstrates the behaviour you described:

Foo.pm:

package Foo;
use base 'Exporter';
our @EXPORT = qw(Baz);

sub Baz {
    print "Hello from Foo::Baz\n";
}

Bar.pm:

package Bar;
use base 'Exporter';
our @EXPORT = qw(Baz);

sub Baz {
    print "Hi from Bar::Baz\n";
}

import-redefine.pl:

use strict;
use warnings;

use Foo;
use Bar;
Baz();

Sample run:

C:\Users\Lona\Desktop\pm>perl import-redefine.pl
Hi from Bar::Baz

Reverse the use statements, as follows:

use strict;
use warnings;

use Bar;
use Foo;
Baz();

And run again:

C:\Users\Lona\Desktop\pm>perl import-redefine.pl
Hello from Foo::Baz

I've come up with the following solution, that redefines Exporter.pm's default import method:

BEGIN {
    require Exporter;                               # We'll need Exporter.pm loaded.
    my $old_import = \&Exporter::import;            # Save copy of original Exporter::import.

    no strict 'refs';                               # We'll be using some hacks that will
    no warnings 'redefine';                         # raise errors and warnings. Suppress those.

    *Exporter::import = sub {                       # Our enhancement of Exporter::import.
        use Carp;
        my $pkg = shift;
        my $callpkg = caller($Exporter::ExportLevel + 1);

        my @exports =  @_ > 0                       # Which subs to export?
                       ? @_                         # Those provided as 'use MODULE' arguments...                
                       : @{"$pkg\::EXPORT"}         # Or thosedefined in the module's @EXPORT?
        ;
        foreach my $sub (@exports) {                # For each of the exportees... 
            if (exists ${"$callpkg\::"}{$sub}) {    # ... check if it exists...
                carp "Subroutine $callpkg\::$sub redefined by import"; # and throw a warning if needed.
            }
        $old_import->($pkg, @_);                    # Call the original Exporter::import.
        }
    }
}

To use this, but it somewhere in your main script file, above the use MODULE statements:

use strict;
use warnings;

BEGIN {
    require Exporter;                               # We'll need Exporter.pm loaded.
    my $old_import = \&Exporter::import;            # Save copy of original Exporter::import.

    no strict 'refs';                               # We'll be using some hacks that will
    no warnings 'redefine';                         # raise errors and warnings. Suppress those.

    *Exporter::import = sub {                       # Our enhancement of Exporter::import.
        use Carp;
        my $pkg = shift;
        my $callpkg = caller($Exporter::ExportLevel + 1);

        my @exports =  @_ > 0                       # Which subs to export?
                       ? @_                         # Those provided as 'use MODULE' arguments...                
                       : @{"$pkg\::EXPORT"}         # Or thosedefined in the module's @EXPORT?
        ;
        foreach my $sub (@exports) {                # For each of the exportees... 
            if (exists ${"$callpkg\::"}{$sub}) {    # ... check if it exists...
                carp "Subroutine $callpkg\::$sub redefined by import"; # and throw a warning if needed.
            }
        $old_import->($pkg, @_);                    # Call the original Exporter::import.
        }
    }
}

use Foo;
use Bar;
Baz();

And run it:

C:\Users\Lona\Desktop\pm>perl import-redefine.pl

Subroutine main::Baz redefined by import at import-redefine.pl line 21.
        main::__ANON__("Bar") called at import-redefine.pl line 30
        main::BEGIN() called at import-redefine.pl line 30
        eval {...} called at import-redefine.pl line 30
Hi from Bar::Baz
like image 62
Andrejovich Avatar answered Oct 19 '22 23:10

Andrejovich