Add the in parameter

[perl/modules/subs-auto.git] / lib / subs / auto.pm

diff --git a/lib/subs/auto.pm b/lib/subs/auto.pm
index 08f38e2c19fc138985a083a19fae69d98e5be3b1..6c4bf274c10334ae9f6e8ff9c252656fe2e5f82b 100644 (file)
--- a/lib/subs/auto.pm
+++ b/lib/subs/auto.pm
@@ -5,6 +5,7 @@ use 5.010;
 use strict;
 use warnings;
 
+use Carp qw/croak/;
 use Symbol qw/gensym/;
 
 use Variable::Magic qw/wizard cast dispell getdata/;
@@ -47,10 +48,7 @@ This pragma lexically enables the parsing of any bareword as a subroutine name,
 =cut
 
 BEGIN {
- if (!Variable::Magic::VMG_UVAR) {
-  require Carp;
-  Carp::croak('uvar magic not available');
- }
+ croak 'uvar magic not available' unless Variable::Magic::VMG_UVAR;
 }
 
 my @core = qw/abs accept alarm atan2 bind binmode bless break caller chdir
@@ -149,7 +147,20 @@ my $wiz = wizard data  => sub { +{ pkg => $_[1] } },
 my %pkgs;
 
 sub import {
- my $pkg = caller 1;
+ shift;
+ croak 'Optional arguments must be passed as keys/values pairs' if @_ % 2;
+ my %args = @_;
+ my $cur = (caller 1)[0];
+ my $pkg;
+ if ($pkg = $args{in}) {
+  croak 'Invalid package name' if ref $pkg
+                               or $pkg =~ /(?:-|[^\w:])/
+                               or $pkg =~ /(?:\A\d|\b:(?::\d|(?:::+)?\b))/;
+  $pkg =~ s/::$//;
+  $pkg = $cur . $pkg if $pkg eq '' or $pkg =~ /^::/;
+ } else {
+  $pkg = $cur;
+ }
  $^H{bareword} = 1;
  ++$pkgs{$pkg};
  no strict 'refs';