Сортировка Perl; чистая работа с глобальными объектами пакета $ a, $ b в пространствах имен

Предположим, у меня есть служебная библиотека ( other ), содержащая подпрограмму ( sort_it ), который я хочу использовать для возврата произвольно отсортированных данных. Возможно, это сложнее, но это иллюстрирует ключевые понятия:

#!/usr/local/bin/perl

use strict;

package other;

sub sort_it {
  my($data, $sort_function) = @_;

  return([sort $sort_function @$data]);
}

Теперь давайте используем его в другом пакете.

package main;
use Data::Dumper;

my($data) = [
        {'animal' => 'bird',            'legs' => 2},
        {'animal' => 'black widow',     'legs' => 8},
        {'animal' => 'dog',             'legs' => 4},
        {'animal' => 'grasshopper',     'legs' => 6},
        {'animal' => 'human',           'legs' => 2},
        {'animal' => 'mosquito',        'legs' => 6},
        {'animal' => 'rhino',           'legs' => 4},
        {'animal' => 'tarantula',       'legs' => 8},
        {'animal' => 'tiger',           'legs' => 4},
        ],

my($sort_by_legs_then_name) = sub {
    return ($a->{'legs'}   <=> $b->{'legs'} ||
            $a->{'animal'} cmp $b->{'animal'});
};

print Dumper(other::sort_it($data, $sort_by_legs_then_name));

Это не работает из-за тонкой проблемы. $ a и $ b являются пакетами глобалы. Они ссылаются на $ main :: a и $ main :: b , когда они заключены в закрытие.

Мы могли бы исправить это, сказав вместо этого:

my($sort_by_legs_then_name) = sub {
    return ($other::a->{'legs'}   <=> $other::b->{'legs'} ||
            $other::a->{'animal'} cmp $other::b->{'animal'});
};

Это работает, но заставляет нас жестко указать имя нашего пакета служебных программ где угодно. Если бы это изменилось, нам нужно было бы не забыть изменить код, а не только , используйте другой оператор qw (sort_it); , который, вероятно, присутствовать в реальном мире.

Вы можете сразу же подумать попробовать использовать __ PACKAGE __ . Что ветры до оценки до "основного". Как и eval ("__ PACKAGE __"); .

Есть трюк с использованием вызывающего , который работает:

my($sort_by_legs_then_name) = sub {
  my($context) = [caller(0)]->[0];
  my($a) = eval("\$$context" . "::a");
  my($b) = eval("\$$context" . "::b");

  return ($a->{'legs'}   <=> $b->{'legs'} ||
          $a->{'animal'} cmp $b->{'animal'});
};

Но это скорее черная магия. Кажется, должно быть какое-то лучшее решение для этого. Но я не нашел и не понял пока нет.

11
задан Sinan Ünür 30 September 2010 в 01:29
поделиться