X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FVariable%2FMagic.pm;h=c10a8057505178e62918bfae94d7bad51df0f927;hb=c8c5b403ecc90d2e086627edcc2806a3316850a1;hp=bebfc984ef21946ca609334f5f4e2fc31f921239;hpb=6c7c2526186bcb3bb40a9a337d77af313f5b2a4e;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/lib/Variable/Magic.pm b/lib/Variable/Magic.pm index bebfc98..c10a805 100644 --- a/lib/Variable/Magic.pm +++ b/lib/Variable/Magic.pm @@ -5,21 +5,19 @@ use 5.008; use strict; use warnings; -use Carp qw/croak/; - =head1 NAME Variable::Magic - Associate user-defined magic to variables from Perl. =head1 VERSION -Version 0.41 +Version 0.44 =cut our $VERSION; BEGIN { - $VERSION = '0.41'; + $VERSION = '0.44'; } =head1 SYNOPSIS @@ -296,19 +294,32 @@ Here's a simple usage example : =cut sub wizard { - croak 'Wrong number of arguments for wizard()' if @_ % 2; + if (@_ % 2) { + require Carp; + Carp::croak('Wrong number of arguments for wizard()'); + } + my %opts = @_; + my @keys = qw/data op_info get set len clear free/; push @keys, 'copy' if MGf_COPY; push @keys, 'dup' if MGf_DUP; push @keys, 'local' if MGf_LOCAL; push @keys, qw/fetch store exists delete copy_key/ if VMG_UVAR; - my $ret = eval { _wizard(map $opts{$_}, @keys) }; - if (my $err = $@) { + + my ($wiz, $err); + { + local $@; + $wiz = eval { _wizard(map $opts{$_}, @keys) }; + $err = $@; + } + if ($err) { $err =~ s/\sat\s+.*?\n//; - croak $err; + require Carp; + Carp::croak($err); } - return $ret; + + return $wiz; } =head2 C @@ -392,6 +403,10 @@ True for perls that call 'clear' magic when undefining magical arrays. True for perls that don't call 'len' magic when taking the C of a magical scalar. +=head2 C + +True for perls that call 'get' magic for operations on globs. + =head2 C The perl patchlevel this module was built with, or C<0> for non-debugging perls. @@ -563,16 +578,17 @@ use base qw/Exporter/; our @EXPORT = (); our %EXPORT_TAGS = ( 'funcs' => [ qw/wizard cast getdata dispell/ ], - 'consts' => [ - qw/MGf_COPY MGf_DUP MGf_LOCAL VMG_UVAR/, - qw/VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID/, - qw/VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID/, - qw/VMG_COMPAT_ARRAY_UNDEF_CLEAR/, - qw/VMG_COMPAT_SCALAR_LENGTH_NOLEN/, - qw/VMG_PERL_PATCHLEVEL/, - qw/VMG_THREADSAFE VMG_FORKSAFE/, - qw/VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT/ - ] + 'consts' => [ qw/ + MGf_COPY MGf_DUP MGf_LOCAL VMG_UVAR + VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID + VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID + VMG_COMPAT_ARRAY_UNDEF_CLEAR + VMG_COMPAT_SCALAR_LENGTH_NOLEN + VMG_COMPAT_GLOB_GET + VMG_PERL_PATCHLEVEL + VMG_THREADSAFE VMG_FORKSAFE + VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT + / ], ); our @EXPORT_OK = map { @$_ } values %EXPORT_TAGS; $EXPORT_TAGS{'all'} = [ @EXPORT_OK ];