Question

I’m working on a package that defines exceptions (using Exception::Class::Nested) for its ‘parent’ package. I don’t want the parent package to have to use the really long names, though, and I don’t want to pollute any other namespace.

So what I’d like to do is export the last element of the class names into the namespace of the package that used the exception package.

For example, an excerpt from the exception package:

package Klass:Foo::Bar::Exceptions;
use vars qw( @ISA @EXPORT @EXPORT_OK ... );
@ISA = qw( Klass::Foo::Bar Exporter );
use Exception::Class::Nested 0.04 (
    'Klass::Foo::Bar::Exceptions::BaseClass' => {
        description => 'Base class for exceptions',
        'Klass::Foo::Bar::Exceptions::NameError' => {
            error => "I don't like your face"
        }
    }
);

The ‘parent’ package:

package Klass::Foo::Bar;
use Klass::Foo::Bar::Exceptions;
Klass::Foo::Bar::Exceptions::NameError->throw(error => "D'oh!");
my $e = NameError->new(error => 'Mwahaha!');

I’d like to export/import the exception class such that the second invocation (the my $e one) works as though NameError was defined in Klass::Foo::Bar, but I haven’t figured it out yet.

(And before anyone says ‘but Exception::Class has the nifty alias thingy,’ I’ll point out that the alias name is linked specifically to the exception’s throw method, so I can’t use that for non-auto-thrown new invocations..)

One thing I tried is putting this in the exception package’s importer sub (@snames is either an array of the fully-qualified exception classes (e.g., 'Klass::Foo::Bar::Exceptions::NameError'), or just the tail end (e.g., 'NameError'):

my $caller = caller();
$caller ||= 'main';
my @snames = @{$EXPORT_TAGS{exceptions}};
for my $exc (@snames) {
    $exc =~ s/^.*:://;
    no strict qw(subs refs);
    *{"${caller}\:\:${exc}\:\:"} = \*{__PACKAGE__ . "\:\:${exc}\:\:"};
}

But this ends up requiring me to invoke the exceptions using Klass::Foo::Bar::NameError rather than just NameError. It seems it works, but too well.

I don’t want to import NameError into main::!

Typeglobs and symbol tables are still a bit mysterious to me, I’m afraid.

I’m sure there’s a way to do what I want (or else I’m doing something that I shouldn’t altogether, but let’s leave that alone for now). Can anyone help me with this?

Thanks!

Answer 1

In your example import sub, you are aliasing package stashes, which is not going to do what you want. Instead, you want to create subroutines with the shortened names that return the full package name:

sub import {
    my $caller = caller;
    for my $long (@{$EXPORT_TAGS{exceptions}}) { # for each full name
        my ($short) = $long =~ /([^:]+)$/;       # grab the last segment
        no strict 'refs';
        *{"$caller\::$short"} = sub () {$long};  # install a subroutine named 
                                                 # $short into the caller's pkg
                                                 # that returns $long
    }
}

Breaking apart that last line, sub () {$long} creates an anonymous subroutine that takes no arguments. The code reference contains the single variable $long which retains the value it had during the loop iteration. This is called a lexical closure, which basically means that the subroutine’s compilation environment ($long and it’s value) will persist as long as the subroutine does.

This anonymous subroutine is then installed into the caller’s package with the $short name. The fully qualified name of a subroutine in the caller’s package is caller::subname, which "$caller\::$short" constructs. This is then dereferenced as a typeglob *{ ... }. Assignment to a typeglob with a reference fills that slot of the typeglob. So assigning a code reference installs the subroutine.

Put another way, the following subroutine declaration:

sub short () {'a::long::name'}

means the same thing as:

BEGIN {*{__PACKAGE__.'::short'} = sub () {'a::long::name'}}