Perl: Как перебрать таблицу символов, чтобы найти все загруженные подклассы Foo :: Bar? - PullRequest
Новая
       19

Perl: Как перебрать таблицу символов, чтобы найти все загруженные подклассы Foo :: Bar?

2 голосов
/ 07 марта 2011

У меня есть модуль, который определяет исключения для пакета, частью которого он является.Исключения объявляются с помощью Exception::Class::Nested.

. В целях обсуждения предположим, что этот модуль называется Foo::Bar::Exception, и что все определяемые им исключения являются подклассами первого уровня этого ( например , Foo::Bar::Exception:DoNotDoThat).Все исключения, которые меня волнуют, определены в этом файле модуля;Я не заинтересован в каких-либо дополнительных подклассах, которые любой другой модуль делает со мной.

Для моего import метода я хочу составить список всех определяемых исключений, и я хотел бы сделать этообходя таблицу символов каким-либо образом, а не сохраняя жестко закодированный список, который может быть не синхронизирован с определениями и должен поддерживаться вручную.

Итак, как Foo::Bar::Exception->import может перебирать Foo::Bar::Exceptionтаблица символов, чтобы найти все исключения (подклассы первого уровня), которые были объявлены в модуле?Меня интересует только активная загруженная таблица символов;поиск файловой системы или тому подобное.

Спасибо!

[ addendum ]

Поскольку все имена подклассов моих исключений заканчиваются на Exception или Error, похоже, это приближается к тому, что я хочу: 

my %symtable = eval("'%' . __PACKAGE__ . '::'");
my @shortnames = grep(m!(?:Error|Exception)::$!, keys(%symtable));
@shortnames = ( map { $_ =~ s/::$//; $_; } @shortnames );
my @longnames = ( map { __PACKAGE__ . '::' . $_ } @shortnames );

Некоторые скобки не нужны, но я добавил их для ясности относительно контекста массива.

Ответы [ 3 ]

1 голос
/ 07 марта 2011 
use MRO::Compat;
my @classes = @{ mro::get_isarev("Foo::Bar::Exception") };
@classes = grep $_->isa("Foo::Bar::Exception"), @classes;

MRO :: Compat включает API mro для pre-5.10 perls, которые иначе не имели бы его (хотя get_isarev - это много быстрее на 5.10+), get_isarev возвращает классы, которые наследуют (прямо или косвенно) от именованного класса, а последний grep объясняется тем, что get_isarev является эвристической функцией - она ​​никогда не будет пропустить класс, который наследует тот, который вы указали, но перед лицом изменения @ISA времени выполнения он может сообщить о классе, который на самом деле не больше не наследует ваш класс.Поэтому проверка ->isa гарантирует, что класс все еще существует и все еще является подклассом.

Редактировать: только что заметил ту часть, где вас интересуют только пакеты, находящиеся в пространстве иментакже, но я все еще думаю, что использование mro API является хорошей основой для их поиска - просто добавьте также grep /^Foo::Bar::Exception::/:)

1 голос
/ 07 марта 2011

Таблица символов для Foo::Bar::Exception равна %Foo::Bar::Exception::, поэтому вы можете написать: 

sub import {
    for my $key (keys %Foo::Bar::Exception::) {
        if (my ($name) = $key =~ /(.+)::$/) {
           my $pkg = 'Foo::Bar::Exception::'.$name;
           no strict 'refs';
           *{caller()."::$name"} = sub () {$pkg};
        }
    }
}
0 голосов
/ 10 марта 2011

Из-за проблем с наследованием (очевидно, введенных Exception::Class или Exception::Class::Nested), я выбрал чистый маршрут таблицы символов.

Оба длинных имени ( например ), Foo::Bar::Exception:DoNotDoThat) и короткие имена (DoNotDoThat) можно экспортировать;длинные имена экспортируются по умолчанию.(Неясно, если это необходимо, но, похоже, это не вредит.)

Если экспортируются короткие имена, это помогает: 

my $caller = caller();
$caller ||= 'main';
my @snames = @{$EXPORT_TAGS{shortnames}};
for my $short (@snames) {
    my $exc = __PACKAGE__ . '::' . $short;
    no strict 'refs';
    *{"$caller\::$short"} = sub () { $exc };
}

, что довольно близко к ответу @ Эрика, но выведенный до того как я его увидел.

Спасибо всем!

...