| Subject: | alias() |
Attached is a patch to add an alias() function which cuts through a lot of the ambiguity involved in the Constant style aliasing.
diff -rN -u old-aliased-0.11/MANIFEST new-aliased-0.11/MANIFEST
--- old-aliased-0.11/MANIFEST 2005-01-06 20:25:28.000000000 -0800
+++ new-aliased-0.11/MANIFEST 2005-07-11 15:05:32.000000000 -0700
@@ -7,4 +7,5 @@
t/10aliased.t
t/lib/Really/Long/Module/Conflicting/Name.pm
t/lib/Really/Long/Module/Name.pm
+t/lib/Really/Long/Name.pm
t/lib/Really/Long/PackageName.pm
diff -rN -u old-aliased-0.11/lib/aliased.pm new-aliased-0.11/lib/aliased.pm
--- old-aliased-0.11/lib/aliased.pm 2005-01-06 20:49:45.000000000 -0800
+++ new-aliased-0.11/lib/aliased.pm 2005-07-11 14:40:28.000000000 -0700
@@ -1,22 +1,24 @@
package aliased;
$VERSION = '0.11';
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(alias);
+
use strict;
sub import {
my ($class, $package, $alias, @import) = @_;
- require Carp && Carp::croak("You must supply a package name to aliased")
- unless defined $package;
- $alias ||= _get_alias($package);
- {
- local $SIG{'__DIE__'};
- my $callpack = caller(0);
- eval "package $callpack; require $package; sub $alias () { '$package' }";
- die $@ if $@;
+
+ if( @_ <= 1 ) {
+ $class->export_to_level(1);
+ return;
}
- my $import_method = $package->can('import');
- @_ = ($package, @import);
- goto $import_method if $import_method;
+
+ my $callpack = caller(0);
+
+ _load_alias($package, $callpack, @import);
+ _make_alias($package, $callpack, $alias);
}
sub _get_alias {
@@ -25,6 +27,42 @@
return $package;
}
+
+sub _make_alias {
+ my($package, $callpack, $alias) = @_;
+
+ $alias ||= _get_alias($package);
+
+ local $SIG{__DIE__};
+ eval qq{
+ package $callpack;
+ sub $alias () { '$package' }
+ };
+ die $@ if $@;
+}
+
+
+sub _load_alias {
+ my($package, $callpack, @import) = @_;
+
+ local $SIG{'__DIE__'};
+ my $code = @import == 0 ? "package $callpack; use $package;"
+ : "package $callpack; use $package (\@import)";
+ eval $code;
+ die $@ if $@;
+}
+
+
+sub alias {
+ my($package, @import) = @_;
+
+ my $callpack = scalar caller(0);
+ _load_alias($package, $callpack, @import);
+
+ return $package;
+}
+
+
1;
__END__
@@ -34,12 +72,22 @@
=head1 SYNOPSIS
+ # Class name interface
use aliased 'My::Company::Namespace::Customer';
my $cust = Customer->new;
use aliased 'My::Company::Namespace::Preferred::Customer' => 'Preferred';
my $pref = Preferred->new;
+
+ # Variable interface
+ my $Customer = alias "My::Other::Namespace::Customer";
+ my $cust = $Customer->new;
+
+ my $Preferred = alias "My::Other::Namespace::Preferred::Customer";
+ my $pref = $Preferred->new;
+
+
=head1 DESCRIPTION
C<aliased> is simple in concept but is a rather handy module. It loads the
@@ -137,6 +185,41 @@
a result, you may simply prefer to only use L<Explicit Aliasing> as a matter of
style.
+=head2 alias()
+
+ my $alias = alias($class);
+ my $alias = alias($class, @imports);
+
+alias() is an alternative to C<use aliased ...> which uses less magic and
+avoids some of the ambiguities.
+
+Like C<use aliased> it C<use>s the $class (pass in @imports, if given) but
+instead of providing an C<Alias> constant it simply returns a scalar set to
+the $class name.
+
+ my $thing = alias("Some::Thing::With::A::Long::Name");
+
+ # Just like Some::Thing::With::A::Long::Name->method
+ $thing->method;
+
+The use of a scalar instead of a constant avoids any possible ambiguity
+when aliasing two similar names:
+
+ # No ambiguity despite the fact that they both end with "Name"
+ my $thing = alias("Some::Thing::With::A::Long::Name");
+ my $other = alias("Some::Other::Thing::With::A::Long::Name");
+
+and there is no magic constant exported into your namespace.
+
+The only caveat is loading of the $class happens at run time. If $class
+exports anything you might want to ensure it is loaded at compile time with:
+
+ my $thing;
+ BEGIN { $thing = alias("Some::Thing"); }
+
+However, since OO classes rarely export this should not be necessary.
+
+
=head2 Why OO Only?
Some people have asked why this code only support object-oriented modules (OO).
diff -rN -u old-aliased-0.11/t/10aliased.t new-aliased-0.11/t/10aliased.t
--- old-aliased-0.11/t/10aliased.t 2005-01-06 19:21:59.000000000 -0800
+++ new-aliased-0.11/t/10aliased.t 2005-07-11 14:43:15.000000000 -0700
@@ -2,7 +2,7 @@
use warnings;
use strict;
-use Test::More tests => 15;
+use Test::More tests => 17;
#use Test::More qw/no_plan/;
BEGIN {
@@ -14,9 +14,8 @@
};
eval "use aliased";
-ok $@, '... trying to use aliased without a package name should fail';
-like $@, qr/You must supply a package name to aliased/,
- '... telling us how stupid we were';
+is $@, '', '... trying to use aliased without a package name should not fail';
+can_ok __PACKAGE__, 'alias';
eval "use aliased 'No::Such::Module'";
ok $@, 'Trying to use aliased with a module it cannot load should fail';
@@ -48,3 +47,15 @@
'... and it should behave as expected';
}
+
+# Test alias
+{
+ my $alias = alias("Really::Long::Name");
+ is $alias->thing(2), 4, 'alias()';
+
+ {
+ package Foo::Bar;
+ ::alias("Really::Long::Module::Conflicting::Name", "echo");
+ ::is_deeply [echo("foo")], ["foo"];
+ }
+}
diff -rN -u old-aliased-0.11/t/lib/Really/Long/Name.pm new-aliased-0.11/t/lib/Really/Long/Name.pm
--- old-aliased-0.11/t/lib/Really/Long/Name.pm 1969-12-31 16:00:00.000000000 -0800
+++ new-aliased-0.11/t/lib/Really/Long/Name.pm 2005-07-11 14:22:30.000000000 -0700
@@ -0,0 +1,5 @@
+package Really::Long::Name;
+
+sub thing { return $_[1] + 2 }
+
+1;