diff lib/IMPL/require.pm @ 427:09e0086a82a7 ref20150831 tip

Merge
author cin
date Tue, 15 May 2018 00:51:33 +0300
parents c27434cdd611
children
line wrap: on
line diff
--- a/lib/IMPL/require.pm	Tue May 15 00:51:01 2018 +0300
+++ b/lib/IMPL/require.pm	Tue May 15 00:51:33 2018 +0300
@@ -11,27 +11,50 @@
 our $level = 0;
 
 sub import {
-	my ( $self, $aliases ) = @_;
+	my $self = shift;
+
+	my $aliases;
 
-	return unless $aliases;
-
-	die "A hash reference is required" unless ref $aliases eq 'HASH';
+	if ( @_ == 1 ) {
+		my $aliases = shift;
+		die "A hash reference is required" unless ref $aliases eq 'HASH';
+	}
+	else {
+		die "A list of pairs is expected" unless @_ % 2 == 0;
+		$aliases = {@_};
+	}
 
 	my $caller = caller;
 
 	$PENDING{$caller} = 1;
 
 	no strict 'refs';
+	while ( my ( $alias, $spec ) = each %$aliases ) {
+		my ( $mode, $class ) = m/^(-|~)(.*)/;
 
-	while ( my ( $alias, $class ) = each %$aliases ) {
-		_trace("$alias => $class");
+		_trace("$alias => $spec [$class]");
+
+		$class =~ s/^SELF(?=\W|$)/${caller}::/;
 		$level++;
 
-		my $c = _require($class);
-
-		*{"${caller}::$alias"} = sub () {
-			$c;
-		};
+		if ( $mode eq '-' ) {
+			*{"${caller}::$alias"} = sub () {
+				$class;
+			};
+		}
+		elsif ( $mode eq '~' ) {
+			*{"${caller}::$alias"} = sub () {
+				my $c = _require($class);
+				*{"${caller}::$alias"} = sub() { $c };
+				return $c;
+			};
+		}
+		else {
+			my $c = _require($class);
+			*{"${caller}::$alias"} = sub () {
+				$c;
+			};
+		}
 
 		$level--;
 	}