r26310 - in /branches/upstream/libtest-without-module-perl/current: Changes META.yml lib/Test/Without/Module.pm

[rmayorga-guest at users.alioth.debian.org]

Author: rmayorga-guest
Date: Tue Oct 28 20:11:29 2008
New Revision: 26310

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=26310
Log:
[svn-upgrade] Integrating new upstream version, libtest-without-module-perl (0.16)

Modified:
    branches/upstream/libtest-without-module-perl/current/Changes
    branches/upstream/libtest-without-module-perl/current/META.yml
    branches/upstream/libtest-without-module-perl/current/lib/Test/Without/Module.pm

Modified: branches/upstream/libtest-without-module-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-without-module-perl/current/Changes?rev=26310&op=diff
==============================================================================
--- branches/upstream/libtest-without-module-perl/current/Changes (original)
+++ branches/upstream/libtest-without-module-perl/current/Changes Tue Oct 28 20:11:29 2008
@@ -2,6 +2,11 @@
 
 Todo:
   - Add way to allow only core modules (suggested by SREZIC)
+
+0.16 20081020
+  - Add a test that exhibits the "redefined" warnings upon disallowing
+    and then reallowing a module
+  - Fixed the code so no more warnings get issued. [RT#40065]
 
 0.15 20071021
   - Now really restored compatibility of the tests with Perl 5.005,

Modified: branches/upstream/libtest-without-module-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-without-module-perl/current/META.yml?rev=26310&op=diff
==============================================================================
--- branches/upstream/libtest-without-module-perl/current/META.yml (original)
+++ branches/upstream/libtest-without-module-perl/current/META.yml Tue Oct 28 20:11:29 2008
@@ -1,13 +1,13 @@
 --- #YAML:1.0
 name:                Test-Without-Module
-version:             0.15
+version:             0.16
 abstract:            Test fallback behaviour in absence of modules
 license:             ~
-generated_by:        ExtUtils::MakeMaker version 6.36_01
+author:              
+    - Max Maischein <corion at cpan.org>
+generated_by:        ExtUtils::MakeMaker version 6.42
 distribution_type:   module
 requires:     
 meta-spec:
-    url:     http://module-build.sourceforge.net/META-spec-v1.2.html
-    version: 1.2
-author:
-    - Max Maischein <corion at cpan.org>
+    url:     http://module-build.sourceforge.net/META-spec-v1.3.html
+    version: 1.3

Modified: branches/upstream/libtest-without-module-perl/current/lib/Test/Without/Module.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-without-module-perl/current/lib/Test/Without/Module.pm?rev=26310&op=diff
==============================================================================
--- branches/upstream/libtest-without-module-perl/current/lib/Test/Without/Module.pm (original)
+++ branches/upstream/libtest-without-module-perl/current/lib/Test/Without/Module.pm Tue Oct 28 20:11:29 2008
@@ -3,7 +3,7 @@
 use Carp qw( croak );
 
 use vars qw( $VERSION );
-$VERSION = 0.15;
+$VERSION = 0.16;
 
 use vars qw( %forbidden );
 
@@ -15,8 +15,10 @@
   my ($self, at forbidden_modules) = @_;
 
   my $forbidden = get_forbidden_list;
-  $forbidden->{$_} = $_
-    for @forbidden_modules;
+  
+  for (@forbidden_modules) {
+      $forbidden->{$_} = $INC{ module2file($_) };
+  };
 
   # Scrub %INC, so that loaded modules disappear
   for my $module (@forbidden_modules) {
@@ -28,14 +30,13 @@
 
 sub fake_module {
     my ($self,$module_file,$member_only) = @_;
-    #warn $@ if $@; # Don't touch $@, or .al files will not load anymore????
+    # Don't touch $@, or .al files will not load anymore????
 
     my $forbidden = get_forbidden_list;
 
     my $modulename = file2module($module_file);
 
     # Deliver a faked, nonworking module
-    #if (grep { $modulename =~ /\Q$_\E/ } keys %$forbidden) {
     if (exists $forbidden->{$modulename}) {
       my @faked_module = ("package $modulename;","0;");
       return sub { defined ( $_ = shift @faked_module ) };
@@ -45,11 +46,15 @@
 sub unimport {
   my ($self, at list) = @_;
   my $module;
-  my $forbidden = \%forbidden;
+  my $forbidden = get_forbidden_list;
+
   for $module (@list) {
     if (exists $forbidden->{$module}) {
-      delete $forbidden->{$module};
-      scrub( $module );
+      if (defined $forbidden->{$module}) {
+          $INC{ module2file($module) } = delete $forbidden->{$module};
+      } else {
+          delete $forbidden->{$module};
+      };
     } else {
       croak "Can't allow non-forbidden module $module";
     };
@@ -63,13 +68,20 @@
   $mod;
 };
 
+sub module2file {
+  my ($mod) = @_;
+  $mod =~ s!::|'!/!g;
+  $mod .= ".pm";
+  $mod;
+};
+
 sub scrub {
   my ($module) = @_;
-  my $key;
-  for $key (keys %INC) {
-    delete $INC{$key}
-      if (file2module($key) =~ /\Q$module\E$/);
-      #if (file2module($key) =~ $module);
+  for my $key (keys %INC) {
+    my $fn = file2module($key);
+    if ($fn =~ /\Q$module\E$/) {
+        delete $INC{$key};
+    };
   };
 };