Code cleanup

diff --git a/lib/subs/auto.pm b/lib/subs/auto.pm
index 3657b1d3b6dbc7e4de61a54778fef9cde0a357ce..3cc549d6dfb05107c06a33da74d0678baf259078 100644 (file)
--- a/lib/subs/auto.pm
+++ b/lib/subs/auto.pm
@@ -7,7 +7,6 @@ use warnings;
 
 use B::Keywords;
 
 
 use B::Keywords;
 

-use Carp qw/croak/;

 use Symbol qw/gensym/;
 
 use Variable::Magic qw/wizard cast dispell getdata/;
 use Symbol qw/gensym/;
 
 use Variable::Magic qw/wizard cast dispell getdata/;


@@ -64,7 +63,10 @@ This module is B<not> a source filter.
 =cut
 
 BEGIN {
 =cut
 
 BEGIN {

- croak 'uvar magic not available' unless Variable::Magic::VMG_UVAR;
+ unless (Variable::Magic::VMG_UVAR) {
+  require Carp;
+  Carp::croak('uvar magic not available');
+ }

 }
 
 my %core;
 }
 
 my %core;


@@ -83,15 +85,18 @@ my $tag = wizard data => sub { \(my $data = _REFCNT_PLACEHOLDERS ? 2 : 1) };
 
 sub _reset {
  my ($pkg, $func) = @_;
 
 sub _reset {
  my ($pkg, $func) = @_;

+

  my $fqn = join '::', @_;
  my $cb = do {
   no strict 'refs';
   no warnings 'once';
   *$fqn{CODE};
  };
  my $fqn = join '::', @_;
  my $cb = do {
   no strict 'refs';
   no warnings 'once';
   *$fqn{CODE};
  };

+

  if ($cb and defined(my $data = getdata(&$cb, $tag))) {
   $$data--;
   return if $$data > 0;
  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/) {
   no strict 'refs';
   my $sym = gensym;
   for (qw/SCALAR ARRAY HASH IO FORMAT/) {


@@ -105,41 +110,49 @@ sub _reset {
 
 sub _fetch {
  (undef, my $data, my $func) = @_;
 
 sub _fetch {
  (undef, my $data, my $func) = @_;

+

  return if $data->{guard} or $func =~ /::/ or exists $core{$func};
  local $data->{guard} = 1;
  return if $data->{guard} or $func =~ /::/ or exists $core{$func};
  local $data->{guard} = 1;

+

  my $hints = (caller 0)[10];
  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;
-   my $cb = do { no strict 'refs'; *$fqn{CODE} };
-   if ($cb) {
-    if (_REFCNT_PLACEHOLDERS and defined(my $data = getdata(&$cb, $tag))) {
-     ++$$data;
-    }
-    return;
+ if ($hints and $hints->{+(__PACKAGE__)}) {
+  my $pm = $func . '.pm';
+  return if exists $INC{$pm};
+
+  my $fqn = $data->{pkg} . '::' . $func;
+  my $cb = do { no strict 'refs'; *$fqn{CODE} };
+  if ($cb) {
+   if (_REFCNT_PLACEHOLDERS and defined(my $data = getdata(&$cb, $tag))) {
+    ++$$data;

    }
    }

-   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;
+   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);
  }
  } else {
   _reset($data->{pkg}, $func);
  }

+

  return;
 }
 
 sub _store {
  (undef, my $data, my $func) = @_;
  return;
 }
 
 sub _store {
  (undef, my $data, my $func) = @_;

+

  return if $data->{guard};
  local $data->{guard} = 1;
  return if $data->{guard};
  local $data->{guard} = 1;

+

  _reset($data->{pkg}, $func);
  _reset($data->{pkg}, $func);

+

  return;
 }
 
  return;
 }
 


@@ -149,12 +162,27 @@ my $wiz = wizard data  => sub { +{ pkg => $_[1], guard => 0 } },
 
 my %pkgs;
 
 
 my %pkgs;
 

+my $pkg_rx = qr/
+ ^(?:
+     ::
+    |
+     (?:::)?
+     [A-Za-z_][A-Za-z0-9_]*
+     (?:::[A-Za-z_][A-Za-z0-9_]*)*
+     (?:::)?
+  )$
+/x;
+

 sub _validate_pkg {
  my ($pkg, $cur) = @_;
 sub _validate_pkg {
  my ($pkg, $cur) = @_;

- return $cur unless $pkg;
- croak 'Invalid package name' if ref $pkg
-                              or $pkg =~ /(?:-|[^\w:])/
-                              or $pkg =~ /(?:\A\d|\b:(?::\d|(?:::+)?\b))/;
+
+ return $cur unless defined $pkg;
+
+ if (ref $pkg or $pkg !~ $pkg_rx) {
+  require Carp;
+  Carp::croak('Invalid package name');
+ }
+

  $pkg =~ s/::$//;
  $pkg = $cur . $pkg if $pkg eq '' or $pkg =~ /^::/;
  $pkg;
  $pkg =~ s/::$//;
  $pkg = $cur . $pkg if $pkg eq '' or $pkg =~ /^::/;
  $pkg;


@@ -162,18 +190,28 @@ sub _validate_pkg {
 
 sub import {
  shift;
 
 sub import {
  shift;

- croak 'Optional arguments must be passed as keys/values pairs' if @_ % 2;
+ if (@_ % 2) {
+  require Carp;
+  Carp::croak('Optional arguments must be passed as keys/values pairs');
+ }

  my %args = @_;
  my %args = @_;

- my $cur  = (caller 1)[0];
- my $in   = _validate_pkg $args{in}, $cur;
- $^H{subs__auto} = 1;
+
+ my $cur = (caller 1)[0];
+ my $in  = _validate_pkg $args{in}, $cur;

  ++$pkgs{$in};
  ++$pkgs{$in};

- no strict 'refs';
- cast %{$in . '::'}, $wiz, $in;
+ {
+  no strict 'refs';
+  cast %{$in . '::'}, $wiz, $in;
+ }
+
+ $^H{+(__PACKAGE__)} = 1;
+ $^H |= 0x020000;
+
+ return;

 }
 
 sub unimport {
 }
 
 sub unimport {

- $^H{subs__auto} = 0;
+ $^H{+(__PACKAGE__)} = 0;

 }
 
 {
 }
 
 {