У тебя две проблемы.Во-первых, вам нужна функция mySort в суперклассе, чтобы вызвать функцию compare для правильного подкласса.Во-вторых, вам нужна функция compare в подклассе, чтобы иметь возможность получать два элемента, которые она хочет сравнить, из вызова в другом пакете.
Неясно, разработали ли вы решение для первогопроблема, но одним из решений является использование UNIVERSAL::can, чтобы найти правильный метод сравнения.
package Fruit;
sub mySort {
my $self = shift;
my $compare_func = $self->can("compare");
@{$self->{itemList}} = sort $compare_func @{$self->{itemList}};
}
Это найдет правильную функцию подкласса compare и будет использовать ее в вызове сортировки.
Теперь проблема в функции Apples::compare заключается в том, что когда Fruit::mySort будет готов сравнить пару элементов, он установит переменные пакета $Fruit::a и $Fruit::b, а не $Apples::a и $Apples::b.Поэтому ваша Apples::compare функция должна быть готова к этому.Вот несколько решений:
package Apples;
sub compare {
package Fruit;
$a->{mass} <=> $b->{mass};
}
или
sub compare {
$Fruit::a->{mass} <=> $Fruit::b->{mass}
}
или более,
package Apples;
sub compare {
my $pkg = caller;
if ($pkg ne __PACKAGE__) {
no strict 'refs';
$a = ${"${pkg}::a"};
$b = ${"${pkg}::b"};
}
$a->{mass} <=> $b->{mass}
}
Обновление :Я думал о создании атрибута подпрограммы, который копировал бы значения $a и $b в правильный пакет, но после сравнения его и обдумывания альтернатив, я решил отказаться от него.Вот мои результаты для потомков:
Рассмотрим три процедуры сортировки (которые могут быть в другом пакете и которые трудно использовать из текущего пакета)
sub numsort { $a <=> $b }
sub lexsort { $a cmp $b }
sub objsort { $a->{value} <=> $b->{value} }
Вот несколько способов, которыми мы можем сделать этодоступные пакеты:
реализуют атрибут подпрограммы для подготовки переменных $a и $b в нужном пакете.Реализация здесь слишком длинная, чтобы включить ее, но под-объявление будет выглядеть так:
sub numsort : CrossPkg { $a <=> $b }
переписать функцию сравнения для сравнения $_[0] и $_[1] вместо $a и $b, и используйте обертку в вызове sort
sub lexcmp { $_[0] cmp $_[1] }
...
@output = sort { lexcmp($a,$b) } @input
Выполните вызов сортировки в правильном пакете, чтобы установить правильные значения $a и $b.
@output = do { package OtherPackage; sort numsort @input };
И вот результаты сравнительного анализа.local - это обычный вызов sort без проблем с несколькими пакетами.
Rate attrib-numsort wrap-numcmp local-numsort repkg-numsort
attrib-numsort 1.17/s -- -90% -96% -96%
wrap-numcmp 11.6/s 885% -- -61% -64%
local-numsort 29.5/s 2412% 155% -- -8%
repkg-numsort 32.2/s 2639% 178% 9% --
Rate attrib-lexsort repkg-lexsort wrap-lexcmp local-lexsort
attrib-lexsort 3.17/s -- -12% -14% -17%
repkg-lexsort 3.60/s 13% -- -2% -5%
wrap-lexcmp 3.68/s 16% 2% -- -3%
local-lexsort 3.80/s 20% 6% 3% --
Rate attrib-objsort wrap-objcmp local-objsort repkg-objsort
attrib-objsort 1.22/s -- -81% -88% -89%
wrap-objcmp 6.32/s 417% -- -38% -44%
local-objsort 10.1/s 730% 61% -- -10%
repkg-objsort 11.3/s 824% 79% 11% --
Сводка : издержки менее важны для lexsort, где каждое сравнениезанимает больше времениАтрибутный подход мертв по прибытии.Установка пакета, входящего в вызов sort, дает наилучшие результаты - более или менее без дополнительных затрат - но он не подходит для этого приложения (в иерархии объектов).Переписать функцию сравнения и включить функцию в вызов sort не так уж плохо для снижения производительности, и она работает в иерархии объектов, поэтому окончательная рекомендация:
package Fruit;
sub compare { ... }
sub mySort {
my $self = shift;
@{$self->{itemList}} =
sort { $self->can("compare")->($a,$b) } @{$self->{itemList}};
}
package Apples;
our @ISA = qw(Fruit)
sub compare { $_[0]->{mass} <=> $_[1]->{mass} }