X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=blobdiff_plain;f=lib%2Findirect.pm;h=1e0827412080392f1def20a9cba6dcb45db81383;hp=1c4d065d542d968c0f98ac42a7b365ee67cb9132;hb=75a60b70d39a18521fcf5c2fbc7266100da27110;hpb=5da717399870f32544637bd4068e00e01eab84a2 diff --git a/lib/indirect.pm b/lib/indirect.pm index 1c4d065..1e08274 100644 --- a/lib/indirect.pm +++ b/lib/indirect.pm @@ -90,11 +90,15 @@ The policy to apply depends on what is first found in C<@opts> : If it is a string that matches C, the compilation will croak when the first indirect method call is found. +This option is mutually exclusive with the C<'hook'> option. + =item * If the key/value pair C<< hook => $hook >> comes first, C<$hook> will be called for each error with a string representation of the object as C<$_[0]>, the method name as C<$_[1]>, the current file as C<$_[2]> and the line number as C<$_[3]>. If and only if the object is actually a block, C<$_[0]> is assured to start by C<'{'>. +This option is mutually exclusive with the C<'fatal'> option. + =item * If none of C and C are specified, a warning will be emitted for each indirect method call. @@ -124,24 +128,32 @@ Note that if another policy is installed by a C statement further i =cut +sub _no_hook_and_fatal { + require Carp; + Carp::croak("The 'fatal' and 'hook' options are mutually exclusive"); +} + sub unimport { shift; - my $hook; - my $global; + my ($global, $fatal, $hook); + while (@_) { my $arg = shift; if ($arg eq 'hook') { - last if $hook; + _no_hook_and_fatal() if $fatal; $hook = shift; } elsif ($arg =~ /^:?fatal$/i) { - last if $hook; - $hook = sub { die msg(@_) }; + _no_hook_and_fatal() if defined $hook; + $fatal = 1; } elsif ($arg =~ /^:?global$/i) { $global = 1; } } - $hook = sub { warn msg(@_) } unless defined $hook; + + unless (defined $hook) { + $hook = $fatal ? sub { die msg(@_) } : sub { warn msg(@_) }; + } $^H |= 0x00020000; if ($global) { @@ -237,7 +249,7 @@ L 5.8.1. A C compiler. This module may happen to build with a C++ compiler as well, but don't rely on it, as no guarantee is made in this regard. -L (standard since perl 5.006). +L (standard since perl 5), L (since perl 5.006). =head1 AUTHOR