Refactor the package name validation in a proper sub

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

diff --git a/lib/subs/auto.pm b/lib/subs/auto.pm
index 13568acf02ac3419c0fb6222aa4b22c2cf50cedc..c0beebe8d10dab298246591a33d1d34d9f846381 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
@@ -78,7 +76,7 @@ my @core = qw/abs accept alarm atan2 bind binmode bless break caller chdir
               time times truncate uc ucfirst umask undef unlink unpack unshift
               untie use utime values vec wait waitpid wantarray warn when
               write/;
-push @core,qw/not/;
+push @core,qw/not __LINE__ __FILE__/;
 
 my %core;
 @core{@core} = ();
@@ -148,12 +146,27 @@ my $wiz = wizard data  => sub { +{ pkg => $_[1] } },
 
 my %pkgs;
 
+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))/;
+ $pkg =~ s/::$//;
+ $pkg = $cur . $pkg if $pkg eq '' or $pkg =~ /^::/;
+ $pkg;
+}
+
 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 $in   = _validate_pkg $args{in}, $cur;
  $^H{bareword} = 1;
- ++$pkgs{$pkg};
+ ++$pkgs{$in};
  no strict 'refs';
- cast %{$pkg . '::'}, $wiz, $pkg;
+ cast %{$in . '::'}, $wiz, $in;
 }
 
 sub unimport {