Перейти к содержанию

Некоторые сведения о Perl 5

Добавить ссылки
Материал из Викиучебника — открытых книг для открытого мира

Пакеты, библиотеки и модули

Объектно-ориентированное программирование в Perl

Работа со строками и регулярные выражения

В языке Perl 5 нет специального синтаксиса для описания классов (до версии 5.38). Для их реализации используются существующие синтаксические конструкции.

Класс в Perl представляет собой пакет, а функции в пакете представляют его методы. Таблица символов класса представляет его содержимое — список полей и методов.

Объект в Perl — это ссылка на экземпляр класса, которая строится с помощью специальной функции класса — конструктора. Функция ref() возвращает для ссылки на объект не стандартный идентификатор типа SCALAR, ARRAY и др., а возвращает имя класса, к которому принадлежит объект[1].

В общих чертах, конструктор любого класса для конструирования ссылки на объект должен вызывать функцию 

bless <ссылка> [, <имя-класса>]

которая «благословляет» (англ. to bless — благословлять) ссылку на то, чтобы принадлежать к классу, указанному вторым аргументом. Если имя класса опущено, то используется имя текущего пакета. Именно ссылка, возвращаемая этим методом, должна возвращаться из конструктора. После того как объект построен, к нему можно обращаться через квалифицированное имя $<имя-класса>::<ссылка>.

Наследование в Perl еще сильнее отличается от того, что есть в других языках программирования. В Perl наследуются только методы. Наследование данных реализует сам программист. Наследование методов реализовано так: с каждым пакетом ассоциирован свой массив @ISA, в котором хранится список базовых классов пакета. Если внутри класса вызывается метод, которого нет в текущем классе, то интерпретатор в поисках метода просматривает по порядку методы каждого класса массива @ISA. Затем просматривается предопределенный класс UNIVERSAL. Если и после этого метод не был найден, то классы снова просматриваются в том же порядке в поисках процедуры AUTOLOAD. Если такая находится, то вызывается она вместо отсутствующего метода. В эту процедуру будут переданы все параметры, а в переменной $AUTOLOAD будет хранится имя вызываемого метода.

Объявление класса

[править]

Конструктор

[править]

Конструктор класса является простой функцией пакета. Она может иметь любое имя, но на практике обычно используют идентификатор new, как устоявшееся имя для любого конструктора.

Самый простой конструктор имеет следующий вид: 

package MyClass;

sub new {
    my $class = shift;   # Передаем конструктору имя класса
    my $self = {};       # Конструируем ссылку
    bless $self, $class; # Конструируем объект
    return $self;        # Возвращаем ссылку
}

# ---------------------------------------------
package main;

# Конструируем объект
$object = MyClass::new("MyClass");

Для примера мы объявляем класс и конструируем его экземпляр в одном исходном файле. Здесь мы это делаем только для демонстрации: на практике классы следует объявлять в отдельных исходных файлах и подключать их через функцию use(). Имя ссылки $self является устоявшимся, и мы настоятельно рекомендуем использовать ее в своих проектах.

Данный пример демонстрирует пустой бесполезный класс, в котором нет полей, так как мы конструируем объект из ссылки на пустой хеш. На практике обычно в конструктор передается массив или другой хеш, которым инициализируется ссылка $self. В общем случае не обязательно использовать именно хеш, но его преимущество в том, что мы можем использовать произвольные ключи. Также мы можем передавать массив значений, которыми затем мы можем инициализировать анонимный хеш. Другими словами, подходы здесь могут быть самые разные.

На практике конструктор класса обычно имеет следующий вид: 

sub new {
    # Предполагается, что $init это ссылка на структуру с инициирующими данными
    my ( $class, $init ) = @_;
    $class = ref( $class ) || $class;    # Чтобы иметь возможность взять имя по ссылке.
    # Примечание: если имя класса не будет передано, будет взято имя ближайшего пространства имен.
    my $self = {};
    bless $self, $class;
    # ... Код инициализирующий поля в ссылке $self через $init ...
    # ...
    return $self;
}

Деструктор

[править]

Когда ссылка на объект выходит из зоны видимости, она удаляется по нулевому счетчику ссылок. Программист может контролировать действия, которые исполнятся перед очисткой ссылки, через деструктор объекта. Деструктор объекта нужен, чтобы корректно завершить жизненный цикл объекта, например, закрыть открытые объектом файловые дескрипторы. Деструктор всегда вызывается автоматически.

Деструктор всегда должен быть объявлен внутри класса и всегда должен иметь имя DESTROY. Также деструктор должен принимать аргумент в виде ссылки на удаляемый объект.

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

Ниже приведен простой пример деструктора. 

package MyClass;

sub new {
    my $class = shift;   # Передаем конструктору имя класса
    my $self = {};       # Конструируем ссылку
    bless $self, $class; # Конструируем объект
    return $self;        # Возвращаем ссылку
}

sub DESTROY {
    my $name = ref($_[0]);
    print "Call destructor to delete an instance of " . $name . " class\n";
}

# ---------------------------------------------
package main;
{
    my $object = MyClass::new("MyClass");
} # Деструктор объекта в блоке вызывается в этой точке.

$object = MyClass::new("MyClass");
# Деструктор объекта, созданного в области видимости пакета main удаляется перед завершением программы.

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

Call destructor to delete an instance of MyClass class   
Call destructor to delete an instance of MyClass class

Другие методы

[править]

Методы в Perl могут вызываться от имени конкретного объекта или от имени всего класса. В последнем случае такие методы называются статическими. Статическому методу в первом аргументе всегда передается имя класса, а не статическому — ссылка на объект. Типичным примером статического класса является конструктор (именно поэтому мы ожидаем в первом аргументе имя класса).

В Perl методы выполняются в пространстве имен того пакета, в котором они были определены, а не в том, в котором они вызываются. Именно поэтому многие статические методы игнорируют свой первый аргумент.

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

package Person;

$classCounter = 0;

# Конструктор
sub new {
    my ($class, $data) = @_;   # Передаем конструктору имя класса вместе с ссылкой на структуру
    my $self = $data;
    bless $self, $class;       # Конструируем класс
    $classCounter++;
    return $self;        
}

# Деструктор
sub DESTROY {
    my $name = ref($_[0]);
    print "Call destructor to delete an instance of " . $name . " class:\n";
    while ( my($k,$v) = each %{$_[0]} ) {
        print "\t$k => $v\n";
    }
    $classCounter--;
}

# Простой сеттер, устанавливающий имя персоны
sub setName {
    my ($self, $data) = @_;
    $self->{'name'} = $data;
    return $self;
}

# Простой геттер, возвращающий поле 'name'
sub getName {
    my $self = shift;
    return $self->{'name'};
}

sub setSurname {
    my ($self, $data) = @_;
    $self->{'surname'} = $data;
    return $self;
}

sub getSurname {
    my $self = shift;
    return $self->{'surname'};
}

# Данный метод может вызываться как статический.
sub show {
    my $self = shift;
    my @keys = @_ ? @_ : sort keys %$self;
    foreach $key (@keys) {
        print "\t$key => $self->{$key}\n";
    }
    return $self;
}

# Чисто статический метод
sub count {
    my $class = shift;
    print "Counter of $class: $classCounter\n";
}

# ---------------------------------------------
package main;

# Конструируем два объекта
$person1 = Person::new(Person, {name => 'Larry', surname => 'Wall'});
$person2 = Person::new(Person, {});

print "-- 1 --\n";
$person1->show();                # вызов метода
print "-- 2 --\n";
$person1->show('name');          # печатаем одно поле структуры
$person1->setName('Garry');      # меняем поле структуры
print "-- 3 --\n";
Person::show($person1);          # вызываем статический метод
print "-- 4 --\n";
$person1->count();               # вызываем метод, считающий объекты
Person::count();
Person::count('Person');
print "-- 5 --\n";
$person2->setName('Homer');      # вызываем сеттеры
$person2->setSurname('Simpson');
$person2->show();
print "-- 6 --\n";
print STDOUT $person1->getName(), "\n";  # вызываем геттер
print "-- 7 --\n";
# строим объект, чтобы увеличить счетчик
{
    local $person1 = Person::new(Person, {});
    Person::count('Person');   # 3
}
Person::count('Person'); # 2

Результат работы программы 

-- 1 --
        name => Larry
        surname => Wall
-- 2 --
        name => Larry
-- 3 --
        name => Garry
        surname => Wall
-- 4 --
Counter of Person=HASH(0x55cc685f3470): 2   # Статический метод, вызванный от имени объекта
Counter of : 2                              # Без аргумента метод ведет себя как статический
Counter of Person: 2
-- 5 --
        name => Homer
        surname => Simpson
-- 6 --
Garry
-- 7 --
Counter of Person: 3                         # Нарастили счетчик ссылок
Call destructor to delete an instance of Person class:
Counter of Person: 2                         # Объект был удален - счетчик уменьшился
Call destructor to delete an instance of Person class:
        surname => Wall
        name => Garry
Call destructor to delete an instance of Person class:
        surname => Simpson
        name => Home

Методы класса можно вызывать двумя способами. Первый способ имеет вид 

<имя-метода> <имя-класса-или-объект>, <параметры>;

print "-- 1 --\n";
$person = Person::new 'Person', {name => "Larry", surname => 'Wall'};
Person::show $person, 'name', 'surname';
print "-- 2 --\n";
# В общем случае метод может распечатать любую ссылку
Person::show {name => 'Dennis', surname => 'Ritchie', born => '1941'};
print "-- 3 --\n";
Person::show Person::new 'Person', {name => 'Dennis', surname => 'Ritchie', born => '1941'};
print "-- 4 --\n";
print STDOUT Person::getSurname Person::new 'Person', {name => 'Dennis', surname => 'Ritchie', born => '1941'};

-- 1 --
        name => Larry
        surname => Wall
-- 2 --
        born => 1941
        name => Dennis
        surname => Ritchie
-- 3 --
        born => 1941
        name => Dennis
        surname => Ritchie
Call destructor to delete an instance of Person class:
        surname => Ritchie
        born => 1941
        name => Dennis
-- 4 --
RitchieCall destructor to delete an instance of Person class:
        name => Dennis
        surname => Ritchie
        born => 1941
Call destructor to delete an instance of Person class:
        surname => Wall
        name => Larry

Данная форма представляет собой вызов функции, вложенный в другой вызов.

Второй формой мы пользовались в самом первом примере этого раздела: 

<класс-или-объект>-><метод>(<параметры>)

$person = Person->new({name => 'Larry', surname => 'Wall', born => '1954'});
print "-- 1 --\n";
$person->show('name', 'born');
print "-- 2 --\n";
Person->new({name => 'Larry', surname => 'Wall', born => '1954'})->show('name', 'surname');

-- 1 --
        name => Larry
        born => 1954
-- 2 --
        name => Larry
        surname => Wall
Call destructor to delete an instance of Person class:
        name => Larry
        born => 1954
        surname => Wall
Call destructor to delete an instance of Person class:
        name => Larry
        born => 1954
        surname => Wall

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

На практике, особенно для такого языка, как Perl, расточительно создавать полный набор геттеров и сеттеров. В большинстве случаев достаточно написать универсальный сеттер, либо объединить геттер и сеттер одного поля в одном методе: 

package Class;

use strict;

sub new {
    my $self = {};
    bless $self;
    return $self;
}

sub name {
    my ($self, $value) = @_;
    return $self->{'name'} = $value if defined $value;
    return $self->{'name'} || "";
}

# ---------------------------------------------

package main;

my $obj = Class->new;
$obj->name("Larry");
print $obj->name, "\n";

Наследование

[править]

Для реализации механизма наследования в Perl используется специальный массив @ISA, в который помещаются родительские классы слева направо от ближайшего к дальнему предку. Если интерпретатор встречает вызов метода, которого нет в данном классе, то он сначала пройдется по классам из @ISA в поисках метода.

Если вам нужно вызвать метод родительского класса из дочернего класса, вы можете воспользоваться квалифицированным вызовом метода. Если вам нужен метод ближайшего предка, вы можете использовать имя псевдокласса SUPER (но только из методов потомка). 

package Parent;

sub new {
    my ($class, $data) = @_;
    my $self = $data;
    bless $self, $class;
    return $self;
}

sub DESTROY {
    print "Call destructor to delete an instance of 'Parent' class\n";
}

sub set {
    my ($self, $data) = @_;
    for $i (keys %$data) {
        $self->{$i} = $data->{$i};
    }
    return $self;
}

sub show {
    my $self = shift;
    my @keys = @_ ? @_ : sort keys %$self;
    print "Parent:\n";
    foreach $key (@keys) {
        print "\t$key => $self->{$key}\n";
    }
    return $self;
}

sub AUTOLOAD {
    print "Package " . __PACKAGE__ . ": there is not '$AUTOLOAD' method\n";
}

package Child;

@ISA = (Parent);

sub new {
    my ($class, $data) = @_;
    my $self = Parent->new($data);
    $self->{"born"} = 0;
    bless $self, $class;
    return $self;
}

sub DESTROY {
    my $self = shift;
    print "Call destructor to delete an instance of '" . ref($self) . "' class\n";
    # Вызываем деструктор родительского класса
    $self->SUPER::DESTROY;
}

# Переопределяем метод
sub show {
    my $self = shift;
    print "Child:\n";
    $self->SUPER::show();
    return $self;
}

package main;

$person = Child->new({name => 'Larry', surname => 'Wall'});
print "-- 1 --\n";
$person->show();
print "-- 2 --\n";
$person->set({born => 1954});
$person->show();
print "-- 3 --\n";
$person->Parent::show();
print "-- 4 --\n";
$person->undefinedMethod;

-- 1 --
Child:
Parent:
        born => 0
        name => Larry
        surname => Wall
-- 2 --
Child:
Parent:
        born => 1954
        name => Larry
        surname => Wall
-- 3 --
Parent:
        born => 1954
        name => Larry
        surname => Wall
-- 4 --
Package Parent: there is not 'Child::undefinedMethod' method
Call destructor to delete an instance of 'Child' class
Call destructor to delete an instance of 'Parent' class

В данном примере мы имеем два класса Parent и Child. Родительский класс объявляет два метода: метод Parent::set() нужен, чтобы устанавливать поля структуры класса; метод Parent::show() распечатывает все поля структуры класса.

Дочерний класс наследует метод Parent::set(), поэтому мы можем вызывать его без квалификатора типа, и переопределяет метод Parent::show(). Также дочерний класс в своем конструкторе вводит поле born, которое по умолчанию инициализируется нулевым значением.

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

В последнем операторе мы пытаемся вызывать несуществующий метод из объекта дочернего класса. Так как в родительском классе объявлен метод AUTOLOAD, то будет вызван именно он.

Использование таблицы символов для генерации методов на ходу

[править]

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

Внимательно изучите следующий пример. 

package Person;

sub new {
    my ($class, $params) = @_;
    my $self = {};
    # В этом цикле мы генерируем методы через псевдонимы и анонимные функции.
    # Геттеры и сеттеры генерируются каждый раз при вызове конструктора, что является недостатком подхода.
    # Чтобы исправить недостаток, нужно добавить проверку на существование метода, но в этом примере мы это опустим.
    # Для геттеров используются имена get_<имя-поля>, а для сеттеров – set_<имя-поля>.
    for my $key (sort keys %$params) {
        *{__PACKAGE__ . '::' . "get_$key"} = sub {
            my $self = shift;
            return $self->{$key};
        };
        *{__PACKAGE__ . '::' . "set_$key"} = sub {
            my ($self, $data) = @_;
            $self->{$key} = $data;
            return $self;
        };
        $self->{$key} = $params->{$key};
    }
    bless $self, $class;
    return $self;
}

package main;

$person = Person->new({name => 'Larry', surname => 'Wall'});
print $person->get_name() . " " . $person->get_surname, "\n";
$person->set_name('Garry');
print $person->get_name() . " " . $person->get_surname, "\n";

Larry Wall
Garry Wall

В примере выше мы генерируем как будто бы пустой класс. На самом деле он генерирует свои методы на ходу, а именно при вызове конструктора. Для этого он для каждого поля хеша, передаваемого в конструктор, генерирует анонимную функцию, к которой можно обращаться по ссылке. Для геттеров имя ссылки будет get_<имя-поля>, а для сеттеров — set_<имя-поля>.

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

Шаблон модуля, несущего в себе класс

[править]
package MyClass;

use strict;                              # Для чистоты кода

require Exporter;                        # Для функции import()
our @ISA = qw{ Exporter };               # Добавьте родительские классы, если нужно
our @EXPORT = qw{ new method1 method2 }; # Добавьте публичные методы класса

sub new {
    my ($class, $data) = @_;
    my $self = $data;
    bless $self, $class;
    return $self;
}

sub method1 {
    my ($self, $data) = @_;
    # ...
}

sub method2 {
    my $self = shift;
    my $data = shift;
    # Примечание: shift возвращает очередной аргумент и сдвигает строку аргументов налево
    # ...
}

sub private {
    my $self = shift;
    # ...
}

1;
__END__

Документация

Пакет UNIVERSAL

[править]

Все классы в @ISA наследуют пакет с именем UNIVERSAL, который предоставляет несколько методов, реализующих рефлексию классов в Perl. Его можно сравнить с классом Object в языке Java, но UNIVERSAL устроен намного проще.

Пакет UNIVERSAL объявляет всего 4 метода, которыми модули могут пользоваться для исследования возможностей текущего программного окружения.

Метод VERSION

[править]

Возвращает значение переменной $VERSION пакета (модуля). Переменная $VERSION может быть объявлена непосредственно в пакете, но рекомендуется инициализировать её в директиве package, так как это более наглядно. 

package SomePackage 1.0;
# Пакет версии 1.0

sub new {
    my $self = {};
    bless $self;
    return $self;
}

#------------------------------------------------------------------
package main;

print "SomePackage version: " . SomePackage->VERSION, "\n";
my $obj = SomePackage->new;

# Номер версии можно вернуть и из экземпляра.
print "SomePackage version: " . $obj->VERSION, "\n";

SomePackage version: 1.0
SomePackage version: 1.0

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

package SomePackage 1.0;
# Пакет версии 1.0 ...

sub new {
    my $self = {};
    bless $self;
    return $self;
}

#------------------------------------------------------------------
package main;

my $obj = SomePackage->new;

eval {
    # ... но запрашиваем 2.0
    $obj->VERSION(2.0);
};
print $@ if $@;

SomePackage version 2 required--this is only version 1.0 at .\universal.pl line 18.

Метод DOES

[править]

Проверяет, есть ли в цепочке наследования текущего класса класс с именем, передаваемом в аргументе. Если есть, то возвращает ИСТИНУ, иначе ЛОЖЬ. 

package Parent;

# ...

package Child;

use parent qw{Parent};

sub new {
    my $self = {};
    bless $self;
    return $self;
}

package main;

print "The Child inherits the Parent\n" if Child->DOES('Parent');
print "The Child does not inherit the AnotherClass\n" unless Child->DOES('AnotherClass');

my $obj = Child->new;
print "The Child inherits the Parent\n" if $obj->DOES('Parent');

The Child inherits the Parent
The Child does not inherit the AnotherClass
The Child inherits the Parent

Метод can

[править]

Проверяет, существует ли метод с указанным именем в цепочке наследования или нет. Если метод существует, то метод возвращает ссылку на него, иначе возвращается ЛОЖЬ. 

package Parent;

# ...

sub parentMethod {
    print "Parent method\n";
}

package Child;

use parent qw{Parent};

sub new {
    my $self = {};
    bless $self;
    return $self;
}

sub childMethod {
    print "Child method\n";
}

package main;

print "The Parent has 'parentMethod'\n" if ref Parent->can('parentMethod') eq 'CODE';

my $obj = Child->new;
print "The Child has 'parentMethod'\n" if ref $obj->can('parentMethod') eq 'CODE';

# Получаемый метод можно вызвать, но нужно передать экземпляр класса в первом аргументе.
$obj->can('childMethod')->($obj);

The Parent has 'parentMethod'
The Child has 'parentMethod'
Child method

Метод isa

[править]

По умолчанию isa и DOES работают абсолютно одинаково, однако метод isa задумывался, чтобы проверить утверждение инстанцирована ли ссылка от переданного в аргументе класса ИЛИ этот класс есть в цепочке наследования[2], а DOES призвана определить, может ли этот класс выполнять данный класс задач. Некоторые CPAN модули переопределяют внутри себя DOES, поэтому он может возвращать отличные от isa ответы.

Подведение итогов

[править]

Описанный выше подход к ООП не является единственным. Существуют модули CPAN, которые пытаются улучшить эту систему, обогащая описанные выше скудные конструкции (например, модуль Moose). Такие модули, как правило, используются в больших проектах.

Однако, как бы там ни было, CPAN модули могут требовать загрузки множества зависимостей и могут замедлять скорость исполнения программы из-за своей внутренней реализации. В маленьких проектах достаточно встроенного в Perl ООП.

Perl 5.38: class или попытка сдвинуться с мёртвой точки

[править]

Очень долго тема ООП в Perl стояла на месте, но с версии 5.38 разработчики интерпретатора решили сделать новый шаг в этом направлении и ввели новое ключевое слово в язык — class. Дело в том, что у старого подхода есть много недостатков, что не позволительно для ООП парадигмы, в частности:

  • По сути у классов нет понятия поля класса, а то что есть не обладает полноценной инкапсуляцией. Кроме того, никак не реализуется наследование полей в дочерние классы. Все эти моменты идут на откуп программисту, который, конечно, в этом разберётся, но вероятно напишет не очень понятный код.
  • Методы класса внешне не выглядят инкапсулировано: не запрещено разбросать их по пакетам, пользуясь уловками интерпретации, а также никакой приватности реализовать в них нельзя. Кроме того, нужно всегда помнить, что в первый аргумент любого метода передаётся ссылка на объект, что вынуждает писать одинаковую первую строку для всех методов, что очень утомляет (сравните с автоматической ссылкой this в C++).

Реализация class на момент 2025 года ещё относительно сырая и ей стоит пользоваться осторожно, но можно потихоньку присматриваться. Если вы хотите использовать эту возможность, то обновите интерпретатор минимум до версии 5.40, потому что первые реализации имеют достаточно серьезные ошибки.

Объявление класса

[править]

Так как на момент версии 5.40 возможность является экспериментальной, её нужно включать так: 

use feature 'class';
# Отключает предупреждения об экспериментальной возможности, которые засоряют вывод.
no warnings 'experimental::class';

В синтаксисе чувствуется, что разработчики вдохновлялись языком C++, так как синтаксис очень похож: 

class <имя> <версия> [: <атрибуты-наследования>] [{ <блок-класса> }]

# Также класс может быть объявлен, но не определен.
class <имя> [<версия>];

Внутренне слово class работает как package, но дополнительно оно генерирует конструктор по умолчанию для пакета. Номер версии для класса используется, когда используется наследование и у класса есть несколько реализаций, чтобы не сломать обратную совместимость. Номер версии может быть опущен, если атрибуты наследования не используются.

Для class было введено слово __CLASS__, которое автоматически разворачивается в имя класса в пределах его определения. Им следует пользоваться для манипуляций с элементами класса, если они происходят до инстанцирования объекта.

Вот примеры объявления класса Person: 

class Person 1.000 {
    # ...
}

class WithoutVersion {
    # ...
}

# Объявление класса
class Empty;

Поля класса

[править]

Чтобы объявить поле в классе, используется ключевое слово field. Это ключевое слово инкапсулирует поле в классе и гарантирует, что каждый инстанцированный объект класса получит свой набор полей в памяти программы. Полный синтаксис поля такой: 

class ClassName {
   field <переменная> [: <атрибуты>] [= <выражение-вычисляющее-инициализирующее-значение>];
}

Например, 

class Person 1.000 {
    field $name = "Larry";
    field $surname = "Wall";
    field $born;
}

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

Методы класса

[править]

Чтобы объявить метод, используется ключевое слово method. Методы уже становятся очень похожими на методы языка C++, в частности вы можете обращаться к полям класса не используя ссылку на объект. С помощью ключевого слова можно объявлять удобные сигнатуры: 

class ClassName {
    method [<имя-метода>] [<сигнатура-метода>] { <блок-метода> }
}

Сигнатуры в новой реализации поддерживают значения по умолчанию. Внутри методов вы можете обращаться к экземпляру объекта по ссылке $self.

Ниже представлены примеры. 

use feature 'class';
no warnings 'experimental::class';

class Person 1.000 {
    field $name = "Larry";
    field $surname = "Wall";
    field $born;

    method printAsString {
        print __CLASS__ . ":"
            . " Name: " . $name
            . ", Surname: " . $surname
            . ", Born: " . $born
            . "\n"
        ;
    }

    # Метод с сигнатурой
    method setBorn($value = "unknown") {
        $born = $value;
    }

    # Метод, возвращающий анонимый метод.
    method jsonBuilder {
        return method {
            use JSON::PP;
            my $obj = {
                name => $name,
                surname => $surname,
                born => $born,
            };
            return JSON::PP->new->ascii->pretty->allow_nonref->encode($obj);
        };
    }

    method asJson {
        #
        # В этой системе пока еще не все идеально: анонимным методам нужно
        # ссылку на объект передавать вручную.
        # 
        return $self->jsonBuilder->($self);
    } 
}

my $o = Person->new;
$o->printAsString;
$o->setBorn("27.09.1954");
$o->printAsString;

print $o->asJson, "\n";

Person: Name: Larry, Surname: Wall, Born: 
Person: Name: Larry, Surname: Wall, Born: 27.09.1954
{
   "name" : "Larry",
   "surname" : "Wall",
   "born" : "27.09.1954"
}

Атрибуты

[править]

Атрибуты призваны для установки правил видимости и доступа к различным частям класса как внутри него самого, так и из классов-потомков. В документации говорится, что атрибуты будут:

  • у класса;
  • у полей класса;
  • у методов (но на момент 5.40 ни одного атрибута для методов ещё не реализовано).

Атрибуты класса

[править]

У класса на момент 5.40 поддерживаются следующие атрибуты:

  • :isa — атрибут устанавливает отношение между классами типа родитель-потомок. В атрибуте вписывается имя класса родителя и опционально минимальная необходимая версия этого класса (если фактическая версия родителя меньше запрашиваемого, исполнение прерывается). Так как у полей всегда лексическая видимость, эта система умеет реализовывать только приватное наследование полей в терминах языка C++. Если класс ещё не был загружен в пространство текущего пакета, неявно вызывается процедура require.
    class Parent 2.0 {
    field $some_field = "Hello, World!";

    method hello {
        print $some_field, "\n";
    }

    method getField {
        return $some_field;
    }
}

class Child :isa(Parent) {
    method child_method {
        print "Child: ";
        $self->SUPER::hello();

        # НЕЛЬЗЯ: приватное наследование.
        #print $some_field, "\n";

        # Доступ к полям родителя можно получить
        # только через методы.
        print "some_field: " . $self->SUPER::getField . "\n";
    }
}

my $o = Child->new;
$o->child_method;

# Сработает защита, так как версия родителя меньше запрашиваемой.
class AnotherChild :isa(Parent 3.0) {
    # ...
}

Атрибуты полей

[править]

У полей на момент 5.40 поддерживаются следующие атрибуты:

  • :param — указывает на то, что начальное значение для этого поля берется из именованного параметра конструктора. По умолчанию, именованный параметр конструктора и имя поля совпадают, но в параметрах атрибута можно указать другое имя, если так удобно или того требует ситуация. Вы можете оставить выражение, которое присваивает значение по умолчанию, но если его нет, значение всегда должно присваиваться через конструктор.
    class ModernPerson {

    field $name :param(person_name);
    field $surname :param;
    field $born :param = "unknown";

    method printAsString {
        print __CLASS__ . ":"
            . " Name: " . $name
            . ", Surname: " . $surname
            . ", Born: " . $born
            . "\n"
        ;
    }

}

my $o1 = ModernPerson->new(person_name => "Larry", surname => "Wall");
my $o2 = ModernPerson->new(person_name => "Larry", surname => "Wall", born => "27.09.1954");

$o1->printAsString;
# ModernPerson: Name: Larry, Surname: Wall, Born: unknown

$o2->printAsString;
# ModernPerson: Name: Larry, Surname: Wall, Born: 27.09.1954
  • :reader — генерирует для поля геттер. По умолчанию имя геттера совпадает с именем поля, но в параметре атрибута можно указать другое имя.
    class ModernPerson {

    field $name :param(person_name) :reader(get_name);
    field $surname :param :reader;
    field $born :param = "unknown";
}

my $o = ModernPerson->new(person_name => "Larry", surname => "Wall", born => "27.09.1954");
print $o->get_name . " " . $o->surname, "\n";

Жизненный цикл объекта класса

[править]

Так как class это по сути замаскированный package, то всё что было сказано ранее в классическом подходе Perl к ООП справедливо и здесь в отношении жизненного цикла. Правда есть одно отличие: для class был добавлен специальный именованный блок ADJUST, который семантически очень похож на BEGIN, но из него вам доступна ссылка на инстанцированный экземпляр класса, т.е. этот блок выполняется сразу за конструктором при конструировании каждого нового объекта. Вы можете указать сколько угодно таких блоков и они будут выполняться в порядке появления. Ниже показаны этапы жизненного цикла на конкретном примере. 

class First {
    ADJUST {
        print 'Parent ADJUST 1 of ' . ref $self, "\n";
    }
    ADJUST {
        print 'Parent ADJUST 2 of ' . ref $self, "\n";
    }
    sub DESTROY {
        my $self = shift;
        print "Called parent destructor for an instance of " . ref $self, "\n";
    }
}

class Second :isa(First) {
    ADJUST {
        print 'ADJUST 1 of ' . ref $self, "\n";
    }
    ADJUST {
        print 'ADJUST 2 of ' . ref $self, "\n";
    }

    sub DESTROY {
        my $self = shift;
        $self->SUPER::DESTROY;
        print "Called destructor for an instance of " . ref $self, "\n";
    }
}

{
    my $o = First->new;
}
print "--------------------------------------------\n";
{
    my $o = Second->new;
}

Parent ADJUST 1 of First
Parent ADJUST 2 of First
Called parent destructor for an instance of First
--------------------------------------------
Parent ADJUST 1 of Second
Parent ADJUST 2 of Second
ADJUST 1 of Second
ADJUST 2 of Second
Called parent destructor for an instance of Second
Called destructor for an instance of Second

Мы можем видеть, что при наследовании конструкторы и блоки ADJUST вызываются автоматически в порядке от родителя к потомку. Как и раньше, для деструкторов мы должны закладывать вызов деструктора родителя в деструкторе потомка .

Перегрузка операций классов

[править]

В этом разделе мы разберем одну из центральных функций ООП в Perl — перегрузка операций. Многие программисты ругают Perl за очень сложный синтаксис ООП, но на самом деле Perl по большому счёту не нужна ООП парадигма в той форме, в которой она есть, например, в языке Java. Perl в первую очередь всегда решал задачи системного администрирования, где скорее важны минимализм и практичность, так как у системных администраторов время на решение входящих запросов очень ограничено.

В Perl существует по меньшей мере два подхода перегружать операции:

  • Перегрузка связыванием. Данный тип перегрузки опирается на функцию tie(), которая привязывает объект-делегат к переменной определенного типа данных и переопределяет операции для этой переменной (привязывается к ней). Данный тип перегрузки концентрируется на этапах жизненного цикла объекта и перегружает через конструктор, деструктор, операции присваивания и копирования.
  • Перегрузка операций класса. Реализуется через модуль overload и позволяет перегружать знаки операций для выражений, в которых используется объект некоторого класса.

Перегрузка связыванием

[править]

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

Обычно протокол работы с определенным типом хранилища данных всегда строго определен. Отсюда возникает желание одни и те же данные записывать в разные типы хранилищ одинаковым, с точки зрения интерфейса, способом. Здесь и появляется функция tie(), которая привязывает реализацию-делегат к экземпляру стандартного типа данных. При этом делегат внутри себя полностью управляет протоколом работы с хранилищем, а наружу для клиентского кода перегружает операции присваивание и извлечение через знак операции =.

Данный подход впервые появился в Perl 5 и поддерживает привязывание для:

  • скаляров (Tie::Scalar),
  • массивов (Tie::Array),
  • хеш-массивов (Tie::Hash),
  • файловых дескрипторов (Tie::Handle).

Основу интерфейса tie() составляют следующие функции: 

# Строит экземпляр делегата и привязывает его к переменной.
tie <переменная-к-которой-привязывается-делегат>, <класс-делегата>, <список-аргументов-для-конструктора-делегата>

# Отвязывает делегата от переменной и удаляет его.
untie <переменная-к-которой-привязывается-делегат>

# Возвращает ссылку на экземпляр делегата.
tied <переменная-к-которой-привязывается-делегат>

Состав интерфейсных методов для каждого типа данных отличается, так как каждый тип в чём-то специфичен, но в общем каждый тип представляет следующие методы:

  • TIEHASH, TIEARRAY, TIEHANDLE и TIESCALAR — конструктор делегата соответственно для хеш-массива, массива, дескриптора и скаляра. Сигнатура конструктора для всех типов одинаковая: в первом аргументе передается имя пакета делегата, а в последующих список аргументов для него.
  • FETCH — определен для всех типов, кроме дескриптора. Вызывается каждый раз, когда связанная переменная участвует в выражении как правосторонний операнд, т.е. значение из источника извлекается.
  • STORE — определен для всех типов, кроме дескриптора. Вызывается каждый раз, когда связанная переменная участвует в выражении как левосторонний операнд, т.е. значение в источник записывается.
  • DESTROY — деструктор делегата.

Вам не обязательно переопределять все методы, предоставляемые интерфейсом, так как тривиальные реализации всегда есть в соответствующем пакете Tie::.

Связывание скаляров

[править]

Основы работы с tie-интерфейсом проще всего показать на скаляре, так как для скаляра определено самое малое количество методов:

  • TIESCALAR — конструктор делегата.
  • FETCH — метод, извлекающий данные из привязанного скаляра.
  • STORE — метод, записывающий данные в привязанный скаляр.
  • DESTROY — деструктор делегата.

Ниже показан небольшой пример делегирующего класса. 

use strict;

package TieScalarExample;

# Конструктор делегата.
sub TIESCALAR {
    my ($class, @args) = @_;
    print "Tie " . __PACKAGE__ . ": " . (join ", ", @args), "\n";
    return bless {}, $class;
}

# Метод извлекающий данные.
sub FETCH {
    my ($self) = @_;
    "To fetch a record";
}

# Метод записывающий данные.
sub STORE {
    my ($self, $value) = @_;
    print "Storing a value: $value", "\n";
}   

# Деструктор делегата.
sub DESTROY {
    my ($self) = @_;
    print "Before untie()";
}

#----------------------------------------------------------

package main;

our ($aScalar, $anotherScalar);

tie $aScalar, 'TieScalarExample', 1, 2, 3;    # Вызывается TieScalarExample::TIESCALAR

$anotherScalar = $aScalar;                    # Вызывается TieScalarExample::FETCH

print "$anotherScalar", "\n";                 # 'To fetch a record'

$aScalar = 15;                                # Вызывается TieScalarExample::STORE

untie $aScalar;                               # Вызывается TieScalarExample::DESTROY

Tie TieScalarExample: 1, 2, 3
To fetch a record  
Storing a value: 15
Before untie()

В комментариях к примеру показано, в какие моменты вызываются интерфейсные методы. В этом примере мы привязываем делегата TieScalarExample к скаляру $aScalar, после чего любая операция = будет переводиться на методы привязанного делегата до момента вызова untie() в зависимости от того, в левом или правом операнде операции участвует связанный скаляр. Перед отвязыванием делегата вызывается деструктор делегата.

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

#!/usr/bin/perl

use strict;

package ScalarTracker;

use IO::File;

#
# $log - имя файла, в который производится логирование.
# $var - начальное значение.
#
sub TIESCALAR {
    my $class = shift;
    my $log = shift;
    my $var = shift || "(undefined)";
    my $fh = new IO::File ">> $log"
        or die "Cannot open $log: $!\n";
    return bless {FH => $fh, VAL => 0, VAR => $var}, $class;
}

sub FETCH {
    my $self = shift;
    my ($package, $filename, $line) = caller();
    my $fh = $self->{FH};
    print $fh "package $package, ",
        "$filename line $line FETCHED $self->{VAR}\n";
    return $self->{VAL};
}

sub STORE {
    my $self = shift;
    my $var = shift;
    my $fh = $self->{FH};
    my ($package, $filename, $line) = caller();
    print $fh "package $package, ",
        "$filename line $line changed $self->{VAR} to $var\n";
    $self->{VAL} = $var;
}

sub DESTROY {
    undef %{$_[0]};
}

#----------------------------------------------------------

package main;

our $aFruit;

tie $aFruit, 'ScalarTracker', './log.txt', 'none';

for (qw{ Apple Pear Grapes Banana }) {
    print "Printing: " . ($aFruit = $_), "\n";
}

untie $aFruit;

Если вы откроете файл лога, то увидите следующие строки: 

package main, ./tiescalar.pl line 54 changed none to Apple
package main, ./tiescalar.pl line 54 FETCHED none
package main, ./tiescalar.pl line 54 changed none to Pear
package main, ./tiescalar.pl line 54 FETCHED none
package main, ./tiescalar.pl line 54 changed none to Grapes
package main, ./tiescalar.pl line 54 FETCHED none
package main, ./tiescalar.pl line 54 changed none to Banana
package main, ./tiescalar.pl line 54 FETCHED none

а на консоли 

$ ./tiescalar.pl 
Printing: Apple
Printing: Pear  
Printing: Grapes
Printing: Banana

Вы можете увидеть странную запись в логах 

package main, ./tiescalar.pl line 54 FETCHED none

Она говорит о том, что списковая операция print внутренне тоже обращается к скаляру.

Связывание массивов

[править]

Интерфейс для массивов уже заметно богаче:

  • TIEARRAY и DESTROY — конструктор и деструктор делегата.
  • STORE — вызывается, когда по конкретному индексу записывается значение в массив.
  • FETCH — вызывается, когда по конкретному индексу извлекается значение из массива.
  • DELETE — вызывается, когда удаляется элемент по индексу.
  • CLEAR — вызывается для операции delete для всего массива.
  • PUSH, POP, SHIFT, UNSHIFT, SPLICE — переопределяет стандартные одноименные операции над массивом.
  • EXISTS — вызывается, когда проверяется существование значение по индексу.
  • EXTEND — предполагается, что метод расширяет занимаемую память под массив на указанное число позиций.
  • FETCHSIZE — предполагается, что возвращает реальное число элементов в массиве.
  • STORESIZE — предполагается, что подравнивает размер массива под указанное значение. Если часть элементов выходит за пределы, они должны быть удалены. Если новый размер больше текущего, то новые значения должны быть проинициализированы undef.

Ниже показано, в какие моменты вызываются методы интерфейса. 

use strict;

package TieArrayExample;

sub TIEARRAY { 
    my ($class, @argv) = @_;

    return bless {}, $class;
}

sub FETCH { 
    my ($self, $value) = @_;
    
}

sub FETCHSIZE { 
    my ($self) = @_;
    
}

sub STORE { 
    my ($self, $index, $value) = @_;
    
}       

sub STORESIZE { 
    my ($self, $count) = @_;

}

sub EXISTS { 
    my ($self, $key) = @_;
    
}

sub DELETE { 
    my ($self, $key) = @_;
    
}

# Опциональные методы
sub CLEAR { 
    my ($self) = @_;

}
sub PUSH {
    my ($self, @list) = @_;
    
}
sub POP {
    my ($self) = @_;
    
}
sub SHIFT {
    my ($self) = @_;
    
}
sub UNSHIFT {
    my ($self, @list) = @_;
    
}
sub SPLICE {
    my ($self, $offset, $length, @list) = @_;

}
sub EXTEND {
    my ($self, $count) = @_;

}
sub DESTROY {
    my ($self) = @_;
}

#----------------------------------------------------------

package main;

our @array;

tie @array, 'TieArrayExample';  # TIEARRAY

my $value = $array[0];          # FETCH
$array[0] = 1;                  # STORE
scalar @array;                  # FETCHSIZE
exists $array[0];               # EXISTS

push @array, "1";               # PUSH
pop @array;                     # POP
shift @array;                   # SHIFT
unshift @array, 1;              # UNSHIFT
splice @array, 1;               # SPLICE и STORESIZE

delete $array[0];               # DELETE
undef @array;                   # CLEAR

untie @array;                   # DESTROY

Связывание хеш-массивов

[править]

Для хеш-массивов определены следующие методы:

  • TIEHASH и DESTOROY — конструктор и деструктор делегата.
  • STORE — сохраняет значение в хеш-массив по ключу.
  • FETCH — извлекает значение из хеш-массива по ключу.
  • FIRSTKEY — возвращает самый первый ключ в массиве.
  • NEXTKEY — возвращает следующий ключ. Используется для перебора элементов хеш-массивов через each().
  • EXISTS — проверяет существование ключа.
  • DELETE — удаляет значение из хеш-массива по ключу.
  • CLEAR — удаляет хеш-массив целиком.
  • SCALAR — вызывается, когда к хеш-массиву происходит обращение в скалярном контексте.

Ниже показано, в какие моменты вызываются методы интерфейса. 

use strict;

package TieHashExample;

sub TIEHASH {
    my ($class, @argv) = @_;

    return bless {}, $class;
}

sub DESTROY {
    my ($self) = @_;

}

sub FETCH {
    my ($self, $key) = @_;

}

sub STORE {
    my ($self, $key, $value) = @_;
   
}

sub FIRSTKEY {
    my ($self) = @_;
   
}

sub NEXTKEY {
    my ($self, $lastkey) = @_;
   
    undef;
}

sub EXISTS {
    my ($self, $key) = @_;
 
}

sub DELETE { 
    my ($self, $key) = @_;
    
}

sub CLEAR { 
    my ($self) = @_;

}

sub SCALAR { 
    my ($self) = @_;

}

#----------------------------------------------------------

package main;

our %hash;

tie %hash, 'TieHashExample';              # TIEHASH

$hash{'aaaa'} = 1;                        # STORE
my $v = $hash{'aaaa'};                    # FETCH
exists $hash{'aaaa'};                     # EXISTS
delete $hash{'aaaa'};                     # DELETE
undef %hash;                              # CLEAR
scalar %hash;                             # SCALAR

while ( my ($k,$v) = each %hash ) {       # FIRSTKEY и NEXTKEY
}

untie %hash;                              # DESTROY

Следует дать пояснения по методам FIRSTKEY и NEXTKEY. Эти методы реализуют подобие итератора. Метод FIRSTKEY вызывается всегда, когда хеш-массив передается функции keys() или each(). Этот метод должен сбросить состояние итератора, если оно не начальное, и вернуть начало хеш-массива. Метод NEXTKEY возвращает последующий элемент, вычисленный от последнего, переданного аргументом $lastkey. Если возвращать нечего, нужно вернуть значение undef, которое говорит, что элементы закончились.

Связывание дескрипторов

[править]

Связывание для файловых дескрипторов в Perl очень полезный функционал в *nix системах, так как в них через файловые дескрипторы можно получить доступ к любой части системы. Например, можно подключаться к блочным или символьным устройствам через специальные файлы и работать с ними через операции файловых дескрипторов из кода Perl. Так как через дескрипторы ходят символьные потоки, в них нет методов STORE и FETCH, а используются методы WRITE и READ.

Интерфейс поддерживает следующие методы:

  • TIEHANDLE и DESTROY — конструктор и деструктор делегата.
  • WRITE — записывает указанное число байтов с некоторого начального адреса и некоторого смещения от его начала.
  • READ — читает указанное число байтов с некоторого начального адреса и некоторого смещения от его начала.
  • READLINE — читает несколько байтов до некоторого разделителя.
  • GETC — читает очередной символ в символьном потоке.
  • PRINT — печатает значения в переданном списке.
  • PRINTF — печатает значения в списке с использованием форматной строки.
  • OPEN — открывает или переоткрывает файловый дескриптор.
  • CLOSE — закрывает файловый дескриптор.
  • BINMODE — указывает на то, что читаемый поток представляет собой поток байтов, а не отдельных символов (другими словами, включает бинарный режим чтения).
  • EOF — возвращает истину, если поток закончился.
  • TELL — возвращает текущую позицию в файле.
  • SEEK — передвигает позицию в файле относительно некоторой опорной точки.

Ниже показано, в какие моменты вызываются методы интерфейса. 

use strict;

package TieHandleExample;

sub TIEHANDLE {
    my ($class, @argv) = @_;

    return bless {}, $class;
}

sub WRITE {
    my ($self, $address, $length, $offet) = @_;
    
}

sub READ {
    my ($self, $address, $length, $offet) = @_;
    
}

sub READLINE {
    my ($self) = @_;
    
}

sub GETC {
    my ($self) = @_;
    
}

sub PRINT {
    my ($self, @list) = @_;

}

sub PRINTF {
    my ($self, $format, @list) = @_;

}

sub OPEN {
    my ($self, $filename) = @_;
    
}

sub CLOSE {
    my ($self) = @_;
    
}

sub TELL {
    my ($self) = @_;
    
}

sub EOF {
    my ($self) = @_;
    
}

sub BINMODE {
    my ($self) = @_;
    
}

sub SEEK {
    my ($self, $offet, $whence) = @_;
    
}

sub DESTROY {
    my ($self) = @_;
    
}

#----------------------------------------------------------

package main;

tie *HANDLE, 'TieHandleExample';                    # TIEHANDLE

open HANDLE, "/test/path";                          # OPEN

syswrite HANDLE, my $addr, my $length, my $offset;  # WRITE
sysread HANDLE, my $addr, my $length, my $offset;   # READ
getc HANDLE;                                        # GETC
seek HANDLE, my $offet, my $whence;                 # SEEK
tell HANDLE;                                        # TELL
eof HANDLE;                                         # EOF
binmode HANDLE;                                     # BINMODE

read HANDLE, my $addr, my $length, my $offset;      # READ

my $line = <HANDLE>;                                # READLINE
print HANDLE "line";                                # PRINT
printf HANDLE "format", "line";                     # PRINTF

close HANDLE;                                       # CLOSE

untie *HANDLE;                                      # DESTROY

Для этого типа связывания мы приведем два конкретных примера использования. Наверное вы знаете Unix утилиту tee. Основной задачей этой утилиты является копирование и перенаправление основного потока. Например, этим пользуются, когда вывод программы нужно видеть на консоли и одновременно с этим логировать его в файл (возможно в несколько файлов).

В Perl можно реализовать возможности tee следующим образом. 

#!/usr/bin/perl

use strict;

package Tie::Tee;

sub TIEHANDLE {
	my $class = shift;
	my @handles;          # В массиве мы сохраняем файловые дескрипторы, 
                          # в которые будет вестись параллельный вывод.
	for my $path (@_) {   # Открываем дескрипторы по передаваемым параметрам.
		open(my $fh, ">$path") || die "can't write $path";
		push @handles, $fh;
	}
	bless \@handles, $class;
}

sub PRINT {
	my $self = shift;
	my $ok = 0;
	for my $fh (@$self) {     # Пишем в каждый открытый дескриптор.
		$ok += print $fh @_;
	}
	return $ok == @$self;
}

sub DESTROY {
    my $self = shift;
    for my $fh (@$self) {
        close $fh;
    }
}

#----------------------------------------------------------

package main;

tie *BROADCAST,   "Tie::Tee", qw(tmp1 - tmp2 >tmp3 tmp4);

for my $line (qw {Apple Pear Grapes}) {
    print BROADCAST "$line\n";
}

untie *BROADCAST;

В примере выше мы открываем 5 дескрипторов: 4 связывается с файлами (tmp1, tmp2, tmp3, tmp4), причем tmp3 открывается на дозапись, и один связывается со стандартным потоком вывода (-). Все эти дескрипторы представляет один общий, который мы назвали BROADCAST и к которому мы привязали свою реализацию метода PRINT. Она не очень сложная и занимается тем, что для каждого открытого ранее дескриптора вызывает функцию print и передает список для печати.

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

Следующий пример показывает, как приложение может переключать источник ввода. Если приложению не передано ни одного аргумента командной оболочки, то приложение читает стандартный поток ввода. 

use strict;

package StdinSelector;

sub TIEHANDLE {
    my $class = shift;
    my @lines = @_;
    bless \@lines, $class;
}

sub READLINE {
    my ($self) = @_;
    shift @$self;
}

#----------------------------------------------------------

package main;

tie *STDIN, 'StdinSelector', @ARGV if scalar @ARGV != 0;

# В этом примере важно писать имя дескриптора явно.
while(<STDIN>) {
    chomp;
    print $_, "\n";
}

untie *STDIN if tied *STDIN;

# Аргументы переданы явно
$ perl ./selecthandle.pl 1 2 3
1
2
3

# А теперь данные поставляются через STDIN.
$ seq 1 3 | perl ./selecthandle.pl
1
2
3

Перегрузка операций через модуль overload

[править]

Второй подход перегрузки операций заключается в использовании директивного модуля overload. Данный модуль позволяет перегрузить часть стандартных операций в отношении произвольного класса. Данный модуль разрешает перегружать только те операции, которые перечислены в хеш-массиве %overload::ops. На момент версии 5.40 состав перегружаемых операций таков: 

$ perl -e 'use overload; use Data::Dumper; print Dumper \%overload::ops;'
$VAR1 = {
          '3way_comparison' => '<=> cmp',
          'iterators' => '<>',
          'with_assign' => '+ - * / % ** << >> x .',
          'mutators' => '++ --',
          'filetest' => '-X',
          'dereferencing' => '${} @{} %{} &{} *{}',
          'conversion' => 'bool "" 0+ qr',
          'matching' => '~~',
          'unary' => 'neg ! ~ ~.',
          'binary' => '& &= | |= ^ ^= &. &.= |. |.= ^. ^.=',
          'assign' => '+= -= *= /= %= **= <<= >>= x= .=',
          'num_comparison' => '< <= >  >= == !=',
          'func' => 'atan2 cos sin exp abs log sqrt int',
          'special' => 'nomethod fallback =',
          'str_comparison' => 'lt le gt ge eq ne'
        };

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

  • Операции not нет в списке перегружаемых операций, однако, если вы перегружаете !, то при вызове not будет использоваться реализация для !.
  • Точно так же операция унарного минуса - будет использовать реализацию для neg.
  • При перегрузке инкремента ++ и декремента --, Perl не будет делать отдельные реализации для префиксной и постфиксной формы (как, например, это делается в языке C++), однако точка вызова их в выражении будет поставлена так, чтобы отрабатывала префиксная или постфиксная форма. Эти операции находятся в категории mutators, что говорит о том, что они работают не с копией значения, а ссылкой на него.
  • Операцию присваивания = нельзя перегрузить с помощью этого модуля, так как она зарезервирована для конструктора копирования класса. Единственный способ её перегрузить — это использовать интерфейс tie(). Тем не менее, вы можете перегружать прочие разновидности присваивания (категория assign), так как они работают с ссылкой.
  • Операции
    +  -  *  /  %  **  <<  >>  x  . &  |  ^  &.  |.  ^.
    не должны изменять свои операнды, так как они передаются по ссылке и это было бы некорректным поведением. Другими словами, они должны конструировать новое значение в качестве результата.
  • Все операции тестирования файла (-f, -x и др.) перегружаются одной и той же операцией -X, и перегрузить их по-отдельности невозможно. Тем не менее, вы можете распознать какой тест передаётся через второй аргумент, несмотря на то, что операция унарная.
  • Чтобы отличать побитовые операции от прочих, в таблице %overload::ops используется точка, например, & и &..

Обычно, если вам требуется перегрузить операции для вашего класса, минимально рекомендуется перегружать следующие: 

+ - * / % ** << >> x
<=> cmp
& | ^ ~ &. |. ^. ~.
atan2 cos sin exp log sqrt int
"" 0+ bool
~~

Основы перегрузки

[править]
  • Перегрузка операции происходит в момент вызова модуля overload. Вы должны указать знак операции из таблицы %overload::ops в качестве ключа, а затем присвоить ссылку на процедуру любым доступным способом
    use overload
    "-" => "minus",    # Перегрузка с помощью символической ссылки.
    "*=" => \&muas,    # Перегрузка с помощью жесткой ссылки.
    '""' => sub { ...; }; # Объявление анонимной процедуры на месте.
  • Объявленные процедуры должны быть реализованы в ближайшем к директиве пакете. Обычно это пакет класса, которому требуется перегрузка операций. Допустимо указывать реализацию из другого пакета. Кроме того, если реализация наследуется, то к ней справедливы все правила наследования, описанные выше. Например, если есть классы A -> B -> C, где стрелка указывает на родителя, и классы B и С перегружают одну и ту же операцию, A будет искать по списку @ISA ближайшую в цепочке наследования реализацию.
  • Все перегружающие процедуры объявляются одинаково
    sub overloadImpl {
   my ($self, $other, $swap) = @_;
   ...
   return $result;
}
    Однако, интерпретация входящих аргументов и тип возвращаемого значения зависят от смысла операции (см. ниже).
  • Для некоторых операций, которые связаны по смыслу разными знаками, Perl может генерировать реализацию автоматически для той части, которая не была перегружена явно. Например, операции 0+[3], "", и bool могут предоставить свою реализацию операции !, если та не была перегружена, а хотя бы одна из них была перегружена.
  • Ключ nomethod может использоваться для объявления универсальной перегрузки, которая будет вызываться для любой не перегруженной индивидуально операции.
  • Установка флага fallback даёт модулю подсказку, как он должен поступать с вызовом, если не удаётся найти для операции перегруженную реализацию.

Реализующая процедура

[править]

Перегрузка бинарных и унарных операций происходит по одному прототипу входящих параметров

my ($self, $other, $swap, $nomethod, $binary) = @_;

Здесь

  • $self — ссылка на объект класса, для которого была перегружена операция;
  • $other — второй операнд или параметр унарной операции;
  • $swap — флаг, который говорит о том, находится ли ссылка на объект слева (ЛОЖЬ) от знака операции или справа (ИСТИНА).

Реализующая процедура обычно возвращает ссылку на результат. Здесь многое зависит от того, какой смысл закладывается в перегрузку.

Флаг $swap многогранный. Он используется и в бинарных, и унарных операциях, но ЛОЖЬ в них представляется по-разному. В бинарных операциях ЛОЖЬ представляется пустой строкой '', а в унарных операциях и операциях класса assign используется undef.

Существуют также 4-й и 5-й параметры, которые инициализируются в особых ситуациях. Если перегружена специальная операция nomethod, которая по смыслу похожа на AUTOLOAD (но для операций), 4-й параметр всегда инициализируется знаком операции. Для побитовых операций (&, |, ^ и ~) инициализируется 5-й параметр, чтобы, возможно, подсказать реализации о необходимости работать с операндами как с числами.

Автогенерируемые операции

[править]

Если вызывается операция для некоторого класса и при этом для неё нет перегруженной реализации, модуль overload руководствуется встроенным в него флагом fallback, который по умолчанию имеет значение ИСТИНА.

Алгоритм поиска реализации операции таков:

  1. Если операция перегружена в объекте вызываемого класса, то использовать реализацию в этом классе, иначе идём дальше.
  2. Если fallback ИСТИНА или undef, попытаться сгенерировать автоматическую реализацию.
  3. Если операция не относится к категории assign, то повторить шаг 1 для второго операнда.
  4. Повторить шаг 2 для второго операнда.
  5. Если для первого операнда все сводится к nomethod реализации, то использовать её.
  6. Если для второго операнда все сводится к nomethod реализации, то использовать её.
  7. Если fallback ИСТИНА и не нашлось ни одной реализации, то попытаться обработать операнды в соответствии с типом операции. Например, если операция арифметическая, то попытаться привести операнды к числам; если строковая — строкам и т.д.
  8. Если ничего из этого не может корректно отработать, то бросить исключение.

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

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

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

Пример перегрузки

[править]

На практике перегрузка зачастую используется, чтобы выразить идею программы более наглядно — добавить синтаксического сахара. Пример ниже демонстрирует модуль, который, используя операцию <<, представляет поток строк, который, возможно, используется шаблонизатором[4]. В данный поток можно встраивать условия, чтобы игнорировать некоторые части шаблона в зависимости от текущих условий.

Внимательно изучите следующий код. 

use strict;

package StringStream;
use subs qw { If ElseIf Else Endl };

use overload 
    '<<' => \&__stream_element,
    q{""} => \&__to_string;

require Exporter;
our @ISA = qw{ Exporter };

our @EXPORT = qw{ new If ElseIf Else Endl };
our @EXPORT_OK = qw{ If ElseIf Else Endl };

sub new { 
    my $class = shift; 
    bless {
        'if_stack' => [],
        'stream' => []
    }, $class 
}

sub __to_string {
    my $self = shift;
    my $result = "";
    foreach my $e (@{$self->{stream}}) {
        $result .= $e;
    }
    return $result;
}

sub __stream_element {
    my ($self, $rhs, $swap) = @_;

    my $stackSize = scalar @{$self->{'if_stack'}};
    my $lastCondition = 1;
    $lastCondition = $self->{'if_stack'}->[-1] if $stackSize;

    if (ref $rhs eq '_If') {
        if ($lastCondition) {
            my $condition = $$rhs;
            push @{$self->{'if_stack'}}, 's';
            push @{$self->{'if_stack'}}, $condition;
        } else {
            push @{$self->{'if_stack'}}, 0;
        }
    } elsif (ref $rhs eq '_ElseIf') {
        my $condition = $$rhs;
        if ( ! $lastCondition && $condition ) {
            push @{$self->{'if_stack'}}, $condition;
        } elsif ($lastCondition) {
            push @{$self->{'if_stack'}}, -1;
        }
    } elsif (ref $rhs eq '_Else') {
        if ( ! $lastCondition && $lastCondition != -1 ) {
            push @{$self->{'if_stack'}}, 1;
        } else {
            push @{$self->{'if_stack'}}, 0;
        }
    } elsif (ref $rhs eq '_Endl') {
        return $self if ! $stackSize;
        my $element = undef;
        do { $element = pop @{$self->{'if_stack'}} } while ($element  ne 's');
    } else {
        if ($lastCondition && $lastCondition != -1) {
            push @{$self->{'stream'}}, $rhs;
        }
    }
    return $self;
}

package _If;

use overload 
    '<<' => \&StringStream::__stream_element
    ;

sub If($;) {
    my ($condition) = @_;
    return bless \$condition, '_If';
}

package _ElseIf;

use overload 
    '<<' => \&StringStream::__stream_element
    ;

sub ElseIf($;) {
    my ($condition) = @_;
    return bless \$condition, '_ElseIf';
}

package _Else;

use overload 
    '<<' => \&StringStream::__stream_element
    ;

sub Else () {
    return bless {}, '_Else';
}

package _Endl;

use overload 
    '<<' => \&StringStream::__stream_element
    ;

sub Endl () {
    return bless {}, '_Endl';
}

package StringStream;

sub If($;) {
    local $_ = $@;
    &_If::If;
}

sub ElseIf($;) {
    local $_ = $@;
    &_ElseIf::ElseIf;
}

sub Else() {
    local $_ = $@;
    &_Else::Else;
}

sub Endl() {
    local $_ = $@;
    &_Endl::Endl;
}

1;

Данный модуль представляет класс StringStream, который имеет два атрибута: stream и if_stack. Атрибут stream представляет собой ссылку на строковый массив, в который набираются части результирующей строки. Чтобы в потоке строк иметь возможность игнорировать некоторые части, класс реализует собственные операции, которые могут представлять условия. Они реализуются за счет встроенных классов, которые не видны клиентскому коду, но которые может интерпретировать StringStream. Эти классы имитируют конструкцию If...ElseIf...Else, но, чтобы отмечать границу конструкции, используется терминирующая операция Endl. Создать экземпляры встроенных классов можно только с помощью функций-оболочек, которые имеют имена If, ElseIf, Else и Endl, причем в If и ElseIf можно передавать выражения, которые выполняют роль условных конструкций.

Весь секрет этого класса кроется в том, что он и его скрытые классы перегружают знак операции <<, который отсылает к одной единственной процедуре __stream_element. Данная процедура анализирует второй операнд и, используя массив if_stack, отключает части потока строк, в зависимости от результатов условных выражений. Данная система не проверяет некоторые некорректные ситуации и ожидает, что ни один ElseIf не будет встречаться раньше чем If; Else не будет стоять раньше If и ElseIf, а каждая открытое условие If будет терминироваться Endl.

Кроме операции << класс StringStream также перегружает операцию q{""}, которая используется в скалярном контексте, чтобы сформировать из набранной строки окончательную.

Ниже показан пример использования. 

#!/usr/bin/perl
# File: stream_test.pl
use StringStream;

print StringStream->new 
    << "Stream of strings:" << "\n"
    << If (scalar @ARGV == 0)
    << "  No Arguments passed\n"
    << ElseIf (scalar @ARGV == 1)
    << "  Passed 1 argument: " << $ARGV[0] << "\n"
    << Else
    << "  Passed " << (scalar @ARGV) << " arguments" << "\n"
    << Endl
    ;

В данном примере анализируется входящий массив аргументов и, в зависимости от переданного числа аргументов, печать выводится по-разному: 

# Предполагается, что файл модуля лежит в рабочем каталоге.

$ perl  -I$(pwd) ./stream_test.pl  
Stream of strings:   
  No Arguments passed

$ perl  -I$(pwd) ./stream_test.pl  arg1 
Stream of strings:       
  Passed 1 argument: arg1

$ perl  -I$(pwd) ./stream_test.pl  arg1 arg2 arg3
Stream of strings:  
  Passed 3 arguments

Обратите внимание, что мы могли бы конструировать строку без использования этого «сахара», но конечная конструкция изобиловала бы множеством операций конкатенации, ветвлений и циклов. Другими словами, мы концентрируемся на задаче сформировать строку по нашим правилам простыми средствами.

Примечания

[править]
  1. ↑ По внутренней терминологии такая ссылка называется благословлённой (англ. blessed)
  2. ↑ Сравните с операцией instanceof в языке Java.
  3. ↑ Операция 0+ называется «Венерой» из-за внешней схожести с зеркалом Венеры. Данная операция пытается преобразовать строку в число в скалярном контексте.
  4. ↑ Программой, которая, используя некоторый шаблон, генерирует конечный текстовый документ.
Источник — https://ru.wikibooks.org/w/index.php?title=Некоторые_сведения_о_Perl_5/Объектно-ориентированное_программирование_в_Perl&oldid=258487