From 2f63ec14a6c5ecfb9c917ccd9d5016e31d3a508c Mon Sep 17 00:00:00 2001 From: Marius Gavrilescu Date: Sat, 1 Apr 2017 18:36:42 +0300 Subject: [PATCH] Implement LAX and INTERMEDIATE modes as well --- lib/evil.pm | 46 +++++++++++++++++++++++++++++++++++++++------- 1 file changed, 39 insertions(+), 7 deletions(-) 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 } } -- 2.39.2