use strict;
use warnings;
-use Carp qw/croak/;
-
=head1 NAME
Variable::Magic - Associate user-defined magic to variables from Perl.
=head1 VERSION
-Version 0.42
+Version 0.43
=cut
our $VERSION;
BEGIN {
- $VERSION = '0.42';
+ $VERSION = '0.43';
}
=head1 SYNOPSIS
=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<cast>
True for perls that don't call 'len' magic when taking the C<length> of a magical scalar.
+=head2 C<VMG_COMPAT_GLOB_GET>
+
+True for perls that call 'get' magic for operations on globs.
+
=head2 C<VMG_PERL_PATCHLEVEL>
The perl patchlevel this module was built with, or C<0> for non-debugging perls.
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 ];