Initial Commit
This commit is contained in:
Riley Schneider
371
database/perl/vendor/lib/aliased.pm
vendored
Normal file
371
database/perl/vendor/lib/aliased.pm
vendored
Normal file
@@ -0,0 +1,371 @@
|
||||
package aliased; # git description: v0.33-3-g0a61221
|
||||
# ABSTRACT: Use shorter versions of class names.
|
||||
$aliased::VERSION = '0.34';
|
||||
require Exporter;
|
||||
@EXPORT = qw(alias prefix);
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
sub _croak {
|
||||
require Carp;
|
||||
Carp::croak(@_);
|
||||
}
|
||||
|
||||
sub import {
|
||||
# Without args, just export @EXPORT
|
||||
goto &Exporter::import if @_ <= 1;
|
||||
|
||||
my ( $class, $package, $alias, @import ) = @_;
|
||||
|
||||
my $callpack = caller(0);
|
||||
_load_alias( $package, $callpack, @import );
|
||||
_make_alias( $package, $callpack, $alias );
|
||||
}
|
||||
|
||||
sub _get_alias {
|
||||
my $package = shift;
|
||||
$package =~ s/.*(?:::|')//;
|
||||
return $package;
|
||||
}
|
||||
|
||||
sub _make_alias {
|
||||
my ( $package, $callpack, $alias ) = @_;
|
||||
|
||||
$alias ||= _get_alias($package);
|
||||
|
||||
my $destination = $alias =~ /::/
|
||||
? $alias
|
||||
: "$callpack\::$alias";
|
||||
|
||||
# need a scalar not referenced elsewhere to make the sub inlinable
|
||||
my $pack2 = $package;
|
||||
|
||||
no strict 'refs';
|
||||
*{ $destination } = sub () { $pack2 };
|
||||
}
|
||||
|
||||
sub _load_alias {
|
||||
my ( $package, $callpack, @import ) = @_;
|
||||
|
||||
# We don't localize $SIG{__DIE__} here because we need to be careful about
|
||||
# restoring its value if there is a failure. Very, very tricky.
|
||||
my $sigdie = $SIG{__DIE__};
|
||||
{
|
||||
my $code =
|
||||
@import == 0
|
||||
? "package $callpack; use $package;"
|
||||
: "package $callpack; use $package (\@import)";
|
||||
eval $code;
|
||||
if ( my $error = $@ ) {
|
||||
$SIG{__DIE__} = $sigdie;
|
||||
_croak($error);
|
||||
}
|
||||
$sigdie = $SIG{__DIE__}
|
||||
if defined $SIG{__DIE__};
|
||||
}
|
||||
|
||||
# Make sure a global $SIG{__DIE__} makes it out of the localization.
|
||||
$SIG{__DIE__} = $sigdie if defined $sigdie;
|
||||
return $package;
|
||||
}
|
||||
|
||||
sub alias {
|
||||
my ( $package, @import ) = @_;
|
||||
|
||||
my $callpack = scalar caller(0);
|
||||
return _load_alias( $package, $callpack, @import );
|
||||
}
|
||||
|
||||
sub prefix {
|
||||
my ($class) = @_;
|
||||
return sub {
|
||||
my ($name) = @_;
|
||||
my $callpack = caller(0);
|
||||
if ( not @_ ) {
|
||||
return _load_alias( $class, $callpack );
|
||||
}
|
||||
elsif ( @_ == 1 && defined $name ) {
|
||||
return _load_alias( "${class}::$name", $callpack );
|
||||
}
|
||||
else {
|
||||
_croak("Too many arguments to prefix('$class')");
|
||||
}
|
||||
};
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
aliased - Use shorter versions of class names.
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.34
|
||||
|
||||
=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
|
||||
use aliased;
|
||||
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
|
||||
class you specify and exports into your namespace a subroutine that returns
|
||||
the class name. You can explicitly alias the class to another name or, if you
|
||||
prefer, you can do so implicitly. In the latter case, the name of the
|
||||
subroutine is the last part of the class name. Thus, it does something
|
||||
similar to the following:
|
||||
|
||||
#use aliased 'Some::Annoyingly::Long::Module::Name::Customer';
|
||||
|
||||
use Some::Annoyingly::Long::Module::Name::Customer;
|
||||
sub Customer {
|
||||
return 'Some::Annoyingly::Long::Module::Name::Customer';
|
||||
}
|
||||
my $cust = Customer->new;
|
||||
|
||||
This module is useful if you prefer a shorter name for a class. It's also
|
||||
handy if a class has been renamed.
|
||||
|
||||
(Some may object to the term "aliasing" because we're not aliasing one
|
||||
namespace to another, but it's a handy term. Just keep in mind that this is
|
||||
done with a subroutine and not with typeglobs and weird namespace munging.)
|
||||
|
||||
Note that this is B<only> for C<use>ing OO modules. You cannot use this to
|
||||
load procedural modules. See the L<Why OO Only?> section. Also, don't let
|
||||
the version number fool you. This code is ridiculously simple and is just
|
||||
fine for most use.
|
||||
|
||||
=head2 Implicit Aliasing
|
||||
|
||||
The most common use of this module is:
|
||||
|
||||
use aliased 'Some::Module::name';
|
||||
|
||||
C<aliased> will allow you to reference the class by the last part of the
|
||||
class name. Thus, C<Really::Long::Name> becomes C<Name>. It does this by
|
||||
exporting a subroutine into your namespace with the same name as the aliased
|
||||
name. This subroutine returns the original class name.
|
||||
|
||||
For example:
|
||||
|
||||
use aliased "Acme::Company::Customer";
|
||||
my $cust = Customer->find($id);
|
||||
|
||||
Note that any class method can be called on the shorter version of the class
|
||||
name, not just the constructor.
|
||||
|
||||
=head2 Explicit Aliasing
|
||||
|
||||
Sometimes two class names can cause a conflict (they both end with C<Customer>
|
||||
for example), or you already have a subroutine with the same name as the
|
||||
aliased name. In that case, you can make an explicit alias by stating the
|
||||
name you wish to alias to:
|
||||
|
||||
use aliased 'Original::Module::Name' => 'NewName';
|
||||
|
||||
Here's how we use C<aliased> to avoid conflicts:
|
||||
|
||||
use aliased "Really::Long::Name";
|
||||
use aliased "Another::Really::Long::Name" => "Aname";
|
||||
my $name = Name->new;
|
||||
my $aname = Aname->new;
|
||||
|
||||
You can even alias to a different package:
|
||||
|
||||
use aliased "Another::Really::Long::Name" => "Another::Name";
|
||||
my $aname = Another::Name->new;
|
||||
|
||||
Messing around with different namespaces is a really bad idea and you probably
|
||||
don't want to do this. However, it might prove handy if the module you are
|
||||
using has been renamed. If the interface has not changed, this allows you to
|
||||
use the new module by only changing one line of code.
|
||||
|
||||
use aliased "New::Module::Name" => "Old::Module::Name";
|
||||
my $thing = Old::Module::Name->new;
|
||||
|
||||
=head2 Import Lists
|
||||
|
||||
Sometimes, even with an OO module, you need to specify extra arguments when
|
||||
using the module. When this happens, simply use L<Explicit Aliasing> followed
|
||||
by the import list:
|
||||
|
||||
Snippet 1:
|
||||
|
||||
use Some::Module::Name qw/foo bar/;
|
||||
my $o = Some::Module::Name->some_class_method;
|
||||
|
||||
Snippet 2 (equivalent to snippet 1):
|
||||
|
||||
use aliased 'Some::Module::Name' => 'Name', qw/foo bar/;
|
||||
my $o = Name->some_class_method;
|
||||
|
||||
B<Note>: remember, you cannot use import lists with L<Implicit Aliasing>. As
|
||||
a result, you may simply prefer to only use L<Explicit Aliasing> as a matter
|
||||
of style.
|
||||
|
||||
=head2 alias()
|
||||
|
||||
This function is only exported if you specify C<use aliased> with no import
|
||||
list.
|
||||
|
||||
use aliased;
|
||||
my $alias = alias($class);
|
||||
my $alias = alias($class, @imports);
|
||||
|
||||
C<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 C<$class> (pass in C<@imports>, if given)
|
||||
but instead of providing an C<Alias> constant it simply returns a scalar set
|
||||
to the C<$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 C<$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 prefix() (experimental)
|
||||
|
||||
This function is only exported if you specify C<use aliased> with no import
|
||||
list.
|
||||
|
||||
use aliased;
|
||||
|
||||
Sometimes you find you have a ton of packages in the same top-level namespace
|
||||
and you want to alias them, but only use them on demand. For example:
|
||||
|
||||
# instead of:
|
||||
MailVerwaltung::Client::Exception::REST::Response->throw()
|
||||
|
||||
my $error = prefix('MailVerwaltung::Client::Exception');
|
||||
$error->('REST::Response')->throw(); # same as above
|
||||
$error->()->throw; # same as MailVerwaltung::Client::Exception->throw
|
||||
|
||||
=head2 Why OO Only?
|
||||
|
||||
Some people have asked why this code only support object-oriented modules
|
||||
(OO). If I were to support normal subroutines, I would have to allow the
|
||||
following syntax:
|
||||
|
||||
use aliased 'Some::Really::Long::Module::Name';
|
||||
my $data = Name::data();
|
||||
|
||||
=for stopwords nilly
|
||||
|
||||
That causes a serious problem. The only (reasonable) way it can be done is to
|
||||
handle the aliasing via typeglobs. Thus, instead of a subroutine that
|
||||
provides the class name, we alias one package to another (as the
|
||||
L<namespace|namespace> module does.) However, we really don't want to simply
|
||||
alias one package to another and wipe out namespaces willy-nilly. By merely
|
||||
exporting a single subroutine to a namespace, we minimize the issue.
|
||||
|
||||
Fortunately, this doesn't seem to be that much of a problem. Non-OO modules
|
||||
generally support exporting of the functions you need and this eliminates the
|
||||
need for a module such as this.
|
||||
|
||||
=head1 EXPORT
|
||||
|
||||
This modules exports a subroutine with the same name as the "aliased" name.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
The L<namespace> module.
|
||||
|
||||
=head1 THANKS
|
||||
|
||||
=for stopwords Rentrak
|
||||
|
||||
Many thanks to Rentrak, Inc. (http://www.rentrak.com/) for graciously allowing
|
||||
me to replicate the functionality of some of their internal code.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Curtis "Ovid" Poe <ovid@cpan.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2005 by Curtis "Ovid" Poe.
|
||||
|
||||
This is free software; you can redistribute it and/or modify it under
|
||||
the same terms as the Perl 5 programming language system itself.
|
||||
|
||||
=head1 CONTRIBUTORS
|
||||
|
||||
=for stopwords Karen Etheridge Curtis Poe Ovid Florian Ragwitz Grzegorz Rożniecki Father Chrysostomos Belden Lyman Olivier Mengué
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
Karen Etheridge <ether@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Curtis Poe <ovid@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Ovid <curtis_ovid_poe@yahoo.com>
|
||||
|
||||
=item *
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=item *
|
||||
|
||||
Grzegorz Rożniecki <xaerxess@gmail.com>
|
||||
|
||||
=item *
|
||||
|
||||
Father Chrysostomos <sprout@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Belden Lyman <belden@shutterstock.com>
|
||||
|
||||
=item *
|
||||
|
||||
Olivier Mengué <dolmen@cpan.org>
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
Reference in New Issue
Block a user