From: Marius Gavrilescu <marius@ieval.ro>
Date: Sat, 1 Apr 2017 15:36:42 +0000 (+0300)
Subject: Implement LAX and INTERMEDIATE modes as well
X-Git-Tag: 0.003~5
X-Git-Url: http://git.ieval.ro/?p=acme-evil.git;a=commitdiff_plain;h=2f63ec14a6c5ecfb9c917ccd9d5016e31d3a508c

Implement LAX and INTERMEDIATE modes as well
---

diff --git a/lib/evil.pm b/lib/evil.pm
index 12ae620..72dabb0 100644
--- 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
 	}
 }