Can I call a superclass sort with a subclass compare in perl?

问题

I want to use a superclass sort which uses a subclass compare function. I've tried to distill the nature of the question in the following code. This isn't the "production" code, but is presented here for illustration. It's tested.

#!/usr/bin/perl
# $Id: foo,v 1.10 2019/02/23 14:14:33 bennett Exp bennett $

use strict;
use warnings;

package Fruit;
use Scalar::Util 'blessed';

sub new {
    my $class = shift;
    my $self = bless({}, $class);
    $self->{itemList} = [];
    warn "Called with class ", blessed $self, "\n";
    return $self;
}

package Apples;

use parent qw(-norequire Fruit);

sub mySort {
    my $self = shift;
    @{$self->{itemList}} = sort compare @{$self->{itemList}};
    return $self;
}

sub compare {
    $a->{mass} <=> $b->{mass};
}

package main;

my $apfel = Apples->new();
push(@{$apfel->{itemList}}, { "name" => "grannysmith", "mass" => 12 });
push(@{$apfel->{itemList}}, { "name" => "macintosh", "mass" => 6 });
push(@{$apfel->{itemList}}, { "name" => "Alkmene", "mass" => 8 });

$apfel->mySort();

for my $f (@{$apfel->{itemList}}) {
    printf("%s is %d\n", $f->{name}, $f->{mass});
}

exit 0;

What I want to do is to move mySort() to the abstract superclass Fruit. I've tried a number ways of addressing the $self->compare() subroutine, but I'm not having much luck.

Any thoughts?

I've gotten it to call the correct subroutine, but never with the correct $a and $b. I've left all of my failed attempts out of this question in the hopes that someone will know right away how to move the mySort() to the Fruit package so that I can sort my oranges with the same subroutine.

回答1:

You've got two problems. First, you need the mySort function in the super class to call the compare function for the correct subclass. Second, you need the compare function in the subclass to be able to receive the two elements it wants to compare from a call in a different package.

It's not clear whether you worked out a solution to the first problem, but one solution is to use UNIVERSAL::can to find out the right comparison method.

package Fruit;
sub mySort {
    my $self = shift;
    my $compare_func = $self->can("compare");
    @{$self->{itemList}} = sort $compare_func @{$self->{itemList}};
}

This will find the correct subclass compare function and use it in the sort call.

Now the issue in the Apples::compare function will be that when Fruit::mySort is ready to compare a couple of elements, it will set the package variables $Fruit::a and $Fruit::b, not $Apples::a and $Apples::b. So your Apples::compare function must be prepared for this. Here are a couple of solutions:

package Apples;
sub compare {
    package Fruit;
    $a->{mass} <=> $b->{mass};
}

sub compare {
    $Fruit::a->{mass} <=> $Fruit::b->{mass}
}

or more defensively,

package Apples;
sub compare {
    my $pkg = caller;
    if ($pkg ne __PACKAGE__) {
        no strict 'refs';
        $a = ${"${pkg}::a"};
        $b = ${"${pkg}::b"};
    }
    $a->{mass} <=> $b->{mass}
}

Update: I thought about making a subroutine attribute that would copy $a and $b values into the correct package, but after benchmarking it and thinking about alternatives, I decided against it. Here were my results for posterity:

Consider three sort routines (that might be in another package and hard to use from the current package)

sub numsort { $a <=> $b }
sub lexsort { $a cmp $b }
sub objsort { $a->{value} <=> $b->{value} }

Here are some ways we can make these packages accessible:

implement a subroutine attribute to prepare the $a and $b variables in the right package. Implementation is too long to include here, but the sub declaration would look like
```
sub numsort : CrossPkg { $a <=> $b }
```
rewrite the comparison function to compare $_[0] and $_[1] instead of $a and $b, and use a wrapper in the sort call
```
sub lexcmp { $_[0] cmp $_[1] }
...
@output = sort { lexcmp($a,$b) } @input
```
Perform the sort call in the correct package, so it sets the correct $a and $b values.
```
@output = do { package OtherPackage; sort numsort @input };
```

And here are the benchmarking results. The local method is the ordinary sort call with no cross-package issues.

                 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%            --

Summary: overhead is less of a concern with lexsort, where each comparison takes more time. The attribute approach is dead on arrival. Setting the package going into the sort call has the best results -- more or less no overhead -- but it isn't suitable for this application (in an object hierarchy). Rewriting the comparison function and wrapping the function in the sort call isn't too bad of a performance drop-off, and it works in an object hierarchy, so the final recommendation is:

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} }

回答2:

The punctuation variables such as $_^[1] are called "super-globals" because they refer to the variable in the main:: namespace.^[2] In other words, no matter what's the current package, $_ is short for $main::_.

$a and $b aren't super-globals. They are ordinary package variables. sort populates the $a and $b of the package in which the sort is found, which leads to problems if sort and the compare function are found in different packages. This means that moving mySort to Fruit:: will cause sort to populate $Fruit::a and $Fruit::b, but your compare function reads $Apple::a and $Apple::b.

There are a few solutions you could use when multiple packages are involved, but the simplest is to use the ($$) prototype on the compare function. This causes sort to pass the values to compare as arguments instead of using $a and $b.

package Foo;
my $compare = \&Bar::compare;
my @sorted = sort $compare @unsorted;

package Bar;
sub compare($$) { $_[0] cmp $_[1] }

sort calls the sub as a function, not a method. If you want it called as a method, you'll need a wrapper.

package Foo;
my @sorted = sort { Bar->compare($a, $b) } @unsorted;

package Bar;
sub compare { $_[1] cmp $_[2] }

That said, the idea of having sort in one class and the sorter in a sub class is fundamentally flawed. You can presumably have a list that contains both Apples and Oranges, so how can you determine which compare method to call?

package Foo;
my @sorted = sort { ???->compare($a, $b) } @unsorted;

package Bar;
sub compare { $_[1] cmp $_[2] }

And a few named ones too such as STDIN.
By using a fully-qualified name (e.g. $package::_), you can access the punctuation variables of other packages. These have no special meaning; they aren't used by Perl itself.

回答3:

The variables $a and $b are used by sort as package variables in the same package that sort was called, so in order for the child class to see them, you could try this.

In the parent class:

sub mySort {
    my $self = shift;
    @{$self->{itemList}} = sort { $self->compare($a, $b) } @{$self->{itemList}};
    return $self;
}

In the child class:

sub compare {
    my ( $self, $a, $b ) = @_;
    $a->{mass} <=> $b->{mass};
}

来源：https://stackoverflow.com/questions/54842607/can-i-call-a-superclass-sort-with-a-subclass-compare-in-perl

标签

perl

subclass

superclass

subroutine