=head1 VERSION
-Version 0.03
+Version 0.05
=cut
-our $VERSION = '0.03';
+our $VERSION = '0.05';
=head1 SYNOPSIS
=head1 DESCRIPTION
-This pragma lexically enables the parsing of any bareword as a subroutine name, except those which corresponds to an entry in C<%INC> (expected to be class names) or whose symbol table entry has a IO slot (expected to be filehandles).
+This pragma lexically enables the parsing of any bareword as a subroutine name, except those which corresponds to an entry in C<%INC> (expected to be class names) or whose symbol table entry has an IO slot (expected to be filehandles).
You can pass options to C<import> as key / value pairs :
=back
+This module is B<not> a source filter.
+
=cut
BEGIN {
delete @core{qw/my local/};
undef @core;
-my $tag = wizard data => sub { 1 };
+BEGIN {
+ *_REFCNT_PLACEHOLDERS = eval 'sub () { ' . ($] < 5.011002 ? 0 : 1) . '}'
+}
+
+my $tag = wizard data => sub { \(my $data = _REFCNT_PLACEHOLDERS ? 2 : 1) };
sub _reset {
my ($pkg, $func) = @_;
no warnings 'once';
*$fqn{CODE};
};
- if ($cb and getdata(&$cb, $tag)) {
+ if ($cb and defined(my $data = getdata(&$cb, $tag))) {
+ $$data--;
+ return if $$data > 0;
no strict 'refs';
my $sym = gensym;
for (qw/SCALAR ARRAY HASH IO FORMAT/) {
sub _fetch {
(undef, my $data, my $func) = @_;
return if $data->{guard} or $func =~ /::/ or exists $core{$func};
- $data->{guard} = 1;
+ local $data->{guard} = 1;
my $hints = (caller 0)[10];
if ($hints and $hints->{subs__auto}) {
my $mod = $func . '.pm';
if (not exists $INC{$mod}) {
my $fqn = $data->{pkg} . '::' . $func;
- if (do { no strict 'refs'; not *$fqn{CODE} || *$fqn{IO}}) {
- my $cb = sub {
- my ($file, $line) = (caller 0)[1, 2];
- ($file, $line) = ('(eval 0)', 0) unless $file && $line;
- die "Undefined subroutine &$fqn called at $file line $line\n";
- };
- cast &$cb, $tag;
- no strict 'refs';
- *$fqn = $cb;
+ my $cb = do { no strict 'refs'; *$fqn{CODE} };
+ if ($cb) {
+ if (_REFCNT_PLACEHOLDERS and defined(my $data = getdata(&$cb, $tag))) {
+ ++$$data;
+ }
+ return;
}
+ return if do { no strict 'refs'; *$fqn{IO} };
+ $cb = sub {
+ my ($file, $line) = (caller 0)[1, 2];
+ ($file, $line) = ('(eval 0)', 0) unless $file && $line;
+ die "Undefined subroutine &$fqn called at $file line $line\n";
+ };
+ cast &$cb, $tag;
+ no strict 'refs';
+ *$fqn = $cb;
}
} else {
_reset($data->{pkg}, $func);
}
- $data->{guard} = 0;
return;
}
sub _store {
(undef, my $data, my $func) = @_;
return if $data->{guard};
- $data->{guard} = 1;
+ local $data->{guard} = 1;
_reset($data->{pkg}, $func);
- $data->{guard} = 0;
return;
}
-my $wiz = wizard data => sub { +{ pkg => $_[1] } },
+my $wiz = wizard data => sub { +{ pkg => $_[1], guard => 0 } },
fetch => \&_fetch,
store => \&_store;
Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
-You can contact me by mail or on #perl @ FreeNode (vincent or Prof_Vince).
+You can contact me by mail or on C<irc.perl.org> (vincent).
=head1 BUGS