Implement LAX and INTERMEDIATE modes as well

diff --git a/lib/evil.pm b/lib/evil.pm
index 12ae620e12467058757961a7be7d7824870ec37f..72dabb0d9746a2699367a20e36779a78738e71fe 100644 (file)
--- a/lib/evil.pm
+++ b/lib/evil.pm
@@ -7,24 +7,56 @@ use warnings;
 
 use Carp;
 
+my $INTERMEDIATE = __PACKAGE__.'/intermediate';
+my $LAX          = __PACKAGE__.'/lax';
+
 our $VERSION = 0.002;
 
 our %tainted;
-our $strict;
+our %wants_strict;
 
 sub import {
+       croak "Cannot load evil module when \"no evil ':strict'\" is in effect" if %wants_strict;
+
+       my $hinthash = (caller 0)[10] || {};
+       croak "Current module requested no evilness" if $hinthash->{$LAX};
+
+       $hinthash = (caller 3)[10] || {};
+       croak "Cannot load evil module when parent requested \"no evil ':lax'\"" if $hinthash->{$LAX};
+
+       my $level = 4;
+       my @caller;
+       while (@caller = caller $level) {
+               $hinthash = $caller[10] || {};
+               croak "Cannot load evil module when ancestor requested \"no evil ':intermediate'\""
+                 if $hinthash->{$INTERMEDIATE};
+               $level++;
+       }
+
        $tainted{caller()} = 1;
-       croak "Cannot load evil module when \"no evil ':strict'\" is in effect" if $strict;
 }
 
 sub unimport {
        my $strict_arg = grep /^:strict$/, @_;
+       my $intermediate_arg = grep /^:intermediate$/, @_;
+       my $lax_arg = grep /^:lax$/, @_;
        my $disable_arg = grep /^:disable/, @_;
-       carp 'no evil; interpreted as no evil ":strict". This will change in a future version of Acme::Evil' unless $strict_arg || $disable_arg;
-       $strict = 1 unless $disable_arg; # To be changed when other modes are implemented
-       $strict = 0 if $disable_arg;
-       if ($strict && %tainted) {
-               croak "Evil module already loaded. Cannot enforce \"no evil ':strict'\"";
+
+       if (!$disable_arg && $tainted{caller()}) { # caller is evil
+               croak 'Current module is evil'
+       }
+
+       if ($strict_arg) {
+               $wants_strict{caller()} = 1;
+               croak "Evil module already loaded. Cannot enforce \"no evil ':strict'\"" if %tainted
+       } elsif ($lax_arg) {
+               $^H{$LAX} = 1
+       } elsif ($disable_arg) {
+               delete $wants_strict{caller()};
+               delete $^H{$LAX};
+               delete $^H{$INTERMEDIATE};
+       } else { # $intermediate_arg or no arg
+               $^H{$INTERMEDIATE} = $^H{$LAX} = 1
        }
 }