Наследование констант с помощью встроенных пакетов

Question

OK. У меня проблема при попытке наследовать константы, установленные в родительском классе, для любого из дочерних классов.

#!/usr/bin/perl
use strict;
use warnings;

package Car;
use Exporter qw( import );
our @EXPORT_OK = ( 'WHEELS', 'WINGS' );

use constant WHEELS => 4;
use constant WINGS  => 0;

sub new {
    my ( $class, %args ) = @_;
    my $self = {
        doors  => $args{doors},
        colour => $args{colour},
        wheels => WHEELS,
        wings  => WINGS,
    };
    bless $self, $class;
    return $self;
}

package Car::Sports;
use base qw( Car );

sub new {
    my ( $class, %args ) = @_;
    my $self = {
        doors  => $args{doors},
        engine => $args{engine},
        wheels => WHEELS,
        wings  => WINGS,
    };
    bless $self, $class;
    return $self;
}

package main;
my $obj = Car->new( doors => 4, colour => "red" );
print Dumper $obj;

my $obj2 = Car::Sports->new( doors => 5, engine => "V8" );

print Dumper $obj2;
__END__

Ошибка:

Bareword "WHEELS" not allowed while "strict subs" in use at ./t.pl line 30.
Bareword "WINGS" not allowed while "strict subs" in use at ./t.pl line 30.
Execution of ./t.pl aborted due to compilation errors.

Теперь, я не пришел сюда, чтобы отправлять сообщения без каких-либо исследований. Я понимаю, что одним из вариантов будет use Car qw( WHEELS WINGS) в Car::Sports. Однако, если я это сделаю, я получу следующую ошибку, потому что все классы встроены в одном файле:

Can't locate Car.pm in @INC 

По разным причинам мне нужно хранить свои пакеты в одном файле. Это можно обойти? Поскольку константы, в основном, являются только подпрограммами, почему я должен импортировать их, если то же самое не будет верно для обычного метода?

Наконец, я также знаю, что могу сделать это:

package Car::Sports;
use base qw( Car );

sub new {
    my ( $class, %args ) = @_;
    my $self = {
        doors  => $args{doors},
        engine => $args{engine},
        wheels => Car::WHEELS,
        wings  => Car::WINGS,
    };
    bless $self, $class;
    return $self;
}

И это нормально ... Но у меня есть несколько классов, и я хочу сделать наследование констант более общим, чем необходимость явно указывать родительский класс (а иногда это не просто родительский класс, а дедушка).

Большое спасибо заранее за любые указатели!

Приветствия

Answer 1

Один обходной путь - включить строку

package Car::Sports;
use base qw( Car );
<b>Car->import(qw(WHEELS WINGS));</b>

И используйте символы в конструкторе Car::Sports:

...
wheels => &WHEELS,
wings  => &WINGS,
...

Ваш класс Car не определяет свой список @EXPORTS_OK до времени выполнения. Сигилы необходимы, потому что конструктор Car::Sports анализируется во время компиляции, и компилятор не знает, что в пространстве имен Car::Sports должны быть символы WHEELS и WINGS.

---

Единственный способ избежать сигил - это определить экспорт Car во время компиляции:

package Car;
our @EXPORT_OK;
BEGIN {@EXPORT_OK = qw(WHEELS WINGS)} # set at compile not run time
...

package Car::Sports;
use base qw(Car);
BEGIN {Car->import('WHEELS','WINGS')} # import before c'tor is parsed

---

Вы также можете избежать этих махинаций, определив класс Car в своем собственном файле Car.pm. Тогда вы просто скажете

use Car qw(WHEELS WINGS);

и все в файле Car.pm будет проанализировано во время компиляции, а метод Exporter::import (вызванный вызовом Car::import) автоматически запустится и импортирует нужные символы в ваше текущее пространство имен.

Answer 2

Альтернатива, вы можете сделать именно то, что делает use:

BEGIN {
    package Car;
    use Exporter qw( import );
    @EXPORT_OK = qw( WHEELS );

    ...

    $INC{'Car.pm'} = 1;
}

BEGIN {
    package Car::Sports;

    use Car qw( WHEELS );
    @ISA = 'Car';

    ...

    $INC{'Car/Sports.pm'} = 1;
}

Answer 3

Может ли это изменение удовлетворить ваши потребности?

    [...]
    wheels => $class->SUPER::WHEELS,
    wings  => $class->SUPER::WINGS,
    [...]

Используя Data :: Dumper, вы получите:

$VAR1 = bless( {
             'wings' => 0,
             'colour' => 'red',
             'doors' => 4,
             'wheels' => 4
           }, 'Car' );
$VAR1 = bless( {
             'wings' => 0,
             'engine' => 'V8',
             'doors' => 5,
             'wheels' => 4
           }, 'Car::Sports' );

Answer 4

Как правило, показывать, что что-то является константой для любого пакета, кроме того, который определяет его, на самом деле плохая идея. Это, среди прочего, противоречит использованию необычных форм при обращении к значениям, которые оказываются постоянными в других областях вашего кода.

Модуль constant на самом деле поддерживает форму вызова, которая скрывает тот факт, что мы говорим о константах, поскольку они вызывают вызов констант, поскольку методы класса работают просто отлично:

package Car;
use constant default_wheel_count => 4;

package Car::Sports;

sub new {
    my ($class) = @_;

    return bless {
        wheels => $class->default_wheel_count,
    } => $class;
}

Вот как на самом деле наследуют константы, но это, вероятно, неправильный подход. Ликвидация копипаст только путем использования констант из классов, которые реализуют конструкцию этих атрибутов, является действительно правильным решением.