Викиучебник ruwikibooks https://ru.wikibooks.org/wiki/%D0%97%D0%B0%D0%B3%D0%BB%D0%B0%D0%B2%D0%BD%D0%B0%D1%8F_%D1%81%D1%82%D1%80%D0%B0%D0%BD%D0%B8%D1%86%D0%B0 MediaWiki 1.47.0-wmf.24 first-letter Медиа Служебная Обсуждение Участник Обсуждение участника Викиучебник Обсуждение Викиучебника Файл Обсуждение файла MediaWiki Обсуждение MediaWiki Шаблон Обсуждение шаблона Справка Обсуждение справки Категория Обсуждение категории Полка Обсуждение полки Импортировано Обсуждение импортированного Рецепт Обсуждение рецепта Задача Обсуждение задачи TimedText TimedText talk Модуль Обсуждение модуля Event Event talk 0 30401 270383 269883 2026-10-17T12:19:47Z ScriptMaster 15708 /* Директива subs */ 270383 wikitext text/x-wiki {{Навигация учебника}} == Пакеты == ''Пакет'' — это пространство имен для некоторой части программы. Каждый фрагмент кода Perl относится к некоторому пакету. Чтобы объявить пакет, используется конструкция <source lang="perl"> package <имя-пространства-имен> [<версия>]; </source> Встроенная функция <code>package</code> предписывает компилятору использовать для оставшегося кода указанное пространство имен. Область действия этого пространства имен распространяется до следующего пакета, либо до конца: * процедуры; * блока; * строки, переданной функции <code>eval()</code>; * исходного файла. Все идентификаторы, встречающиеся после пакета, автоматически связываются с ним, кроме локальных переменных, созданных с помощью <code>my()</code>. Пространство имен можно многократно менять в разных точках программы. По умолчанию предполагается, что основная программа всегда начинается с объявления пакета <code>package main;</code>. Таким образом, все глобальные переменные неявно находятся в пакете <code>main</code>. К переменным пакета <code>main</code> мы можем обращаться без всяких дополнительных префиксов, но для обращения к объектам других пакетов нужно использовать следующий синтаксис <source lang="perl"> <идентификатор-типа><пространство-имен>::<имя-объекта> # Например $PackageName::var; # Обращение к скаляру в пространстве PackageName # Для пространства main допустимо указывать пакет явно, но это # в общем то бесполезно, если это пространство уже действует. # Следующие три обращения направлены на одну и ту же переменную в пространстве # main. $var; $main::var; $::var; </source> С помощью специальной лексемы <code>__PACKAGE__</code> можно узнать какое пространство имен применяется в некоторой точке программы. === Таблица символов пакета === С каждым пакетом связана отдельная ''таблица символов''. Она представляет собой хеш-массив, имя которого образовано из имени пакета, за которым следуют два двоеточия. Например, таблица символов для пакета <code>main</code> хранится в хеш-массиве <code>%main::</code>. Ключами этого хеш-массива являются идентификаторы переменных, определенных в пакете, а значениями — <code>typeglob</code>-ссылки, указывающие на гнездо, состоящее из одноимённых переменных разных типов. Таблица символов может использоваться для создания псевдонимов, так как <code>typeglob</code>-ссылки обладают следующими свойствами: <source lang="perl"> *alias = *object; # alias становится псевдонимом для всех переменных одного гнезда # таблицы: $object, @object, %object, &object. # Можно создать псевдоним только для конкретного объекта *alias = \$object; # Псевдоним для скаляра $object </source> Функция из следующего примера позволяет распечатать таблицу символов. <source lang="perl"> # # Аргументы: # $1 - имя пространства для печати # \%2 - ссылка на хеш-массив пространства имен # # Пример: # printNamespace ("main", %main::); # sub printNamespace ($\%) { my ($spaceName, $space) = @_; my ($key, $item); print "Symbols in the '$spaceName' namespace:\n"; for $key (sort keys %$space) { local *glob = $$space{$key}; print " scalar: \$$key = $glob\n" if defined $glob; if (@glob) { print " array '\@$key':\n"; for $item (0..$#glob) { print " \$$key [$item] = $glob[$item]\n"; } } if (%glob) { print " hash '\@$key':\n"; for $item (sort keys %glob) { print " \$$key {$item} = $glob{$item}\n"; } } print " routine '$key()'\n" if defined &glob; } } package test1; $scalar = 4; @array = (1, 2, 3); %hash = (name => "Larry", surname => "Wall"); sub func { return 0 } package test2; $scalar = 4; @array = (1, 2, 3); %hash = (name => "Larry", surname => "Wall"); sub func { return 0 } package main; printNamespace ("test1", %test1::); printNamespace ("test2", %test2::); </source> Результат вывода <source lang=""> Symbols in the 'test1' namespace: array '@array': $array [0] = 1 $array [1] = 2 $array [2] = 3 routine 'func()' hash '@hash': $hash {name} = Larry $hash {surname} = Wall scalar: $scalar = 4 Symbols in the 'test2' namespace: array '@array': $array [0] = 1 $array [1] = 2 $array [2] = 3 routine 'func()' hash '@hash': $hash {name} = Larry $hash {surname} = Wall scalar: $scalar = 4 </source> В этом примере мы создали два пакета <code>test1</code> и <code>test2</code>, в каждом из которых мы объявили скаляр, массив, хеш и функцию. В таблицу символов пакета, отличного от <code>main</code>, входят только идентификаторы, начинающиеся с буквы или символа нижнего подчеркивания. Все остальные идентификаторы относятся к пакету <code>main</code>. Кроме них к <code>main</code> также относятся: <code>STDIN</code>, <code>STDOUT</code>, <code>STDERR</code>, <code>ARGV</code>, <code>ARGVOUT</code>, <code>ENV</code>, <code>INC</code>, <code>SIG</code>. В этих случаях не обязательно указывать пространство имен из другого пространства. === Конструктор и деструктор пакета === В некоторых сложных пакетах может потребоваться внутренняя инициализация, например установка констант, некоторые переключения, зависящие от операционной системы, управление порядком компиляции и прочее. Для таких случаев в пакет может быть внедрен ''конструктор'' и ''деструктор'' пакета. ''Конструктор пакета'' — это процедура, оформленная в специальном блоке <code>BEGIN</code>, которая выполняется сразу после своего определения до завершения компиляции оставшейся части программы. Отметим также, что директива <code>use</code>, рассмотренная ниже, является по своей сути завуалированным блоком <code>BEGIN</code> с процедурой. ''Деструктор пакета'' — это процедура, оформленная в специальном блоке <code>END</code>, которая выполняется после выполнения программы и перед выгрузкой пакета. <source lang="perl"> BEGIN { <операторы> } END { <операторы> } </source> Для одного пакета может быть определено несколько блоков <code>BEGIN</code> и <code>END</code>, причем блоки <code>END</code> могут быть определены раньше <code>BEGIN</code>. Блоки <code>BEGIN</code> вызываются в порядке FIFO, а блоки <code>END</code> в порядке LIFO. Это сделано для того, чтобы блоки <code>BEGIN</code> и <code>END</code> могли быть сопоставлены попарно. Следующий пример демонстрирует, как вызываются конструкторы и деструкторы пакетов. <source lang="perl"> BEGIN { print "Package " . __PACKAGE__ . " are loading ...", "\n"; } END { print "Package " . __PACKAGE__ . " are unloading ...", "\n"; } END { print __PACKAGE__ . ": additional destructor.", "\n"; } package test1; BEGIN { print "Package " . __PACKAGE__ . " are loading ...", "\n"; } BEGIN { print __PACKAGE__ . ": additional consturctor.", "\n"; } END { print "Package " . __PACKAGE__ . " are unloading ...", "\n"; } </source> Результат вывода <source lang=""> Package main are loading ... Package test1 are loading ... test1: additional consturctor. Package test1 are unloading ... main: additional destructor. Package main are unloading ... </source> === Другие блоки пакета === Кроме конструктора и деструктора пакета есть еще два блока, которые применяются не часто, но о них следует знать. Это блоки <code>CHECK</code> и <code>INIT</code>. Они могут быть использованы, когда программисту нужны инструкции, которые выполняются на границах компилятора и интерпретатора Perl. Сейчас это может быть не так понятно, но после прочтения раздела [[Некоторые сведения о Perl 5/Perl XS#Работа компилятора Perl]], вы поймете какие это моменты. Блок <code>CHECK</code> запускается после стадии компиляции, но перед запуском основной программы. Это можно использовать, чтобы проверить, как отработал компилятор. Блок <code>INIT</code> запускается перед основной программой на стадии интерпретации. Это может быть использовано для инициализации некоторых контролирующих программу процедур, которыми основная программа не должна владеть. Если перечислить блоки в порядке их вызова, то он будет таким: <pre> BEGIN { ... } <компиляция> CHECK { ... } INIT { ... } <поток исполнения скомпилированного кода> END { ... } </pre> Разумеется этих блоков может быть много и все они закрепляются за конкретным пакетом. === Автозагрузка === При попытке обратиться к функции, которая еще не определена в пакете, интерпретатор завершает работу с выдачей сообщения об ошибке. Если в пакете определить функцию со специальным именем <code>AUTOLOAD</code>, то интерпретатор будет перенаправлять вызов на нее с сохранением передаваемых параметров. Кроме того, внутри этой функции будет определен скаляр <code>$AUTOLOAD</code>, в котором будет хранится имя вызываемой функции. Способы применения этой возможности самые различные. Самое простое, так можно отслеживать вызов функции при написании прототипа новой программы или определить, что пакеты подгружаются в программу неправильно. <source lang="perl"> sub AUTOLOAD { print "Called '$AUTOLOAD': @_\n"; } testCall(1, 2 ,4); undefinedFunc(1, "a", 3.1415, "b"); </source> Результат <source lang=""> Called 'main::testCall': 1 2 4 Called 'main::undefinedFunc': 1 a 3.1415 b </source> == Библиотека == Пакеты, как мы выяснили это выше, служат для повторного использования имен, а также для логического объединения операторов. Второй шаг — это группировка процедур и сохранение их в отдельных исходных файлах. Для реализации этого, в Perl существует два механизма: библиотеки и модули. В этом разделе мы рассмотрим библиотечный подход. Библиотеки появились в Perl с 4-й версии языка и являются классическим методом. ''Библиотека'' — это пакет, областью действия которого является отдельный файл. Другими словами, ''библиотека Perl'' — это исходный файл, составленный на языке Perl, первая строка которого вводит пространство имен: <source lang="perl"> package package_name; </source> Имя библиотечного файла обычно имеет расширение <code>.pl</code>. Основная программа загружает библиотеки при помощи директивы компилятора <code>require</code>. === Загрузка библиотеки === Директива <source lang="perl"> require [<выражение>] </source> служит для загрузки функций из внешних библиотек во время выполнения. Если <code><выражение></code> отсутствует, то вместо него будет использоваться переменная <code>$_</code>. Если <code><выражение></code> является числом, то вызов соответствует требованию, что для выполнения данного сценария необходим интерпретатор perl с номером версии, не меньшим, чем указано. Самую меньшую версию, которую можно указать, это 5.005. Более ранние интерпретаторы будут прерывать исполнение с выдачей сообщения об ошибке. Чтобы загрузить библиотеку, нужно указать имя исходного файла в выражении. Логику работы этой директивы можно выразить следующей псевдофункцией: <source lang="perl"> sub require { my ($filename) = @_; return 1 if $INC{$filename}; my ($realfilename, $result); ITER: { foreach $prefix (@INC) { $realfilename = "$prefix/$filename"; if (-f $realfilename) { $result = do $realfilename; last ITER; } } die "Can't find $filename in \@INC"; } die $@ if $@; die "$filename did not return true value" unless $result; $INC{$filename} = $realfilename; return $result; } </source> Специальный встроенный массив <code>@INC</code> содержит имена каталогов, в которых следует искать сценарии Perl, подлежащие выполнению в конструкциях: * <code>do <файл></code>; * <code>require</code>; * <code>use</code>. В этот массив помещаются каталоги, переданные интерпретатору опцией <code>-I</code>, стандартные пути к библиотечным каталогам (которые могут зависеть от операционной системы) и символическое обозначение текущего каталога <code>.</code>. Специальный встроенный хеш-массив <code>%INC</code> содержит по одному элементу для каждой загруженной библиотеки с помощью <code>do</code> и <code>require</code>. Ключом является имя файла, в том виде, в котором оно было указано, а значением — полный путь к нему. Хеш-массив <code>%INC</code> защищает программу от повторной загрузки библиотеки, так как он проверяется перед включением. Обычно библиотечные файлы имеют расширение <code>.pl</code> в своем имени. Так как в Perl есть операция конкатенации <code>.</code>, чтобы не путать интерпретатор, следует всегда передавать имена файлов в кавычках: <source lang="perl"> require "mylib.pl"; </source> Если файл не имеет расширения, то по умолчанию предполагается, что это модуль, которые имеют расширение <code>.pm</code>. === Рекомендации по созданию библиотечных файлов === Для создания библиотеки нужно придерживаться следующих правил: * Создайте каталог для хранения библиотечных файлов и помещайте файлы в него по мере роста библиотеки. * Типовая струтура библиотечного файла имеет вид:<source lang="perl"> package myspace; ... # Процедуры, функции и другое ... 1; </source>В конце файла следует поместить строку <code>1;</code>, которая нужна для реализации вызова <code>do <файл></code>: несложно догадаться, что если <code>do</code> удается распарсить файл целиком, то наружу нужно вернуть ИСТИНУ, которая как раз возвращается единицей. * Библиотеки следует включать в основном директивой <code>require</code>. * Пути поиска пользовательских библиотек можно внедрять в программу по-разному: ** Раньше <code>@INC</code> обычно редактировался в конструкторе пакета как то так:<source lang="perl"> BEGIN { unshift(@INC, <список>) } </source> Сейчас рекомендуется использовать директиву <code>lib</code> (см. ниже). ** Можно передавать пути к каталогам через опцию <code>-I</code>. ** Можно передать пути к каталогам через переменную окружения <code>PERLLIB</code> или <code>PERL5LIB</code>. == Модуль == Модули являются дальнейшим развитием библиотек и появились начиная с Perl 5. ''Модуль'' — это библиотека, оформленная особым образом, которая определяет свои правила включения. Модуль определяет правила ''экспорта'' и ''импорта''. Правила экспорта предоставляют другим модулям права для импорта в них символов текущего модуля. В свою очередь, правила импорта определяют правила включения в текущий модуль символов из других модулей. Таким образом, в такой системе ожидается, что модули могут включать друг друга единственно правильным образом, а все ошибочные действия будут перехватываться как можно раньше. Для целей управления экспортом каждый модуль должен располагать методом <code>import()</code> и определить специальные массивы <code>@EXPORT</code> и <code>@EXPORT_OK</code>. Вызываюшая программа обращается к методу <code>import()</code>, чтобы включить в себя модуль. Массив <code>@EXPORT</code> содержит идентификаторы, экспортируемые по умолчанию. Специальный массив <code>@EXPORT_OK</code> содержит идентификаторы, которые будут экспортироваться только в том случае, если они указаны явно в списке импорта вызывающей программы. С появлением модулей появилась и новая директива для их подключения к основной программе — <code>use()</code>. === Директива use() === Директива <source lang="perl"> use <модуль> [<список>] use <версия> </source> служит для того же самого, что и <code>require()</code>, но ориентирована на загрузку модулей. Она автоматически импортирует имена функций и переменных в основное пространство имен текущего пакета. Для этого в импортируемом модуле неявно вызывается метод <code>import()</code>. Этот метод должен быть определен в экспортирующем модуле, либо он должен его унаследовать у модуля <code>Exporter</code>. Большинство модулей не имеют своего метода <code>import()</code>, поэтому они наследуют его из модуля <code>Exporter</code>. Логику работы директивы <code>use</code> можно описать строкой: <source lang="perl"> BEGIN { require <модуль>; import <модуль> <список>; } </source> Здесь <code><модуль></code> это слово без суффиксов, не заключенное в кавычки. Если аргументом является число <code><версия></code>, то оно будет обозначать номер версии интерпретатора perl. Если номер версии текущего интерпретатора меньше указанного, то интерпретатор завершит работу с сообщением об ошибке. Если при импорте модуля указан <code><список></code>, то будут импортироваться символы, указанные в этом списке, иначе будут импортироваться символы из массива <code>@EXPORT</code>, определенном в самом модуле. === Создание и подключение модуля === Для создания модулей требуется немного больше кода, чем для простых библиотек. Ниже показан пример модуля, который можно использовать как шаблон. <source lang="perl"> # Файл: TestModule.pm package TestModule; # Пространство модуля require Exporter; # Импортируем метод import() @ISA = qw{ Exporter }; # Для наследования из @ISA @EXPORT = qw{ test printContent }; # Символы, экспортируемые по умолчанию @EXPORT_OK = qw{ $scalar @array %hash }; # Символы, экспортируемые по требованию # Функции модуля sub test { my ($element, $counter); @array = @_; $scalar = $#array + 1; foreach $element (@array) { $hash{"$element"} = ++$counter; } } sub printContent { foreach $key (sort keys %hash) { print __PACKAGE__ . "::\$hash {$key} = $hash{$key}\n"; } print __PACKAGE__ . "::Scalar = $scalar\n"; } 1; </source> Первые пять строк (начиная со второй) являются стандартными для любого модуля: * <code>package TestModule;</code> Вводит пространство имен модуля <code>TestModule</code>, исходный файл которого имеет имя <code>TestModule.pm</code>. * <code>require Exporter;</code> Мы подключаем библиотеку <code>Exporter</code>, чтобы не писать метод <code>import()</code>. * <code>@ISA = qw{ Exporter };</code> С каждым пакетом ассоциируется свой массив <code>@ISA</code>, включающий имена других пакетов, представляющих классы. Если интерпретатор наталкивается на метод, не определенный в текущем пакете, он просматривает массив <code>@ISA</code>, чтобы найти его среди перечисленных пакетов. В нашем примере достаточно указать только модуль <code>Exporter</code>. * <code>@EXPORT = qw{ test printContent };</code> Массив символов, которые импортируются из модуля <code>TestModule</code> неявно. В данном случае мы всегда неявно импортируем обе функции, которые определены в модуле. * <code>@EXPORT_OK = qw{ $scalar @array %hash };</code> Массив символов, которые мы разрешаем импортировать из модуля <code>TestModule</code> по требованию списком. В данном примере мы разрешаем импортировать все глобальные переменные модуля. На практике, обычно, модуль имеет свои внутренние переменные, которые он никому не раскрывает. Представим, что наш тестовый модуль лежит в некотором каталоге. Теперь напишем программу, которая его подключит и вызовет его функции. <source lang="perl"> # Файл: main.pl use TestModule qw{ :DEFAULT $scalar }; test one, two, three, four; printContent; print __PACKAGE__ . ": TestModule::Scalar = $scalar\n"; </source> Первой строкой <code>use TestModule qw{ :DEFAULT $scalar };</code> мы подключаем модуль <code>TestModule</code>. Кроме имени модуля, мы передаем список того, что хотим импортировать в наше приложение. В нашем примере мы передаем тэг <code>:DEFAULT</code>, который требует импортировать все, что перечислено в массиве <code>@EXPORT</code>, а также дополнительно мы просим импортировать символ <code>$TestModule::scalar</code>. Далее мы вызываем функцию модуля <code>test()</code>, которая инициализирует внутренние массивы модуля переданными значениями, а затем мы вызываем функцию печати <code>printContent()</code>, которая печатает содержимое хеш-массива модуля. Благодаря тому что мы импортировали символ <code>$TestModule::scalar</code>, мы можем им пользоваться в нашем приложении, как будто он существует в пространстве <code>main</code>. Вызывать нашу программу мы должны с опцией <code>-I</code>, так как наш модуль не лежит в стандартном для модулей месте. Таким образом, вызов должен быть таким: <source lang="bash"> $ perl -I$(pwd) ./main.pl </source> Результат работы программы представлен ниже <source lang="bash"> TestModule::$hash {four} = 4 TestModule::$hash {one} = 1 TestModule::$hash {three} = 3 TestModule::$hash {two} = 2 TestModule::Scalar = 4 main: TestModule::Scalar = 4 </source> === Директива no() === Директива <source lang="perl"> no <имя-модуля> <список> </source> является противоположной по смыслу директиве <code>use()</code>. Она отменяет действия, связанные с импортом, вызывая метод <code>unimport <имя-модуля> <список></code>. Не все библиотечные модули реагируют на эту директиву. Некоторые другие директивы не реагируют на <code>no</code>, потому что с логической точки зрения это было бы странным. Например, к такой директиве относится <code>subs</code> (см. ниже): её действие длится с момента определения и до конца файла. === Категоризация экспорта === Вы могли заметить, что символы в массивах <code>@EXPORT</code> и <code>@EXPORT_OK</code> хранятся одной большой кучей, что может создавать неудобства в клиентском коде, когда подключаемый модуль хранит десятки символов. В этом случае у разработчика есть возможность привязать часть символов к так называемым тэгам (категориям) и предоставить возможность импортировать символы по тэгам через модуль <code>Exporter</code>. Ниже демонстрируется принцип работы этого механизма. Пусть у нас есть такой модуль: <source lang="perl"> package MyModule; use strict; use Exporter; our @ISA = qw { Exporter }; our @EXPORT = qw { cat1_function1 cat1_function2 cat2_function1 @cat1_arr $scalar1 $scalar2 %cat2_hash }; # Следующий хэш объявляет тэги. Ключи этого хэша называют категории, а массив категории называет все символы, # которые к ней относятся. Все символы должны существовать в массиве @EXPORT. our %EXPORT_TAGS = ( CATEGORY_1 => [ qw { cat1_function1 cat1_function2 @cat1_arr } ], CATEGORY_2 => [ qw { cat2_function1 %cat2_hash } ], SCALARS => [ qw { $scalar1 $scalar2 } ] ); sub _dummy { my ($package, $filename, $line) = caller; print "call: $package ($filename:$line)\n"; } our @cat1_arr = ( 1, 2, 3 ); our $scalar1 = "Scalar 1"; our $scalar2 = "Scalar 2"; our %cat2_hash = ( value => 1 ); sub cat1_function1 { &_dummy; } sub cat1_function2 { &_dummy; } sub cat2_function1 { &_dummy; } 1; </source> Пусть наш клиентский код использует этот модуль так: <source lang="perl"> #!/usr/bin/perl use lib qw {.}; # Данная директива требует добавить текущий рабочий каталог в массив @INC. # Для печати таблицы символов. sub printNamespace ($\%) { my ($spaceName, $space) = @_; my ($key, $item); print "Symbols in the '$spaceName' namespace:\n"; for $key (sort keys %$space) { local *glob = $$space{$key}; print " scalar: \$$key = $glob\n" if defined $glob; if (@glob) { print " array '\@$key':\n"; for $item (0..$#glob) { print " \$$key [$item] = $glob[$item]\n"; } } if (%glob) { print " hash '\@$key':\n"; for $item (sort keys %glob) { print " \$$key {$item} = $glob{$item}\n"; } } print " routine '$key()'\n" if defined &glob; } } package Space_1; # Импортируем символы модуля в пакет Space_1 по категории CATEGORY_1 и смотрим что получилось. use MyModule qw{ :CATEGORY_1 }; main::printNamespace "Space_1", %Space_1::; package Space_2; # Импортируем символы модуля в пакет Space_2 по категории CATEGORY_2 и смотрим что получилось. use MyModule qw{ :CATEGORY_2 }; main::printNamespace "Space_2", %Space_2::; package Space_3; # Импортируем символы модуля в пакет Space_3 по категории SCALARS и смотрим что получилось. use MyModule qw{ :SCALARS }; main::printNamespace "Space_3", %Space_3::; package Space_4; # Категорию :DEFAULT вводит модуль Exporter и просто импортирует символы из массива @EXPORT вызываемого модуля. use MyModule qw{ :DEFAULT }; main::printNamespace "Space_4", %Space_4::; </source> Вывод программы будет следующим: <pre> Symbols in the 'Space_1' namespace: array '@cat1_arr': $cat1_arr [0] = 1 $cat1_arr [1] = 2 $cat1_arr [2] = 3 routine 'cat1_function1()' routine 'cat1_function2()' Symbols in the 'Space_2' namespace: routine 'cat2_function1()' hash '@cat2_hash': $cat2_hash {value} = 1 Symbols in the 'Space_3' namespace: scalar: $scalar1 = Scalar 1 scalar: $scalar2 = Scalar 2 Symbols in the 'Space_4' namespace: array '@cat1_arr': $cat1_arr [0] = 1 $cat1_arr [1] = 2 $cat1_arr [2] = 3 routine 'cat1_function1()' routine 'cat1_function2()' routine 'cat2_function1()' hash '@cat2_hash': $cat2_hash {value} = 1 scalar: $scalar1 = Scalar 1 scalar: $scalar2 = Scalar 2 </pre> Модуль, который мы используем, вводит три пользовательских тэга: <code>CATEGORY_1</code>, <code>CATEGORY_2</code> и <code>SCALARS</code>. Мы специально разделили клиентский код на 4 пакета для наглядности. В каждом пакете мы используем процедуру печати таблицы символов, которую мы рассматривали в [[../Пакеты, библиотеки и модули#Таблица символов пакета|Таблица символов пакета]]. В первом пространстве мы импортируем символы по категории <code>CATEGORY_1</code>, во-втором — <code>CATEGORY_2</code>, в третьем — <code>SCALARS</code>, а в четвертом мы используем категорию модуля <code>Exporter</code>, по которой импортируется весь <code>@EXPORT</code>. Обратите внимание, что в директиве <code>use</code> тэги всегда начинаются с двоеточия, чтобы модуль <code>Exporter</code> мог их отличать от экспортируемых символов. За один раз вы можете импортировать больше одной категории, а также мешать импорт по <code>@EXPORT_OK</code> с тэгами. Главный момент здесь — экспортируемый символ, по какому механизму он не передавался бы вызывающему коду, должен быть зарегистрирован в массиве <code>@EXPORT</code>. === Тонкости экспорта модулей === Чтобы директива <code>use</code> отрабатывала правильно, первой строкой модуль должен вводить пространство имен директивой <code>package</code>, причем имя пространства всегда должно совпадать с именем файла (без учёта расширения). Похожий подход используется в языке Java, где имя файла совпадает с именем первого публичного класса внутри файла исходного кода. В таком случае директива всегда неявно пытается найти и вызвать функцию <code>import()</code> внутри модуля. Например, если бы у нас существовал собственный не вложенный модуль с именем <code>MyModule</code>, то программа, вызывающая его, должна в служебном массиве <code>@INC</code> хранить директорию, в которой находится файл <code>MyModule.pm</code>, а директива <code>use</code> внутри вызывающего кода могла бы выглядеть так: <source lang="perl"> # Код вызывающей программы # ... # Мы передаем модулю список аргументов. use MyModule qw{ arg1 arg2 arg3 }; # ... no MyModule qw{ arg1 arg2 arg3 }; </source> Код самого модуля должен быть примерно таким: <source lang="perl"> # Код внутри файла MyModule.pm package MyModule; # ... sub import { # $self хранит имя модуля, а массив @args - переданные аргументы. my ( $self, @args ) = @_; print "import '$self'\n"; for (@args) { print " " . $_ . "\n"; } # ... } sub unimport { my ( $self, @args ) = @_; print "unimport '$self'\n"; for (@args) { print " " . $_ . "\n"; } } # ... </source> Во время экспорта модуля директивой <code>use</code>, она неявно найдет функцию <code>import()</code> и передаст ей аргументы <pre> import 'MyModule' arg1 arg2 arg3 </pre> Аналогично с директивой <code>no</code> — она будет неявно вызывать функцию <code>unimport()</code>: <pre> unimport 'MyModule' arg1 arg2 arg3 </pre> Обычно в качестве аргументов экспорта модуля, программист передает имена символов, которые должны быть загружены в таблицу символов вызывающего кода, но это не обязательно. В некоторых случаях вы можете передавать флаги или инструкции по режиму загрузки/выгрузки модуля. Чтобы аргументы загрузки модуля отличать от загружаемых символов, чаще всего разработчики помечают их символами двоеточия в начале имени, подобно атрибуту (например, <code>:DEFAULT</code> в модуле <code>Exporter</code>). До появления модуля <code>Exporter</code> разработчики часто писали свою реализацию метода <code>import()</code>. В большинстве случаев она будет похожа на что-то типа такого: <source lang="perl"> package MyModule; use strict; sub import { my ( $self, @args ) = @_; my $caller = caller(); # Отключаем ограничение, чтобы иметь возможность разрешать символические ссылки на функции. no strict "refs"; for my $arg (@args) { # Экспортируем функции текущего модуля в вызывающий его код путем # определения в таблице символов вызывающего кода ссылок на функции текущего модуля. # Мы это реализуем через символические ссылки, которые получаются конкатенацией # имени пакета модуля с именем символа, переданного модулю. Ожидается, что # клиентский код правильно передает имена, иначе такой трюк не пройдет. *{"${caller}::${arg}"} = sub { return &{__PACKAGE__ ."::$arg"}; }; } } #... sub function1 { print "Function 1\n"; } sub function2 { print "Function 2\n"; } 1; </source> Тогда вызывающий код может импортировать функции модуля в своё пространство так: <source lang="perl"> #!/usr/bin/perl use strict; # Обратите внимание, что мы импортировали только одну функцию модуля. use MyModule qw { function1 }; eval { &function1; &function2; }; print $@ if $@; </source> Вывод будет таким <pre> Function 1 Undefined subroutine &main::function2 called at run.pl line 9. </pre> Обратите внимание, что вызов первой функции модуля отрабатывает нормально, а второй вызов завершился аварийно, потому что <code>function2</code> мы не импортировали. В реальных программах следует отдавать предпочтение использованию модуля <code>Exporter</code> (см. документацию к модулю), так как он реализует множество тривиальных проверок. Свою реализацию нужно делать, только если этого модуля в дистрибутиве Perl нет, либо экспорт символов очень особенный. === Сложный модуль с вложенностями === Модули могут состоять из множества файлов, т.е. модуль может быть совокупностью меньших модулей. Разработчик обычно сохраняет Perl-код сложного модуля в отдельный каталог, в котором меньшие модули также могут быть разложены по каталогам для создания вложенности и структуры. Нет каких-то строгих правил, как разработчик это будет делать, но обычно с модулем поставляется так называемый загружающий его файл, который внутри себя организует инициализацию всего модуля, а прочие файлы модуля могут быть включены в клиентский код только через него. Другой ситуацией может быть, когда модуль состоит из нескольких обособленных подмодулей, связанные одной темой, но подключаемые через свои загружающие файлы. Для создания сложной иерархии, Perl заимствует идеи из языков программирования C++ и Java. Из Java берется идея использования структуры файловой системы для создания подобия Java-пакетов для исходных файлов, а у C++ способ создания вложенности у пространств имен. Для создания вложенной структуры у модуля, необходимо следовать следующим правилам: # Размещайте код модуля в каталоге, имя которого должно состоять из букв и цифр и не должно начинаться на цифру<ref>Так как имена пакетов могут отсылать на имена файлов в файловой системе, само собой разумеющееся, чтобы в них не было символов, которые недопустимы для самой файловой системы.</ref>. Имя каталога будет верхним уровнем пространства имен модуля. Это аналогично тому, как классы размещаются в пакетах на языке Java. Соответственно имена модулей лучше начинать с большой буквы. # Если подмодуль размещается в некотором каталоге (вложенном пакете), то в имени его пространства имен необходимо использовать два символа двоеточия <code>::</code> чтобы выразить вложенность, аналогично тому, как это делается в C++. Например, запись <code>package MyModule::SubModule::Util;</code> означает, что файл <code>Util.pm</code> должен быть расположен по пути <code>MyModule/SubModule/Util.pm</code>. # Чтобы сложный модуль можно было подключить, необходимо, чтобы в служебном массиве <code>@INC</code> был путь к директории, являющейся родительской по отношению к каталогу модуля. === Переопределение === Язык Perl поддерживает переопределение функционала (''overriding'') за счет использования модулей, причем необязательно в рамках объектно-ориентированного программирования. Переопределение позволяет вам использовать существующий код, изменяя его частично под текущие задачи. Например, множество модулей CPAN вводят, так называемые программные интерфейсы, а их конкретная реализация возлагается уже на другие модули. При желании, программист может подменить один конкретный модуль другим, при условии, что они используют одинаковый интерфейсный модуль. В этом случае, через интерфейсные вызовы, одни конкретные вызовы подменяются другими, что позволяет вам координально не менять архитектуру основного приложения. Основным инструментом в переопределении выступает массив <code>@ISA</code>, который хранит список пространств имен (модулей), которые нужно проверить по порядку в поисках функции, определения которой нет в таблице символов текущего пространства имен. Исполнение этого контролирует сам интерпретатор. Рассмотрим простейший пример переопределения. Этот пример не нужно использовать при написании реальных программ, но он приоткрывает завесу над тем, как примерно работает модуль <code>Exporter</code>. Предположим, что у нас есть интерфейсный модуль <code>InterfaceModule</code>, который объявляет функцию <code>sum</code>, которая принимает два числа, складывает их и возвращает ответ, т.н. базовая реализация. Пусть у нас есть первый конкретный модуль, который делает то же самое, но более продвинуто, в частности, в реализации этого модуля функции можно передавать сколько угодно слагаемых. И, наконец, пусть есть третий модуль, который ничего не переопределяет и использует интерфейсный вызов. Реализация этого может быть такой: <source lang="perl"> # Примечание: опущены несущественные для изложения директивы. #----------------------------------------------------------------------------- ## НАЧАЛО ИНТЕРФЕЙСНОГО МОДУЛЯ (представим, что он в отдельном файле) #----------------------------------------------------------------------------- package InterfaceModule; sub sum { # Когда функция переопределена в другом пакете или функция вызывается из # другого пакета по @ISA, в первом аргументе всегда хранится имя вызывающего # пакета, иначе список начинается сразу с передаваемых аргументов. Следующая # конструкция учитывает все эти варианты. my $caller = ref $_[0] eq __PACKAGE__ ? ref shift : scalar @_ > 2 ? ref shift : __PACKAGE__; my $arg1 = shift || 0; my $arg2 = shift || 0; print "$caller: $arg1 + $arg2\n"; return $arg1 + $arg2; } #----------------------------------------------------------------------------- ## НАЧАЛО МОДУЛЯ КОНКРЕТНОЙ РЕАЛИЗАЦИИ (представим, что он в отдельном файле) #----------------------------------------------------------------------------- package ConcreteModule_1; # Подгружаем родительский модуль в @ISA, чтобы иметь возможность переопределять метод. push @ConcreteModule_1::ISA, 'InterfaceModule'; # Вызов переопределенной реализации. print $self->sum(2, 2), "\n"; # В переопределенной версии можно передавать больше одного аргумента. print $self->sum(2, 2, 3, 6), "\n"; # Вызов может быть непосредственно от имени пакета (ссылка конструируется за вас). print ConcreteModule_1->sum(10, 11, 12, 13), "\n"; # Не играет роли в какой части модуля начинать переопределение, так как связывание происходит динамически. sub sum { my ( $self, @args ) = @_; print STDOUT (ref $self) . ": " . (join " + ", @args) . "\n"; my $result = 0; $result +=$_ for @args; return $result; } BEGIN { # Чтобы иметь возможность использовать @ISA, нам нужно получить ссылку на текущий модуль. $self = {}; bless $self, __PACKAGE__; } #----------------------------------------------------------------------------- ## НАЧАЛО МОДУЛЯ ДРУГОЙ КОНКРЕТНОЙ РЕАЛИЗАЦИИ (представим, что он в отдельном файле) #----------------------------------------------------------------------------- package ConcreteModule_2; push @ConcreteModule_2::ISA, 'InterfaceModule'; # Интерфейсная реализация может быть вызвана по @ISA ... print $self->sum(3, 3), "\n"; # ... либо напрямую от имени пакета ... print ConcreteModule_2->sum(6, 6), "\n"; # ... либо вы можете использовать квалифицированный вызов, но это не так гибко, так как вы привязываетесь к интерфейсу. print InterfaceModule::sum(4, 4), "\n"; BEGIN { # Чтобы иметь возможность использовать @ISA, нам нужно получить ссылку на текущий модуль. $self = {}; bless $self, __PACKAGE__; } </source> Конкретно для этого примера мы опустили много директив, которые нужны, когда модули разнесены по файлам. Здесь мы имитируем работу <code>Exporter</code> через конструктор пакета (<code>BEGIN</code>). Единственное, что тут не показано от модуля <code>Exporter</code> это создание т.н. ''wrapper-функций'', которые будут размещаться в таблице символов конкретного пакета и через которые вызовы пробрасываются на родительские (интерфейсные) реализации методов. Эти функции строятся соответственно по массивам <code>@EXPORT</code> и <code>@EXPORT_OK</code>. Если вызвать эту программу, мы получим такой ответ: <pre> ConcreteModule_1: 2 + 2 4 ConcreteModule_1: 2 + 2 + 3 + 6 13 : 10 + 11 + 12 + 13 46 ConcreteModule_2: 3 + 3 6 : 6 + 6 12 InterfaceModule: 4 + 4 8 </pre> Чтобы механизм переопределения заработал, мы должны построить ссылку на текущий модуль (в главе [[Некоторые сведения о Perl 5/Объектно-ориентированное программирование в Perl|Объектно-ориентированное программирование в Perl]] вы узнаете, что в Perl так строятся классы, а демонстрируемый вызов — это вызов статической функции пакета), которая строится в конструкторе пакета через вызов встроенной функции <code>bless</code>. Далее, пользуясь этой ссылкой, мы обращаемся к функциям пакета через разыменовывание ссылки на функцию. После этого весь механизм позднего связывания берет на себя интерпретатор. Так, в реализации второго модуля, этот механизм без проблем нашел переопределение базовой реализации, даже несмотря на то, что её определение находится позже вызова. В третьем модуле механизм позднего связывания не находит реализации функции <code>sum</code>, поэтому он обращается к массиву <code>@ISA</code> и пытается найти функцию в ближайшем (слева на право в списке <code>@ISA</code>) пакете, коей является интерфейсная реализация. === Перегрузка === ''Перегрузка'' (''overloading'') — это возможность вызывать процедуру/функцию с различающимися по типу аргументами в отдельные моменты времени, возможно, в разных комбинациях. В языке Perl нет каких-то специальных синтаксических конструкций для создания перегрузки, но язык сам по себе достаточно гибкий, чтобы перегрузку эмулировать. Подходы могут быть самые разные: * Самое простое — это проанализировать, что хранится во входящем массиве <code>@_</code> и через ветвления выполнять соответствующие действия. * Если алгоритм процедуры сильно отличается при различных типах аргументов, можно реализовать несколько технологических функций, которые никогда не будут вызываться из основного приложения, и будут прятаться в пакете, а управление им передавать через фасадную функцию, которая будет анализировать массив <code>@_</code> и отдавать управление нужной функции. * Если есть такая возможность, можно попытаться различные комбинации входящих параметров приводить к некоторому единому варианту, а затем вызывать единственную реализацию. Некоторые паттерны проектирования перегруженных функций перечислены ниже: * Анализ количества входящих аргументов:<source lang="perl"> sub overloaded { # ... if (@_ >= 2) { # Передано два и больше аргументов. } elsif (@_ == 1) { # Передан один аргумент. } elsif (!@_) { # Ничего не передано. } # ... } </source> * Анализ типа входящих аргументов:<source lang="perl"> sub overloaded { # ... if (ref $_[0] eq 'ARRAY') { # Передана ссылка на массив. } elsif (ref $_[0] eq 'HASH') { # Передана ссылка на хеш. } else { # Передано, что-то другое или ничего не передано. } # ... } </source> * Перегрузка через таблицу перегрузки:<source lang="perl"> # Таблица перегрузки. our %_handlers = ( "operation1" => \&_variant1, "operation2" => \&_variant2, ); sub overloaded { my $oper_id = shift; $_handlers{$oper_id}->(@_) if exists $_handlers{$oper_id}; } sub _variant1 { print "Called '_variant1': @_\n"; } sub _variant2 { print "Called '_variant2': @_\n"; } # ... overloaded "operation1", 1, 2, 3; overloaded "operation2", 1, 2, 3, 4, 5; </source> Кроме этого, стандартная библиотека Perl имеет стандартную директиву <code>overload</code>, которая позволяет перегружать некоторые операции по отношению к классу, например: <source lang="perl"> package OverloadedPackage; # Перегрузка операции заключения в кавычки. use overload q{""} => 'to_string'; sub to_string { my $self = shift; return "called overloaded implementation"; } sub new { $self = {}; bless $self; return $self; } $var = OverloadedPackage->new; print "Demo: " . "$var", "\n"; # Вызывается подстановочный контекст. print "Demo: " . $var, "\n"; # Для конкатенации подстановочный контекст также вызывается. # Результат: # Demo: called overloaded implementation # Demo: called overloaded implementation </source> Но мы забегаем с предыдущим примером вперед, так как это уже относится к перегрузке операторов для классов (как в C++). === Атрибуты === В Perl есть возможность прикрепить к некоторому типу данных специальную метку (в общем случае несколько меток), называемую ''атрибутом''. Атрибуты несут в себе некоторую мета-информацию, которая может быть использована при загрузке пакета в пространство, чтобы, например, инициализировать глобальные переменные, сгенерировать процедуры или собрать информацию о пакете, чтобы другие пакеты знали, как с ним работать. Если проводить аналогии с другими языками программирования, то атрибуты по смыслу очень похожи на аннотации в языке Java. Если размышлять в контексте современных паттернов проектирования приложений, атрибуты могут использоваться для декорирования методов; с помощью них можно делать проверки допустимости значений перед инициализацией. Также вы можете привнести парадигму ''аспектно-ориентированного программирования'' в язык Perl, например, чтобы отслеживать контекст выполнения процедур. Атрибуты могут использоваться в тестировании, например, чтобы помечать тестирующие процедуры. В объектно-ориентированной парадигме, через атрибуты можно проверять правильность использования класса, например, можно имитировать проверку инкапсуляции данных класса и прерывать исполнение программы, если программист, использующий ваш класс, нарушает её в некоторой части программы. Чтобы навесить атрибут на переменную, нужно после её имени через двоеточие написать имя атрибута, например так: <source lang="perl"> my $scalar0 : MyAttribute = 300; # Пробел после двоеточия необязателен. my $scalar1 :Attribute = 400; # Атрибут может нести параметр. С точки зрения интерпретатора, это просто строковый литерал. my $scalar2 : MyAttribute(parameter) = 300; # Атрибутов при желании может быть больше одного. Все они отделяются друг от друга двоеточием. my $scalar3 : MyAttribute : MyAttribute_1(param1=value1, param2=value2) = 100; </source> Так как в Perl некоторые стандартные модули тоже объявляют атрибуты, чтобы не конфликтовать с ними, рекомендуется пользовательские атрибуты всегда именовать с большой буквы. Атрибуты на процедуры навешиваются похожим способом: <source lang="perl"> sub procedure :MyAttribute :MyAttribute_1(param) { return 0; } </source> Недостаточно просто навесить атрибут: пакет, в котором используется хотя бы один атрибут, должен объявить одну или несколько процедур обработки атрибутов (что-то похожее требуется и в Java для обработки аннотаций). На каждый тип данных, на которых есть атрибуты, нужно объявить по одному обработчику, имена которых строятся по такому принципу: <source lang="perl"> sub MODIFY_<тип-данных>_ATTRIBUTES { ... } # Например, обработчик для атрибутов всех скаляров будет: sub MODIFY_SCALAR_ATTRIBUTES { ... } # А обработчик для всех функций: sub MODIFY_CODE_ATTRIBUTES { ... } # и так далее по аналогии. Т.е. нужно использовать идентификатор, возвращаемый ref. </source> Обработчики всегда вызываются автоматически, единственное, что момент вызова для процедур и для прочих типов данных различный: для процедур обработчик атрибутов вызывается сразу за конструкторами пакета <code>BEGIN</code>, а для других типов данных — в момент инициализации значением. Обработчик атрибутов обычно имеет такую реализацию: <source lang="perl"> sub MODIFY_<тип-данных>_ATTRIBUTES { my $package = shift; my $source = shift; my @attributes = @_; ######### # Обработка атрибутов ... while (defined (my $attr = pop @attributes)) { # ... } return @attributes; } </source> Обработчик атрибутов в первом аргументе принимает пакет, в котором атрибут встретился; второй аргумент — это ссылка на объект типа данных, возле которого стоит атрибут и затем идет список атрибутов в порядке, в котором они объявлены. В идеале процедура должна вернуть пустой список, что означает что обработка всех атрибутов прошла успешно. Иначе процедура может вернуть не пустой массив с некоторыми атрибутами в нём, что означает что в этих атрибутах есть какие-то ошибки. Следующий пример демонстрирует процедуру обработки атрибутов скаляров и функций внутри пакета <code>main</code>. Так как мы будем просто печатать атрибуты, мы напишем универсальную функцию, а обработчики атрибутов мы сгенерируем динамически. <source lang="perl"> use strict; # Генерирует обработчики процедур для функций и скаляров. Внутри реализации мы просто вызываем # функцию '__attribute_processor', которой передаются аргументы обработчика. BEGIN { no strict 'refs'; use subs qw { __attribute_processor }; foreach my $datatype ('CODE', 'SCALAR') { *{'MODIFY_' . $datatype . '_ATTRIBUTES'} = sub { print 'MODIFY_' . $datatype . '_ATTRIBUTES' . "\n"; __attribute_processor @_; }; } } # Процедура просто печатает все прикрепленные атрибуты. sub __attribute_processor { my $package = shift; my $source = shift; my @attributes = @_; print "Package: $package\nData: $source\n"; my $counter; while (defined (my $attr = pop @attributes)) { print " Attribute #" . ++$counter . ": $attr\n"; } return @attributes; } my $scalar0 : MyAttribute = 300; my $scalar1 :Attribute = 400; my $scalar2 : MyAttribute(parameter) = 300; my $scalar3 : MyAttribute : MyAttribute_1(param1=value1, param2=value2) = 100; sub procedure :MyAttribute :MyAttribute_1(param) { return 0; } </source> <pre> MODIFY_CODE_ATTRIBUTES Package: main Data: CODE(0xa00069ba8) Attribute #1: MyAttribute_1(param) Attribute #2: MyAttribute MODIFY_SCALAR_ATTRIBUTES Package: main Data: SCALAR(0xa0003ab20) Attribute #1: MyAttribute MODIFY_SCALAR_ATTRIBUTES Package: main Data: SCALAR(0xa00053018) Attribute #1: Attribute MODIFY_SCALAR_ATTRIBUTES Package: main Data: SCALAR(0xa00069dd0) Attribute #1: MyAttribute(parameter) MODIFY_SCALAR_ATTRIBUTES Package: main Data: SCALAR(0xa000591d0) Attribute #1: MyAttribute_1(param1=value1, param2=value2) Attribute #2: MyAttribute </pre> По отладочной печати вы можете видеть, что <code>MODIFY_CODE_ATTRIBUTES</code> вызывается сразу за всеми конструкторами пакета, <code>MODIFY_SCALAR_ATTRIBUTES</code> — в порядке объявления скаляров. Обратите внимание, что во втором аргументе передается ссылка на программный объект, по которой вы можете его видоизменять в зависимости от переданных атрибутов и от их логики. Чтобы пример был более конкретным, давайте объявим декорирующий атрибут с именем <code>print_before</code>, который добавляет к процедуре, использующей этот атрибут, вызов декорирующей функции перед исполнением непосредственно кода самой процедуры. Реализовать это можно к примеру так. <source lang="perl"> # Процедура, которая вызывается для атрибута 'print_before'; sub __print_before_execution { print "*** START PROCEDURE ***\n"; print "** Args: @_\n"; print "***********************\n"; } sub MODIFY_CODE_ATTRIBUTES { my $package = shift; my $source = shift; my @attributes = @_; my @allowed_attrs = qw{ print_before }; my @bad_attrs; # Для получения имени процедуры по ссылке. use B qw(svref_2object); while (defined (my $attr = pop @attributes)) { if ( grep( /^$attr$/, @allowed_attrs ) ) { my $sub_name = svref_2object($source)->GV->NAME; if ($attr eq 'print_before') { no strict 'refs'; # Переопределяем таблицу символов пакета, внедряя декоратор в вызов процедуры с атрибутом. *{$package . '::' . $sub_name} = sub { __print_before_execution @_; # Это декоратор. &$source(@_); # Это декорируемая процедура. } } } else { push @bad_attrs, $attr; } } return @bad_attrs; } # Декорируем первую процедуру. sub test_procedure :print_before { print "In the 'test_procedure': @_\n"; } # Декорируем вторую процедуру. sub another_procedure :print_before { } test_procedure 1, 2, 3; another_procedure "AAA", "BBBB", 3; </source> <pre> *** START PROCEDURE *** ** Args: 1 2 3 *********************** In the 'test_procedure': 1 2 3 *** START PROCEDURE *** ** Args: AAA BBBB 3 *********************** </pre> На таком простом примере можно видеть, как много вспомогательного кода нужно написать. На практике проще воспользоваться встроенным модулем <code>Attribute::Handlers</code>, который работает похоже. Если переписать предыдущий пример с использованием библиотечного модуля, реализация будет такой. <source lang="perl"> use Attribute::Handlers; sub __print_before_execution { print "*** START PROCEDURE ***\n"; print "** Args: @_\n"; print "***********************\n"; } sub print_before : ATTR(CODE) { my ($package, $symbol, $referent, $attr, $data, $phase, $filename, $linenumber) = @_; my $function_name = *{$symbol}{NAME}; my $new = sub { my $params = join ', ', @_; __print_before_execution($params); my @results = $referent->(@_); return @results; }; no warnings qw(redefine); *$symbol = $new; } # Декорируем первую процедуру. sub test_procedure :print_before { print "In the 'test_procedure': @_\n"; } # Декорируем вторую процедуру. sub another_procedure :print_before { } test_procedure 1, 2, 3; another_procedure "AAA", "BBBB", 3; </source> Результат аналогичен предыдущему. === Bootstrapping === Ещё один частый приём, связанный с модулями, это использование их окружения, как площадку для вызова более серьезной процедуры (так называемый ''bootstrapping''). Этот приём часто используется при написании Perl-приложений как утилит командной оболочки. Прием реализуется через опцию <code>-M</code> интерпретатора Perl, который позволяет сделать импорт указываемого модуля из командной оболочки. При этом модуль обычно не имеет сложной основной процедуры, а предоставляет коллекцию процедур, которые пользователь выбирает произвольно через опцию <code>-e</code>. Продемонстрируем этот приём на конкретном примере. <source lang="perl"> package Cmd; use strict; use warnings; require Exporter; our @ISA = qw { Exporter }; our @EXPORT = qw { print_hello cat }; sub expand { @ARGV = map(/'*?'/o ? glob($_) : $_, @ARGV); } sub cat { expand(); print while (<>); } sub print_hello { print "Hello, World!\n"; } </source> Модуль <code>Cmd</code> вводит две процедуры: * <code>cat</code> — процедура, которая имитирует утилиту командной оболочки <code>cat</code>. * <code>print_hello</code> — выводит на экран терминала строку <code>Hello, World!</code>. Так как модуль <code>Cmd</code> не установлен в общеизвестные директории Perl, нам нужно дополнительно воспользоваться директивой <code>lib</code> (описанной ниже), но в общем случае вызов любой из этих процедур будет таким. <source lang="bash"> # Если бы наш модуль был установлен в общеизвестные директории Perl, вызов, например # процедуры print_hello, был бы таким. $ perl -MCmd -e print_hello # Но в этом примере мы должны вызывать процедуру так: $ perl -Mlib='.' -MCmd -e print_hello Hello, World! </source> Любая процедура может захватить аргументы командной строки. Это можно продемонстрировать на процедуре <code>cat</code>. <source lang="bash"> $ cat > file.txt <<EOF line 1 line 2 line 3 EOF $ perl -Mlib='.' -MCmd -e cat -- file.txt line 1 line 2 line 3 </source> Чтобы этот приём работал, вы должны воспользоваться библиотекой <code>Exporter</code>, которая добавляет в основное пространство приложения процедуры нашего модуля. Далее мы можем вызывать их без квалификатора пакета через опцию <code>-e</code>. Необязательно вызывать эти процедуры по одной: на самом деле вы можете передать небольшую программу, которая будет вызывать их некоторым образом. Также вы можете видеть на примере директивы <code>lib</code>, что если написать процедуру <code>import()</code> для модуля, можно передавать параметры самому модулю, делая тем самым сложные переключения. Основное преимущество ''bootstrapping'' заключается в том, что ваши инструкции запускаются под интерпретатором Perl, что защищает весь вызов от разницы между операционными системами, делая утилиту более портируемой. Также, написанный однажды, код может многократно использоваться в различных комбинациях. === Базовые модули Perl === В стандартной поставке Perl включено множество стандартных модулей, некоторые из которых мы перечислим в приложении (см. [[Некоторые сведения о Perl 5/Приложения#Библиотечные модули Perl]]). Помимо них, за много лет существования Perl, была создана огромная коллекция модулей CPAN (''Comprehensive Perl Archive Network''), доступ к которой можно получить через Интернет. Обычно вы должны сначала посмотреть не была ли решена ваша задача в виде некоторого модуля CPAN. Если такой модуль существует, вам следует загрузить его и установить в своей системе. Исходные тексты всех модулей Perl распространяются открыто, поэтому вы всегда сможете познакомиться с тем, как они работают. Чтобы посмотреть, какие модули установлены в вашей дистрибутивной сборке Perl, можно воспользоваться следующей консольной командой, которая ищет все файлы с расширением <code>.pm</code> по путям в массиве <code>@INC</code>: <source lang="bash"> $ find $(perl -e 'print "@INC"') -type f -name "*.pm" -print </source> ==== Прагма-библиотеки ==== Компилятором Perl можно управлять с помощью специальных модулей, объявляющих особые директивы. Данные директивы обычно используются чтобы запретить некоторые конструкции языка Perl (ужесточить проверки, чтобы сделать код более предсказуемым), выводить предупреждения или отладочные сообщения и многое другое. Такие библиотеки мы называем ''библиотеками директив компилятора'' или просто ''прагма-библиотеками'' (''pragmas''). Как и любые другие модули, директивы подключаются с помощью <code>use()</code> и отключаются с помощью <code>no()</code>. Обычно директива применяется ко всему пакету/библиотеке/модулю, либо директивы применяют к отрезку программы. Например, чтобы ускорить вычисления, директивой <code>integer</code> можно временно запретить вычисления с плавающей точкой, оставив только целочисленные: <source lang="perl"> print 2 / 3, "\n"; # 0.666666666666667 use integer; print 2 / 3, "\n"; # 0 no integer; print 2 / 3, "\n"; # 0.666666666666667 </source> В дистрибутивный комплект Perl входит стандартный набор прагма-библиотек. Некоторые из них мы рассмотрим ниже. С прагма-библиотеками следует быть осторожными, так как от релиза к релизу они могут менять поведение. Большинство учебников по Perl не успевают за этими изменениями, поэтому сведения из очень старых уже не актуальны для последних релизов языка. Этим мы хотим сказать, что не ленитесь сверяться с документацией к конкретному релизу на [https://perldoc.perl.org perldoc.perl.org]. ===== Директива strict ===== Очень полезная директива, которая запрещает использование ''небезопасных конструкций'' языка. Многие подходы в программировании на Perl, которые в старых релизах интерпретатора считались допустимыми, со временем стали небезопасными из-за возможности возникновения скрытых ошибок. В новых релизах документация к Perl обычно рекомендует новые подходы, не запрещая старые для сохранения обратной совместимости. Чтобы запретить использование старых методов и не давать искушения программисту их где-либо использовать в новом коде, следует в начале любого исходного файла вводить эту директиву. Директива обычно применяется к файлу или отдельному блоку. <source lang="perl"> use strict; # Аналогично следующим трем вызовам: # Запрещает объявление переменных без явного указания их области видимости use strict "vars"; # Запрещает символические ссылки use strict "refs"; # Ужесточает правила для идентификаторов: # если идентификатор не заключен в фигурные скобки и не стоит # слева от =>, то нельзя его записывать без кавычек и без идентификатора типа. # При этом, если он является именем процедуры, то это ошибкой не считается. use strict "subs"; </source> Ниже приведены антипримеры того, что запрещает директива. <source lang="perl"> # Примечание: везде, где написано НЕЛЬЗЯ, оператор запретит директива. use strict 'refs'; $ref = \3.1415; print $$ref, "\n"; # МОЖНО: разыменовывается жесткая ссылка. $ref = "foo"; print $$ref, "\n"; # НЕЛЬЗЯ: попытка разыменовать символическую ссылку. $file = "STDOUT"; print $file "Hi!"; # НЕЛЬЗЯ: без запятой после $file и без директивы, интерпретатор # попытался бы разрешить символическую ссылку, однако сейчас они # запрещены директивой, поэтому эта строка не скомпилируется. # ПРАВИЛЬНО $file = *STDOUT; print $file "Hi!"; # Есть одно ИСКЛЮЧЕНИЕ из правил. $bar = \&{'foo'}; &$bar; # МОЖНО: ссылка на функцию разрешится как символическая. </source> <source lang="perl"> # Примечание: везде, где написано НЕЛЬЗЯ, оператор запретит директива. use strict 'vars'; $main::var = 1; # МОЖНО: есть квалификатор пакета $var1 = 2; # НЕЛЬЗЯ: область видимости не указана явно. our $var1 = 2; # МОЖНО: our определяет область видимости пакета. my $lexical = 3; # МОЖНО: my определяет лексическую область видимости. local $var1 = 4; # МОЖНО: потому что переменная $var1 была к этому моменту определена. local $var2 = 5; # НЕЛЬЗЯ: переменная $var2 должна быть определена к этому моменту, # даже несмотря на то, что local определяет видимость. package MyPackage; our $var3 = 6; # МОЖНО: our определяет область видимости пакета. </source> <source lang="perl"> # Примечание: везде, где написано НЕЛЬЗЯ, оператор запретит директива. use strict 'subs'; sub func { return 0 } $scalar = string; # НЕЛЬЗЯ: нужны кавычки для литерала. $scalar = "string"; # ПРАВИЛЬНО func 3, arg2; # НЕЛЬЗЯ: второй аргумент должен быть закавычен. func 3, "arg2"; # ПРАВИЛЬНО $ref = \&func; # МОЖНО: потому что func это имя функции. </source> До версии интерпретатора 5.36 эту директиву нужно было прописывать всегда явно. Начиная с версии 5.36 достаточно писать следующим образом: <source lang="perl"> use v5.36; # Директива 'strict' включается неявно. ... </source> Здесь же отметим, что до недавнего времени (а конкретнее до Perl 5.6.0) при включенной <code>use strict 'vars';</code>, глобальные переменные нужно было объявлять через директиву <code>vars</code>, например<source lang="perl"> use vars qw($frob @mung %seen); </source> С версии Perl 5.6.0 глобальные переменные пакета <u>следует объявлять исключительно</u> через функцию <code>our</code>. ===== Директива lib ===== Директива <code>lib</code> позволяет редактировать массив <code>@INC</code> из программы. Напомним, что этот массив используется для определения путей, по которым нужно искать модули и библиотеки. <source lang="perl"> # Добавит список к тому, что уже есть в массиве. use lib <список-директорий>; # Очистит @INC целиком no lib; </source> Вы можете только добавлять конкретные пути в массив. С помощью директивы удалить можно только сразу все пути. Следует аккуратно удалять пути, так как некоторыми из них могут пользоваться уже загруженные модули. Вернемся к примеру, где мы писали свой модуль. В основной программе мы могли бы добавить нужные директивы для поиска модуля. <source lang="perl"> use strict; # Добавим директиву, чтобы ужесточить проверки. use lib qw{ . }; # Добавим текущую рабочую директорию в @INC. use TestModule qw{ :DEFAULT $scalar }; test "one", "two", "three", "four"; printContent; print __PACKAGE__ . ": TestModule::Scalar = $scalar\n"; </source> ====== Вычисление каталога с библиотеками относительно исполняемого файла ====== На практике иногда программы на Perl поставляются встраиваемыми, т.е. со всеми зависимостями в комплекте. Обычно все зависимые библиотеки в этом сценарии запуска располагаются в директории <code>lib/</code> рядом с запускающим файлом. Пользователя программы не должно волновать, как зависимые библиотеки будут подключаться к приложению, т.е. запускающий файл сам должен уметь отыскивать каталог <code>lib/</code>. Эта проблема решается с помощью директивы <code>lib</code>, которой передается директория расположения файла запускающего сценария. Но каким образом узнать эту директорию? Вычислить её нельзя, так как директива <code>lib</code> является директивой времени компиляции, и путь не может быть вычислен из программы Perl до момента окончания процесса компиляции, другими словами, возникает ''[[w:Проблема курицы и яйца|проблема курицы и яйца]]''. К счастью в поставке Perl 5 идёт стандартный модуль <code>FindBin</code>, который позволяет вернуть директорию, в которой находится файл с программой. Данный модуль несёт в себе переменную <code>$Bin</code>, которая в каждый момент хранит путь до файла с Perl программой. Следующий сниппет используется, чтобы добавить каталог <code>$(pwd)/lib</code> в массив <code>@INC</code>. <source lang="perl"> #!/usr/bin/perl use FindBin; use File::Spec; use lib File::Spec->catdir($FindBin::Bin, '..', 'lib'); # ... Ваша программа print "@INC", "\n"; </source> Мы используем дополнительно функцию <code>catdir()</code> стандартного модуля <code>File::Spec</code>, чтобы сформировать путь с правильными разделителями: <code>/</code> для *nix систем и <code>\</code> — для Windows. Потенциально путь до <code>lib</code> может быть сколь угодно сложным, поэтому мы используем здесь конкатенацию его частей для универсальности. Модуль <code>FindBin</code> можно вызывать только один раз, другими словами путь формируется правильно только для того модуля, который вызывает его самым первым. На практике обычно этого достаточно, потому что более сложные схемы разворачивания обычно устанавливают библиотечные модули в общеизвестные директории. ===== Директива subs ===== Данная директива позволяет определить процедуры до их фактического определения. В основном это используется для того, чтобы вызывать их без скобок вокруг аргументов и без идентификатора <code>&</code>. <source lang="perl"> use subs <список-имен-процедур>; </source> Пример <source lang="perl"> example1 1, 2, 3; # НЕЛЬЗЯ: функция еще к этому моменту не определена. example1 (1, 2, 3); # ПРАВИЛЬНО: в этой точке скобки обязательны. use subs qw{ example1 example2 example3 }; example1 1, 2, 3; # МОЖНО: функция как бы определена к этому моменту через директиву. sub example1 { return 0 } sub example2 { return 0 } sub example3 { return 0 } </source> Директива применяется ко всему пакету, где бы она не использовалась. Действие директивы нельзя отменить через <code>no</code>. Технически директива просто готовит гнездо в таблице символов пакета, заполняя его пустой реализацией, что и позволяет вам вызывать функции без скобок:<source lang="perl"> use feature 'try'; use subs 'example'; # Для example было занято место в таблице символов и есть примитиваная реализация. try { # Бросает исключение, так как конкретной реализации мы не предоставили. example } catch ($msg) { print "Exception: $msg"; } </source> <pre> Exception: Undefined subroutine &main::example called at .\subs.pl line 6. </pre> Теперь предоставим реализацию:<source lang="perl"> use feature 'try'; use subs 'example'; sub example {} try { # Исключение не выбрасывается. example } catch ($msg) { print "Exception: $msg"; } </source> С помощью этой директивы также можно вмешиваться в таблицу символов со встроенными функциями Perl, но только в текущем пакете. Это происходит потому, что она форсированно переписывает слой <code>CORE::</code>. <source lang="perl"> use feature 'say'; package Example; use subs 'time'; sub time { print "Hello\n"; } package main; # Вызывается CORE реализация. say time; package Example; # Вызывается переопределенная реализация. say time; </source> <pre> 1792239499 Hello 1 </pre> ===== Директива parent ===== Используется, чтобы работать с массивом <code>@ISA</code> не напрямую, а через директиву. Позволяет добавлять модули в массив <code>@ISA</code>, чтобы, как это было описано выше, искать функции в родительских модулях, если их нет в текущем. Например, запись <source lang="perl"> package CurrentModule; use parent qw { ParentModule_1 ParentModule_2 }; </source> аналогична <source lang="perl"> package CurrentModule; BEGIN { require ParentModule_1; require ParentModule_2; push @ISA, qw(ParentModule_1 ParentModule_2); } </source> По умолчанию ожидается, что родительские модули лежат в разных файлах, но пространства родителей могут лежать в том же файле что и модуль (обычно в отладочных целях). Чтобы иметь возможность подключить их код директивой, нужно передать ей параметр <code>-norequire</code>, чтобы не использовать механизм <code>require</code> для поиска кода: <source lang="perl"> package ParentModule_1; # ... package ParentModule_2; # ... package CurrentModule; use parent -norequire, 'ParentModule_1', 'ParentModule_2'; </source> что аналогично записи <source lang="perl"> # ... push @CurrentModule::ISA, 'ParentModule_1', 'ParentModule_2'; </source> Флаг также может использоваться, когда файл библиотеки подключается явным <code>require</code>, но пространство имен внутри родителей имеет имя отличное от имени их файла. Обычно так стараются не делать, но такие ситуации тоже можно обходить. Данная директива имеет более старую версию <code>base</code>, которая работает похожим образом, но ей не рекомендуется пользоваться, так как она ориентирована на работу совместно с директивой <code>fields</code>, что ухудшает её производительность. ===== Директива warnings ===== Данная директива позволяет управлять предупреждениями интерпретатора Perl. Рекомендуется всегда включать эту директиву в релизном коде, так как она является продолжением директивы <code>strict</code> и позволяет выявлять большинство небезопасных конструкций, которые могут негативно повлиять на исполнение или, в будущем, на обратную совместимость кода. Ваша задача писать код так, чтобы не возбуждалось ни одного предупреждения. Однако, в отличие от <code>strict</code>, эта директива не запрещает использовать сомнительную конструкцию и не останавливает исполнение, а просто предупреждает, что она сомнительная. Директива может включаться разными способами: * Путем прямого включения директивы:<source lang="perl"> use warnings; # или use warnings 'all'; </source> * До версии Perl 5.6 директива обычно включалась через ключ командной строки:<source lang="perl"> #!/usr/local/bin/perl -w </source>Если вызывать интерпретатор с <code>-W</code>, то он принудительно включает предупреждения во всей программе, независимо от того, как вызывается директива <code>warnings</code>, а опция <code>-X</code> принудительно отключает все предупреждения. * С версии 5.35 директива включается неявно:<source lang="perl"> use v5.35; # и выше # директива включается неявно. </source> * Поднимая или опуская флаг <code>$^W</code>, можно включать или отключать предупреждения, однако этот метод использовался до появления <code>use</code> и не так очевиден, как использование <code>use</code> и <code>no</code>. Внутри интерпретатора все предупреждения разделены на большое число категорий, с которыми можно ознакомиться на странице документации<ref>[https://perldoc.perl.org/warnings#Category-Hierarchy Категории предупреждений директивы warnings]</ref>. Категоризация позволяет вам отключать не все предупреждения, а только некоторые. Обычно это нужно, когда вы сознательно идёте на использование сомнительной конструкции. По умолчанию директива включает все предупреждения, но на некотором участке кода можно включить только конкретные:<source lang="perl"> use warnings qw(void redefine); # Включает предупреждения void контекста, а также о случаях # переопределения в одном пространстве имен. </source> Подобным образом можно отключать конкретные предупреждения:<source lang="perl"> no warnings qw(io syntax untie); # Подавляет предупреждения о сомнительном использовании модуля IO, # странных синтаксических конструкциях и на неправильном использовании # функции untie. </source> Следует помнить, что структура категорий не сразу стала такой, какой она показана в последней версии документации, а также она может изменяться от релиза к релизу. Некоторые предупреждения можно пометить фатальными, т.е. такими, которые должны прервать компиляцию программы:<source lang="perl"> use warnings FATAL => qw(void); # Использование void контекста строго запрещено. </source> ===== Директива constant ===== Директива <code>constant</code> позволяет вам объявить константу времени компиляции. Ниже показано несколько способов вызова директивы. <source lang="perl"> # Простая константа use constant MYCONST_1 => 1; # Списковая константа use constant WEEKDAYS => qw { Sunday Monday Tuesday Wednesday Thursday Friday Saturday }; # Константа может хранить ссылку. Константна только ссылка, но не данные, # на которые ссылка указывает. use constant ARRAY => [1..4]; # Объявление нескольких констант за один вызов use constant { PI => 3.141595, STRING_1 => "Hello, World", EXPRESSION => 2 + 2 * 2, }; # -------------------------------------------------- # Константа будет заменена на значение в выражении на этапе компиляции. print "MYCONST_1 = " . MYCONST_1 . "\n"; print "EXPRESSION = " . EXPRESSION . "\n"; print "STRING_1 = " . STRING_1 . "\n"; # Константа WEEKDAYS хранит список слов и не является массивом. В контексте # следующего вызова массив должен быть построен через круглые скобки до индексации. print "Today is ", (WEEKDAYS)[ (localtime)[6] ], ".\n"; # Константа ARRAY хранит ссылку на массив. Чтобы получить размер массива, мы # должны разыменовать ссылку и вызвать скалярный контекст. Но для некоторых операций # нельзя использовать "голые" слова, так как будут производиться попытки интерпретировать # их как простые строки. Для таких случаев константу необходимо сопровождать парой скобок, # как показано ниже, либо поставить знак '+' перед константой. for ($i = 0; $i < scalar @{ ARRAY() }; $i++) { print "ARRAY[$i] = " . ARRAY->[$i] . "\n"; } # Или так for ($i = 0; $i < scalar @{ +ARRAY }; $i++) { print "ARRAY[$i] = " . ARRAY->[$i] . "\n"; } </source> * По соглашению, имена констант всегда должны записываться в верхнем регистре, хотя язык этого не требует. Это убережет от конфликта по именам, а также выделяет константы в тексте программы. Имя константы обычно начинается на букву, но может начинаться на одно нижнее подчеркивание. Имена констант, начинающиеся на два нижних подчеркивания, зарезервированы для внутреннего использования Perl. Также зарезервированы имена <code>STDIN</code>, <code>STDOUT</code>, <code>STDERR</code>, <code>ARGV</code>, <code>ARGVOUT</code> <code>ENV</code>, <code>INC</code> и <code>SIG</code>. * Константы, объявляемые этой директивой, подставляются на этапе формирования кодов операций, т.е. на этапе компиляции Perl кода. Это позволяет компилятору, при необходимости, оптимизировать выражение в месте их подстановки. В частности, вставка константы исключает накладные расходы, связанные с вызовом процедур. * Определения констант не могут быть раскручены в пределах одной директивы <code>constant</code>:<source lang="perl"> use constant { BITMASK => 0xAFBAEBA8, NEGMASK => ~BITMASK, # НЕПРАВИЛЬНО: в этот момент компилятор еще не знает об определении BITMASK. }; </source> * Константы принадлежат пакету, в котором они объявляются. Чтобы обратиться к константе из другого пакета, нужно использовать полное квалифицированное имя:<source lang="perl"> package Package_1; use constant CONST => "Value"; package Package_2; print Package_1::CONST . "\n"; # Можно также обращаться через ссылку на пакет/объект. print Package_1->CONST . "\n"; </source> * Константы не могут использоваться без особого синтаксиса в выражениях, в которых подразумевается автоматическое закавычивание «голого слова», например, в контексте индексации хэша. В таких ситуациях, чтобы компилятор понимал, что это константа, её нужно сопровождать символом <code>+</code> в начале, либо парой скобок в конце:<source lang="perl"> use constant INDEX => "Apple"; %FRUITS = ( INDEX => 17 ); # НЕПРАВИЛЬНО: компилятор не поймет, что это константа %FRUITS = ( INDEX() => 16 ); # ПРАВИЛЬНО ТАК ... %FRUITS = ( INDEX, 16 ); # ... ЛИБО ТАК. print $FRUITS{ INDEX } . "\n"; # НЕПРАВИЛЬНО: компилятор не поймет, что это константа print $FRUITS{ +INDEX } . "\n"; # ПРАВИЛЬНО print $FRUITS{ INDEX() } . "\n"; # ПРАВИЛЬНО </source> == Примечания == {{примечания}} fame36wjo4lc34jwf3cpgxsrgezj2gp 0 30406 270384 269956 2026-10-18T09:05:36Z ScriptMaster 15708 /* Метод isa */ 270384 wikitext text/x-wiki {{Навигация учебника}} В языке Perl не существовало специального синтаксиса для описания классов до версии 5.38. Для их реализации использовались существующие синтаксические конструкции. ''Класс в Perl'' представляет собой пакет, а функции в пакете представляют его ''методы''. Таблица символов класса представляет его содержимое — список полей и методов. ''Объект в Perl'' — это ссылка на экземпляр класса, которая строится с помощью специальной функции класса — ''конструктора''. Функция <code>ref()</code> возвращает для ссылки на объект не стандартный идентификатор типа <code>SCALAR</code>, <code>ARRAY</code> и др., а возвращает имя класса, которому принадлежит объект<ref>По внутренней терминологии такая ссылка называется благословлённой ({{lang-en|blessed}})</ref>. В общих чертах, конструктор любого класса для конструирования ссылки на объект должен вызывать функцию <source lang="perl"> bless <ссылка> [, <имя-класса>] </source> которая «''благословляет''» ({{lang-en|to bless}} — благословлять) ссылку на то, чтобы принадлежать к классу, указанному вторым аргументом. Если имя класса опущено, то используется имя текущего пакета. Именно ссылка, возвращаемая этим методом, должна возвращаться из конструктора. После того как объект построен, к нему можно обращаться через квалифицированное имя <code>$<имя-класса>::<ссылка></code>. Наследование в Perl еще сильнее отличается от того, что есть в других языках программирования. В Perl наследуются только методы. Наследование данных реализует сам программист. Наследование методов реализовано так: с каждым пакетом ассоциирован свой массив <code>@ISA</code>, в котором хранится список базовых классов пакета. Если внутри класса вызывается метод, которого нет в текущем классе, то интерпретатор в поисках метода просматривает по порядку методы каждого класса массива <code>@ISA</code>. Затем просматривается предопределенный класс <code>UNIVERSAL</code>. Если и после этого метод не был найден, то классы снова просматриваются в том же порядке в поисках процедуры <code>AUTOLOAD</code>. Если такая находится, то вызывается она вместо отсутствующего метода. В эту процедуру будут переданы все параметры, а в переменной <code>$AUTOLOAD</code> будет хранится имя вызываемого метода. == Объявление класса == === Конструктор === Конструктор класса является простой функцией пакета. Она может иметь любое имя, но на практике обычно используют идентификатор <code>new</code>, как устоявшееся имя для любого конструктора. Самый простой конструктор имеет следующий вид: <source lang="perl"> package MyClass; sub new { my $class = shift; # Передаем конструктору имя класса my $self = {}; # Конструируем ссылку bless $self, $class; # Конструируем объект return $self; # Возвращаем ссылку } # --------------------------------------------- package main; # Конструируем объект $object = MyClass::new("MyClass"); </source> Для примера мы объявляем класс и конструируем его экземпляр в одном исходном файле. Здесь мы это делаем только для демонстрации: на практике классы следует объявлять в отдельных исходных файлах и подключать их через директиву <code>use()</code>. Имя ссылки <code>$self</code> является устоявшимся, и мы настоятельно рекомендуем использовать ее в своих проектах. Данный пример демонстрирует пустой бесполезный класс, в котором нет полей, так как мы конструируем объект из ссылки на пустой хеш. На практике обычно в конструктор передается массив или другой хеш, которым инициализируется ссылка <code>$self</code>. В общем случае не обязательно использовать именно хеш, но его преимущество в том, что мы можем использовать произвольные ключи. Также мы можем передавать массив значений, которыми затем мы можем инициализировать анонимный хеш. Другими словами, подходы здесь могут быть самые разные. На практике конструктор класса обычно имеет следующий вид: <source lang="perl"> sub new { # Предполагается, что $init это ссылка на структуру с инициирующими данными my ( $class, $init ) = @_; $class = ref( $class ) || $class; # Чтобы иметь возможность взять имя по ссылке. # Примечание: если имя класса не будет передано, будет взято имя ближайшего пространства имен. my $self = {}; bless $self, $class; # ... Код инициализирующий поля в ссылке $self через $init ... # ... return $self; } </source> === Деструктор === Когда ссылка на объект выходит из зоны видимости, она удаляется по нулевому счетчику ссылок. Программист может контролировать действия, которые исполнятся перед очисткой ссылки, через ''деструктор'' объекта. Деструктор объекта нужен, чтобы корректно завершить жизненный цикл объекта, например, закрыть открытые объектом файловые дескрипторы. Деструктор всегда вызывается автоматически. Деструктор всегда должен быть объявлен внутри класса и всегда должен иметь имя <code>DESTROY</code>. Также деструктор должен принимать аргумент в виде ссылки на удаляемый объект. Деструктор является необязательным методом объекта, так как ссылка на удаляемый объект в любом случае будет очищаться правильно. Данный метод позволяет вам лучше контролировать этот процесс. Деструктор не вызывает автоматически другие деструкторы, другими словами, если ваш класс наследует другой, деструктор базового класса нужно вызвать явно в деструкторе дочернего. Ниже приведен простой пример деструктора. <source lang="perl"> 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 удаляется перед завершением программы. </source> Если вызвать программу, можно убедиться, что деструктор был вызван для каждого из двух объектов: <source lang=""> Call destructor to delete an instance of MyClass class Call destructor to delete an instance of MyClass class </source> === Другие методы === Методы в Perl могут вызываться от имени конкретного объекта или от имени всего класса. В последнем случае такие методы называются ''статическими''. Статическому методу в первом аргументе всегда передается имя класса, а не статическому — ссылка на объект. Типичным примером статического метода является конструктор (именно поэтому мы ожидаем в первом аргументе имя класса). В Perl методы выполняются в пространстве имен того пакета, в котором они были определены, а не в том, в котором они вызываются. Именно поэтому многие статические методы игнорируют свой первый аргумент. Не статические методы выполняют самую разную работу. Обычно эти действия направлены на инкапсулированные в объекте данные. В Perl полностью инкапсулировать данные невозможно, так как вы можете при желании исправлять их прямо через ссылку на объект (если конечно знаете как он устроен). На практике всегда следует изменять инкапсулированные данные через методы класса, игнорируя то, что сам объект является простой ссылкой, так как в этом и есть ООП подход. <source lang="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 </source> Результат работы программы <source lang="bash"> -- 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 </source> Методы класса можно вызывать двумя способами. Первый способ имеет вид <source lang="perl"> <имя-метода> <имя-класса-или-объект>, <параметры>; 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'}; </source> <source lang="bash"> -- 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 </source> Данная форма представляет собой вызов функции, вложенный в другой вызов. Второй формой мы пользовались в самом первом примере этого раздела: <source lang="perl"> <класс-или-объект>-><метод>(<параметры>) $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'); </source> <source lang="bash"> -- 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 </source> Вторая форма требует обязательного заключения аргументов в скобки. В большинстве случаев вторая форма предпочтительнее в смысле читаемости текста программы, так как оператор разыменовывания наглядно отделяет части выражения. При использовании первой формы могут возникнуть трудноуловимые ошибки, особенно когда действует область видимости, в которой существует функция с тем же именем, что и у метода класса. На практике, особенно для такого языка, как Perl, расточительно создавать полный набор геттеров и сеттеров. В большинстве случаев достаточно написать универсальный сеттер, либо объединить геттер и сеттер одного поля в одном методе: <source lang="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"; </source> === Наследование === Для реализации механизма наследования в Perl используется специальный массив <code>@ISA</code>, в который помещаются родительские классы слева направо от ближайшего к дальнему предку. Если интерпретатор встречает вызов метода, которого нет в данном классе, то он сначала пройдется по классам из <code>@ISA</code> в поисках метода. Если вам нужно вызвать метод родительского класса из дочернего класса, вы можете воспользоваться квалифицированным вызовом метода. Если вам нужен метод ближайшего предка, вы можете использовать имя псевдокласса <code>SUPER</code> (но только из методов потомка). <source lang="perl"> 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; </source> <source lang="bash"> -- 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 </source> В данном примере мы имеем два класса <code>Parent</code> и <code>Child</code>. Родительский класс объявляет два метода: метод <code>Parent::set()</code> нужен, чтобы устанавливать поля структуры класса; метод <code>Parent::show()</code> распечатывает все поля структуры класса. Дочерний класс наследует метод <code>Parent::set()</code>, поэтому мы можем вызывать его без квалификатора типа, и переопределяет метод <code>Parent::show()</code>. Также дочерний класс в своем конструкторе вводит поле <code>born</code>, которое по умолчанию инициализируется нулевым значением. Обратите внимание, как мы определяем методы дочернего класса: все они вводят небольшие изменения в алгоритм, но все равно вызывают методы родительского класса. На практике не всегда нужно поступать так, но конструкторы и деструкторы по логике вещей всегда должны обращаться к конструкторам и деструкторам предков, причем конструирование должно происходить сверху вниз (от дальнего предка к последнему потомку), а для деструкторов снизу вверх (от дальнего потомка к дальнему предку). В последнем операторе мы пытаемся вызывать несуществующий метод из объекта дочернего класса. Так как в родительском классе объявлен метод <code>AUTOLOAD</code>, то будет вызван именно он. ==== Множественное наследование ==== Язык Perl поддерживает множественное наследование за счет массива <code>@ISA</code>. В этом массиве вы можете разместить любое количество родительских классов, методы которых будут просматриваться, если реализации соответствующего метода нет в потомке. Ниже показано наследование, при котором класс <code>Child</code> объединяет в себе свойства двух родительских классов. <source lang="perl"> package Parent1; sub new { my $class = shift; bless {}, $class; } sub greet { return "Parent1::greet\n"; } package Parent2; sub new { my $class = shift; bless {}, $class; } sub talk { return "Parent2::talk\n"; } sub greet { return "Parent2::greet\n"; } package Child; @ISA = qw(Parent1 Parent2); sub new { my $class = shift; return bless {}, $class; } package main; my $child = Child->new; print $child->greet(); # Вызовется реализация Parent1, так как этот родитель в списке наследования раньше. print $child->talk(); # Вызовется реализация Parent2. print $child->Parent2::greet(); # Вызов реализации Parent2. </source> <pre> Parent1::greet Parent2::talk Parent2::greet </pre> Множественное наследование обычно следует избегать, но если всё-таки приходится его использовать, следует быть предельно внимательным и учитывать вероятность получения [[w:Ромбовидное наследование|ромбовидного наследования]], при котором есть вероятность унаследовать один и тот же метод у двух и более родителей. Для языка Perl это не является особой проблемой, так как родители проверяются всегда в одном порядке, но это может приводить к логической ошибке в программе и неправильному поведению объекта класса потомка. Если необходимо изменить порядок проверки родительских классов, следует использовать модуль [https://perldoc.perl.org/mro MRO]. Множественное наследование можно избежать, если использовать [[w:Агрегирование (программирование)|агрегирование]] вместо наследования. Также можно использовать интерфейс ролей класса <code>UNIVERSAL</code>, в котором определен метод <code>DOES()</code>. Переопределив этот метод в потомках, вы можете управлять вызовами в зависимости от того, какую роль берет на себя конкретная реализация. === Использование таблицы символов для генерации методов на ходу === Некоторые стандартные методы, такие как геттеры и сеттеры, могут быть сгенерированы по контексту самой структуры класса. Для этого мы можем пройтись по полям структуры класса и сгенерировать из имен полей стандартные методы устанавливающие и возвращающие значения. Внимательно изучите следующий пример. <source lang="perl"> 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"; </source> <source lang=""> Larry Wall Garry Wall </source> В примере выше мы генерируем как будто бы пустой класс. На самом деле он генерирует свои методы на ходу, а именно при вызове конструктора. Для этого он для каждого поля хеша, передаваемого в конструктор, генерирует анонимную функцию, к которой можно обращаться по ссылке. Для геттеров имя ссылки будет <code>get_<имя-поля></code>, а для сеттеров — <code>set_<имя-поля></code>. Этот пример демонстрирует, что в принципе в Perl можно создавать очень сложные абстрактные классы, но вероятнее всего вам не захочется этим заниматься. == Шаблон модуля, несущего в себе класс == <source lang="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__ Документация </source> == Пакет UNIVERSAL == Все классы в <code>@ISA</code> наследуют пакет с именем <code>UNIVERSAL</code>, который предоставляет несколько методов, реализующих рефлексию классов в Perl. Его можно сравнить с классом <code>Object</code> в языке Java, но <code>UNIVERSAL</code> устроен намного проще. Пакет <code>UNIVERSAL</code> объявляет всего 4 метода, которыми модули могут пользоваться для исследования возможностей текущего программного окружения. === Метод VERSION === Возвращает значение переменной <code>$VERSION</code> пакета (модуля). Переменная <code>$VERSION</code> может быть объявлена непосредственно в пакете, но рекомендуется инициализировать её в директиве <code>package</code>, так как это более наглядно. <source lang="perl"> 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"; </source> <pre> SomePackage version: 1.0 SomePackage version: 1.0 </pre> У метода есть необязательный аргумент, в котором вы можете передать ожидаемый номер версии. Если фактический номер версии оказывается меньше запрашиваемого, функция выбрасывает исключение. Предполагается, что более старшие версии не совместимы с младшими. <source lang="perl"> 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 $@; </source> <pre> SomePackage version 2 required--this is only version 1.0 at .\universal.pl line 18. </pre> === Метод DOES === Проверяет, есть ли в цепочке наследования текущего класса класс с именем, передаваемом в аргументе. Если есть, то возвращает ИСТИНУ, иначе ЛОЖЬ. <source lang="perl"> 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'); </source> <pre> The Child inherits the Parent The Child does not inherit the AnotherClass The Child inherits the Parent </pre> === Метод can === Проверяет, существует ли метод с указанным именем в цепочке наследования или нет. Если метод существует, то метод возвращает ссылку на него, иначе возвращается ЛОЖЬ. <source lang="perl"> 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); </source> <pre> The Parent has 'parentMethod' The Child has 'parentMethod' Child method </pre> === Метод isa === По умолчанию <code>isa</code> и <code>DOES</code> работают абсолютно одинаково, однако метод <code>isa</code> задумывался, чтобы проверить утверждение ''инстанцирована ли ссылка от переданного в аргументе класса ИЛИ этот класс есть в цепочке наследования''<ref>Сравните с операцией <code>instanceof</code> в языке Java.</ref>, а <code>DOES</code> призвана определить, ''может ли этот класс выполнять данный класс задач''. Некоторые CPAN модули переопределяют внутри себя <code>DOES</code>, поэтому он может возвращать отличные от <code>isa</code> ответы. Чтобы уловить суть, рассмотрим такой пример. <source lang="perl"> package Logger 1.0; # ... Реализация всего того, что должен уметь типичный класс, # умеющий логировать. sub write { my ($class, $msg) = @_; print STDOUT "$msg"; } # # ... # package Animal 1.0; # # ... # package Dog; use parent -norequire, qw ( Logger Animal ); sub new { my $class = shift; return bless {}, $class; } sub whoAmI { my ($class) = @_; return __PACKAGE__; } # # ... # package main; my $o = Dog->new(); if ($o->DOES('Logger')) { $o->write("This object can write log messages\n"); } if ($o->isa('Animal')) { print STDOUT $o->whoAmI . " is " . "Animal" . "\n"; } else { print STDOUT $o->whoAmI . " is not " . "Animal" . "\n"; } </source> <pre> This object can write log messages Dog is Animal </pre> В этом примере у нас есть класс <code>Dog</code> (''собака''), который наследует классы <code>Logger</code> и <code>Animal</code> (''животное''). С точки зрения бизнес-логики, ''собака является животным'', т.е. метод <code>isa()</code> должен подчеркивать отношение ООП ''являюсь''. С другой стороны, класс умеет пользоваться подсистемой логирования приложения и писать в общий журнал сообщения. Таким образом <code>DOES()</code> сообщает, что объект наделен ролью ''логера''. Вам может быть сейчас не понятно, почему мы должны разделять эти возможности, но представьте себе модуль логирования, который написан отдельно от вашего приложения и не знает системы наследования вашего приложения. Обычно вы просто передаете сконструированные объекты этому модулю в виде ссылок, при этом самому модулю важно понять существует ли возможность вызова методов логирования подсистемы логтрования, что и делается через <code>DOES()</code>. == Подведение итогов == Описанный выше подход к ООП не является единственным. Существуют модули CPAN, которые пытаются улучшить эту систему, обогащая описанные выше скудные конструкции (например, модуль Moose). Такие модули, как правило, используются в больших проектах. Однако, как бы там ни было, CPAN модули могут требовать загрузки множества зависимостей и могут замедлять скорость исполнения программы из-за своей внутренней реализации. В маленьких проектах достаточно встроенного в Perl ООП. == Perl 5.38: class или попытка сдвинуться с мёртвой точки == Очень долго тема ООП в Perl стояла на месте, но с версии 5.38 разработчики интерпретатора решили сделать новый шаг в этом направлении и ввели новое ключевое слово в язык — <code>class</code>. Дело в том, что у старого подхода есть много недостатков, что не позволительно для ООП парадигмы, в частности: * По сути у классов нет понятия ''поля класса'', а то что есть не обладает полноценной инкапсуляцией. Кроме того, никак не реализуется наследование полей в дочерние классы. Все эти моменты идут на откуп программисту, который, конечно, в этом разберётся, но вероятно напишет не очень понятный код. * Методы класса внешне не выглядят инкапсулировано: не запрещено разбросать их по пакетам, пользуясь уловками интерпретации, а также никакой приватности реализовать в них нельзя. Кроме того, нужно всегда помнить, что в первый аргумент любого метода передаётся ссылка на объект, что вынуждает писать одинаковую первую строку для всех методов, что очень утомляет (сравните с автоматической ссылкой <code>this</code> в C++). Реализация <code>class</code> на момент 2025 года ещё относительно сырая и ей стоит пользоваться осторожно, но можно потихоньку присматриваться. Если вы хотите использовать эту возможность, то обновите интерпретатор минимум до версии 5.40, потому что первые реализации имеют достаточно серьезные ошибки. === Объявление класса === Так как на момент версии 5.40 возможность является экспериментальной, её нужно включать так: <source lang="perl"> use feature 'class'; # Отключает предупреждения об экспериментальной возможности, которые засоряют вывод. no warnings 'experimental::class'; </source> В синтаксисе чувствуется, что разработчики вдохновлялись языком C++, так как синтаксис очень похож: <source lang="perl"> class <имя> <версия> [: <атрибуты-наследования>] [{ <блок-класса> }] # Также класс может быть объявлен, но не определен. class <имя> [<версия>]; </source> Внутренне слово <code>class</code> работает как <code>package</code>, но дополнительно оно генерирует конструктор по умолчанию для пакета. Номер версии для класса используется, когда используется наследование и у класса есть несколько реализаций, чтобы не сломать обратную совместимость. Номер версии может быть опущен, если атрибуты наследования не используются. Для <code>class</code> было введено слово <code>__CLASS__</code>, которое автоматически разворачивается в имя класса в пределах его определения. Им следует пользоваться для манипуляций с элементами класса, если они происходят до инстанцирования объекта. Вот примеры объявления класса <code>Person</code>: <source lang="perl"> class Person 1.000 { # ... } class WithoutVersion { # ... } # Объявление класса class Empty; </source> === Поля класса === Чтобы объявить поле в классе, используется ключевое слово <code>field</code>. Это ключевое слово инкапсулирует поле в классе и гарантирует, что каждый инстанцированный объект класса получит свой набор полей в памяти программы. Полный синтаксис поля такой: <source lang="perl"> class ClassName { field <переменная> [: <атрибуты>] [= <выражение-вычисляющее-инициализирующее-значение>]; } </source> Например, <source lang="perl"> class Person 1.000 { field $name = "Larry"; field $surname = "Wall"; field $born; } </source> Данный синтаксис позволяет присвоить значение полю до вызова конструктора, а также, когда значение для поля не передается через конструктор. Что-то похожее есть в языке Java, но здесь вы можете использовать полноценное Perl-выражение справа от присваивания. === Методы класса === Чтобы объявить метод, используется ключевое слово <code>method</code>. Методы уже становятся очень похожими на методы языка C++, в частности вы можете обращаться к полям класса не используя ссылку на объект. С помощью ключевого слова можно объявлять удобные сигнатуры: <source lang="perl"> class ClassName { method [<имя-метода>] [<сигнатура-метода>] { <блок-метода> } } </source> Сигнатуры в новой реализации поддерживают значения по умолчанию. Внутри методов вы можете обращаться к экземпляру объекта по ссылке <code>$self</code>. Ниже представлены примеры. <source lang="perl"> 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"; </source> <pre> Person: Name: Larry, Surname: Wall, Born: Person: Name: Larry, Surname: Wall, Born: 27.09.1954 { "name" : "Larry", "surname" : "Wall", "born" : "27.09.1954" } </pre> === Атрибуты === Атрибуты призваны для установки правил видимости и доступа к различным частям класса как внутри него самого, так и из классов-потомков. В документации говорится, что атрибуты будут: * у класса; * у полей класса; * у методов (но на момент 5.40 ни одного атрибута для методов ещё не реализовано). ==== Атрибуты класса ==== У класса на момент 5.40 поддерживаются следующие атрибуты: * <code>:isa</code> — атрибут устанавливает отношение между классами типа ''родитель-потомок''. В атрибуте вписывается имя класса родителя и опционально минимальная необходимая версия этого класса (если фактическая версия родителя меньше запрашиваемого, исполнение прерывается). Так как у полей всегда лексическая видимость, эта система умеет реализовывать только приватное наследование полей в терминах языка C++. Если класс ещё не был загружен в пространство текущего пакета, неявно вызывается процедура <code>require</code>.<source lang="perl"> 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) { # ... } </source> ==== Атрибуты полей ==== У полей на момент 5.42 поддерживаются следующие атрибуты: * <code>:param</code> — указывает на то, что начальное значение для этого поля берется из именованного параметра конструктора. По умолчанию, именованный параметр конструктора и имя поля совпадают, но в параметрах атрибута можно указать другое имя, если так удобно или того требует ситуация. Вы можете оставить выражение, которое присваивает значение по умолчанию, но если его нет, значение всегда должно присваиваться через конструктор.<source lang="perl"> 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 </source> * <code>:reader</code> — генерирует для поля геттер. По умолчанию имя геттера совпадает с именем поля, но в параметре атрибута можно указать другое имя.<source lang="perl"> 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"; </source> * <code>:writer</code> — генерирует для поля сеттер. На момент версии 5.42 сеттер можно сгенерировать только для скалярного поля, иначе будет сгенерирована ошибка времени компиляции. По умолчанию имя сеттера генерируется по шаблону <code>set_<имя-поля></code>, но в параметре атрибута можно указать другое имя. Все генерируемые автоматически сеттеры возвращают ссылку на объект, поэтому сеттеры можно вызывать по цепочке.<source lang="perl"> class ModernPerson { field $name :writer; field $surname :writer(surname); field $born :writer = "unknown"; method printAsString { print __CLASS__ . ":" . " Name: " . $name . ", Surname: " . $surname . ", Born: " . $born . "\n" ; } } my $o = ModernPerson->new; $o->set_name("Larry"); # Вызов по цепочке. $o->surname("Wall")->set_born("27.09.1954"); $o->printAsString; </source> === Жизненный цикл объекта класса === Так как <code>class</code> это по сути замаскированный <code>package</code>, то всё что было сказано ранее в классическом подходе Perl к ООП справедливо и здесь в отношении жизненного цикла. Правда есть одно отличие: для <code>class</code> был добавлен специальный именованный блок <code>ADJUST</code>, который семантически очень похож на <code>BEGIN</code>, но из него вам доступна ссылка на инстанцированный экземпляр класса, т.е. этот блок выполняется сразу за конструктором при конструировании каждого нового объекта. Вы можете указать сколько угодно таких блоков и они будут выполняться в порядке появления. Ниже показаны этапы жизненного цикла на конкретном примере. <source lang="perl"> 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; } </source> <pre> 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 </pre> Мы можем видеть, что при наследовании конструкторы и блоки <code>ADJUST</code> вызываются автоматически в порядке от родителя к потомку. Как и раньше, для деструкторов мы должны закладывать вызов деструктора родителя в деструкторе потомка . == Перегрузка операций классов == В этом разделе мы разберем одну из центральных функций ООП в Perl — ''перегрузка операций''. Многие программисты ругают Perl за очень сложный синтаксис ООП, но на самом деле Perl по большому счёту не нужна ООП парадигма в той форме, в которой она есть, например, в языке Java. Perl в первую очередь всегда решал задачи системного администрирования, где скорее важны минимализм и практичность, так как у системных администраторов время на решение входящих запросов очень ограничено. В Perl существует по меньшей мере два подхода перегружать операции: * '''Перегрузка связыванием'''. Данный тип перегрузки опирается на функцию <code>tie()</code>, которая привязывает объект-делегат к переменной определенного типа данных и переопределяет операции для этой переменной (привязывается к ней). Данный тип перегрузки концентрируется на этапах жизненного цикла объекта и перегружает через ''конструктор'', ''деструктор'', операции ''присваивания'' и ''копирования''. * '''Перегрузка операций класса'''. Реализуется через модуль <code>overload</code> и позволяет перегружать знаки операций для выражений, в которых используется объект некоторого класса. === Перегрузка связыванием === Идея этого подхода кроется в желании обобщить работу с хранилищами данных по отношению к типам данных языка Perl. В языке Perl можно любую структуру представить комбинацией стандартных типов языка (скаляр, массив и хеш-массив). С другой стороны, сценарии Perl обычно конечной целью ставят перед собой прочитать данные из некоторого источника и записать данные в некоторый источник. Обычно протокол работы с определенным типом хранилища данных всегда строго определен. Отсюда возникает желание одни и те же данные записывать в разные типы хранилищ одинаковым, с точки зрения интерфейса, способом. Здесь и появляется функция <code>tie()</code>, которая привязывает реализацию-делегат к экземпляру стандартного типа данных. При этом делегат внутри себя полностью управляет протоколом работы с хранилищем, а наружу для клиентского кода перегружает операции ''присваивание'' и ''извлечение'' через знак операции <code>=</code>. Данный подход впервые появился в Perl 5 и поддерживает привязывание для: * скаляров (<code>Tie::Scalar</code>), * массивов (<code>Tie::Array</code>), * хеш-массивов (<code>Tie::Hash</code>), * файловых дескрипторов (<code>Tie::Handle</code>). Основу интерфейса <code>tie()</code> составляют следующие функции: <source lang="perl"> # Строит экземпляр делегата и привязывает его к переменной. tie <переменная-к-которой-привязывается-делегат>, <класс-делегата>, <список-аргументов-для-конструктора-делегата> # Отвязывает делегата от переменной и удаляет его. untie <переменная-к-которой-привязывается-делегат> # Возвращает ссылку на экземпляр делегата. tied <переменная-к-которой-привязывается-делегат> </source> Состав интерфейсных методов для каждого типа данных отличается, так как каждый тип в чём-то специфичен, но в общем каждый тип представляет следующие методы: * <code>TIEHASH</code>, <code>TIEARRAY</code>, <code>TIEHANDLE</code> и <code>TIESCALAR</code> — конструктор делегата соответственно для хеш-массива, массива, дескриптора и скаляра. Сигнатура конструктора для всех типов одинаковая: в первом аргументе передается имя пакета делегата, а в последующих список аргументов для него. * <code>FETCH</code> — определен для всех типов, кроме дескриптора. Вызывается каждый раз, когда связанная переменная участвует в выражении как правосторонний операнд, т.е. значение из источника извлекается. * <code>STORE</code> — определен для всех типов, кроме дескриптора. Вызывается каждый раз, когда связанная переменная участвует в выражении как левосторонний операнд, т.е. значение в источник записывается. * <code>DESTROY</code> — деструктор делегата. Вам не обязательно переопределять все методы, предоставляемые интерфейсом, так как тривиальные реализации всегда есть в соответствующем пакете <code>Tie::</code>. ==== Связывание скаляров ==== Основы работы с tie-интерфейсом проще всего показать на скаляре, так как для скаляра определено самое малое количество методов: * <code>TIESCALAR</code> — конструктор делегата. * <code>FETCH</code> — метод, извлекающий данные из привязанного скаляра. * <code>STORE</code> — метод, записывающий данные в привязанный скаляр. * <code>DESTROY</code> — деструктор делегата. Ниже показан небольшой пример делегирующего класса. <source lang="perl"> 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 </source> <pre> Tie TieScalarExample: 1, 2, 3 To fetch a record Storing a value: 15 Before untie() </pre> В комментариях к примеру показано, в какие моменты вызываются интерфейсные методы. В этом примере мы привязываем делегата <code>TieScalarExample</code> к скаляру <code>$aScalar</code>, после чего любая операция <code>=</code> будет переводиться на методы привязанного делегата до момента вызова <code>untie()</code> в зависимости от того, в левом или правом операнде операции участвует связанный скаляр. Перед отвязыванием делегата вызывается деструктор делегата. В предыдущем примере делегат по сути ничего не делает, но на практике часто за делегатом скаляра стоит реальное хранилище данных, а сам делегат выступает его драйвером. Ниже представлен конкретный пример, в котором делегат логирует все значения, которые проходят через скаляр в любом направлении. <source lang="perl"> #!/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; </source> Если вы откроете файл лога, то увидите следующие строки: <pre> 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 </pre> а на консоли <source lang="bash"> $ ./tiescalar.pl Printing: Apple Printing: Pear Printing: Grapes Printing: Banana </source> Вы можете увидеть странную запись в логах <pre> package main, ./tiescalar.pl line 54 FETCHED none </pre> Она говорит о том, что списковая операция <code>print</code> внутренне тоже обращается к скаляру. ==== Связывание массивов ==== Интерфейс для массивов уже заметно богаче: * <code>TIEARRAY</code> и <code>DESTROY</code> — конструктор и деструктор делегата. * <code>STORE</code> — вызывается, когда по конкретному индексу записывается значение в массив. * <code>FETCH</code> — вызывается, когда по конкретному индексу извлекается значение из массива. * <code>DELETE</code> — вызывается, когда удаляется элемент по индексу. * <code>CLEAR</code> — вызывается для операции <code>delete</code> для всего массива. * <code>PUSH</code>, <code>POP</code>, <code>SHIFT</code>, <code>UNSHIFT</code>, <code>SPLICE</code> — переопределяет стандартные одноименные операции над массивом. * <code>EXISTS</code> — вызывается, когда проверяется существование значение по индексу. * <code>EXTEND</code> — предполагается, что метод расширяет занимаемую память под массив на указанное число позиций. * <code>FETCHSIZE</code> — предполагается, что возвращает реальное число элементов в массиве. * <code>STORESIZE</code> — предполагается, что подравнивает размер массива под указанное значение. Если часть элементов выходит за пределы, они должны быть удалены. Если новый размер больше текущего, то новые значения должны быть проинициализированы <code>undef</code>. Ниже показано, в какие моменты вызываются методы интерфейса. <source lang="perl"> 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 </source> ==== Связывание хеш-массивов ==== Для хеш-массивов определены следующие методы: * <code>TIEHASH</code> и <code>DESTOROY</code> — конструктор и деструктор делегата. * <code>STORE</code> — сохраняет значение в хеш-массив по ключу. * <code>FETCH</code> — извлекает значение из хеш-массива по ключу. * <code>FIRSTKEY</code> — возвращает самый первый ключ в массиве. * <code>NEXTKEY</code> — возвращает следующий ключ. Используется для перебора элементов хеш-массивов через <code>each()</code>. * <code>EXISTS</code> — проверяет существование ключа. * <code>DELETE</code> — удаляет значение из хеш-массива по ключу. * <code>CLEAR</code> — удаляет хеш-массив целиком. * <code>SCALAR</code> — вызывается, когда к хеш-массиву происходит обращение в скалярном контексте. Ниже показано, в какие моменты вызываются методы интерфейса. <source lang="perl"> 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 </source> Следует дать пояснения по методам <code>FIRSTKEY</code> и <code>NEXTKEY</code>. Эти методы реализуют подобие итератора. Метод <code>FIRSTKEY</code> вызывается всегда, когда хеш-массив передается функции <code>keys()</code> или <code>each()</code>. Этот метод должен сбросить состояние итератора, если оно не начальное, и вернуть начало хеш-массива. Метод <code>NEXTKEY</code> возвращает последующий элемент, вычисленный от последнего, переданного аргументом <code>$lastkey</code>. Если возвращать нечего, нужно вернуть значение <code>undef</code>, которое говорит, что элементы закончились. ==== Связывание дескрипторов ==== Связывание для файловых дескрипторов в Perl очень полезный функционал в *nix системах, так как в них через файловые дескрипторы можно получить доступ к любой части системы. Например, можно подключаться к блочным или символьным устройствам через специальные файлы и работать с ними через операции файловых дескрипторов из кода Perl. Так как через дескрипторы ходят символьные потоки, в них нет методов <code>STORE</code> и <code>FETCH</code>, а используются методы <code>WRITE</code> и <code>READ</code>. Интерфейс поддерживает следующие методы: * <code>TIEHANDLE</code> и <code>DESTROY</code> — конструктор и деструктор делегата. * <code>WRITE</code> — записывает указанное число байтов с некоторого начального адреса и некоторого смещения от его начала. * <code>READ</code> — читает указанное число байтов с некоторого начального адреса и некоторого смещения от его начала. * <code>READLINE</code> — читает несколько байтов до некоторого разделителя. * <code>GETC</code> — читает очередной символ в символьном потоке. * <code>PRINT</code> — печатает значения в переданном списке. * <code>PRINTF</code> — печатает значения в списке с использованием форматной строки. * <code>OPEN</code> — открывает или переоткрывает файловый дескриптор. * <code>CLOSE</code> — закрывает файловый дескриптор. * <code>BINMODE</code> — указывает на то, что читаемый поток представляет собой поток байтов, а не отдельных символов (другими словами, включает бинарный режим чтения). * <code>EOF</code> — возвращает истину, если поток закончился. * <code>TELL</code> — возвращает текущую позицию в файле. * <code>SEEK</code> — передвигает позицию в файле относительно некоторой опорной точки. Ниже показано, в какие моменты вызываются методы интерфейса. <source lang="perl"> use strict; package TieHandleExample; sub TIEHANDLE { my ($class, @argv) = @_; return bless {}, $class; } sub WRITE { my ($self, $address, $length, $offset) = @_; } sub READ { my ($self, $address, $length, $offset) = @_; } 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, $offset, $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 $offset, 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 </source> Для этого типа связывания мы приведем два конкретных примера использования. Наверное вы знаете Unix утилиту [[w:tee|tee]]. Основной задачей этой утилиты является копирование и перенаправление основного потока. Например, этим пользуются, когда вывод программы нужно видеть на консоли и одновременно с этим логировать его в файл (возможно в несколько файлов). В Perl можно реализовать возможности <code>tee</code> следующим образом. <source lang="perl"> #!/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; </source> В примере выше мы открываем 5 дескрипторов: 4 связывается с файлами (<code>tmp1</code>, <code>tmp2</code>, <code>tmp3</code>, <code>tmp4</code>), причем <code>tmp3</code> открывается на дозапись, и один связывается со стандартным потоком вывода (<code>-</code>). Все эти дескрипторы представляет один общий, который мы назвали <code>BROADCAST</code> и к которому мы привязали свою реализацию метода <code>PRINT</code>. Она не очень сложная и занимается тем, что для каждого открытого ранее дескриптора вызывает функцию <code>print</code> и передает список для печати. После запуска программы, вы можете видеть, как создаются 4 файла, и один и тот же вывод транслируется в каждый из них и на консоль. Следующий пример показывает, как приложение может переключать источник ввода. Если приложению не передано ни одного аргумента командной оболочки, то приложение читает стандартный поток ввода. <source lang="perl"> 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; </source> <source lang="bash"> # Аргументы переданы явно $ perl ./selecthandle.pl 1 2 3 1 2 3 # А теперь данные поставляются через STDIN. $ seq 1 3 | perl ./selecthandle.pl 1 2 3 </source> === Перегрузка операций через модуль overload === Второй подход перегрузки операций заключается в использовании директивного модуля <code>overload</code>. Данный модуль позволяет перегрузить часть стандартных операций в отношении произвольного класса. Данный модуль разрешает перегружать только те операции, которые перечислены в хеш-массиве <code>%overload::ops</code>. На момент версии 5.40 состав перегружаемых операций таков: <source lang="bash"> $ 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' }; </source> Обратите внимание, что операции в этом массиве отсортированы по категориям. Большинство операций в этом списке однозначно соответствуют их знакам, но есть и исключения. * Операции <code>not</code> нет в списке перегружаемых операций, однако, если вы перегружаете <code>!</code>, то при вызове <code>not</code> будет использоваться реализация для <code>!</code>. * Точно так же операция унарного минуса <code>-</code> будет использовать реализацию для <code>neg</code>. * При перегрузке инкремента <code>++</code> и декремента <code>--</code>, Perl не будет делать отдельные реализации для префиксной и постфиксной формы (как, например, это делается в языке C++), однако точка вызова их в выражении будет поставлена так, чтобы отрабатывала префиксная или постфиксная форма. Эти операции находятся в категории <code>mutators</code>, что говорит о том, что они работают не с копией значения, а ссылкой на него. * Операцию присваивания <code>=</code> нельзя перегрузить с помощью этого модуля, так как она зарезервирована для конструктора копирования класса. Единственный способ её перегрузить — это использовать интерфейс <code>tie()</code>. Тем не менее, вы можете перегружать прочие разновидности присваивания (категория <code>assign</code>), так как они работают с ссылкой. * Операции<pre>+ - * / % ** << >> x . & | ^ &. |. ^.</pre>не должны изменять свои операнды, так как они передаются по ссылке и это было бы некорректным поведением. Другими словами, они должны конструировать новое значение в качестве результата. * Все операции тестирования файла (<code>-f</code>, <code>-x</code> и др.) перегружаются одной и той же операцией <code>-X</code>, и перегрузить их по-отдельности невозможно. Тем не менее, вы можете распознать какой тест передаётся через второй аргумент, несмотря на то, что операция унарная. Обычно, если вам требуется перегрузить операции для вашего класса, минимально рекомендуется перегружать следующие: <pre> + - * / % ** << >> x <=> cmp & | ^ ~ &. |. ^. ~. atan2 cos sin exp log sqrt int "" 0+ bool ~~ </pre> ==== Основы перегрузки ==== * Перегрузка операции происходит в момент вызова модуля <code>overload</code>. Вы должны указать знак операции из таблицы <code>%overload::ops</code> в качестве ключа, а затем присвоить ссылку на процедуру любым доступным способом<source lang="perl"> use overload "-" => "minus", # Перегрузка с помощью символической ссылки. "*=" => \&muas, # Перегрузка с помощью жесткой ссылки. '""' => sub { ...; }; # Объявление анонимной процедуры на месте. </source> * Объявленные процедуры должны быть реализованы в ближайшем к директиве пакете. Обычно это пакет класса, которому требуется перегрузка операций. Допустимо указывать реализацию из другого пакета. Кроме того, если реализация наследуется, то к ней справедливы все правила наследования, описанные выше. Например, если есть классы <code>A -> B -> C</code>, где стрелка указывает на родителя, и классы <code>B</code> и <code>С</code> перегружают одну и ту же операцию, <code>A</code> будет искать по списку <code>@ISA</code> ближайшую в цепочке наследования реализацию. * Все перегружающие процедуры объявляются одинаково<source lang="perl"> sub overloadImpl { my ($self, $other, $swap) = @_; ... return $result; } </source>Однако, интерпретация входящих аргументов и тип возвращаемого значения зависят от смысла операции (см. ниже). * Для некоторых операций, которые связаны по смыслу разными знаками, Perl может генерировать реализацию автоматически для той части, которая не была перегружена явно. Например, операции <code>0+</code><ref>Операция <code>0+</code> называется «Венерой» из-за внешней схожести с [[w:Зеркало Венеры|зеркалом Венеры]]. Данная операция пытается преобразовать строку в число в скалярном контексте.</ref>, <code>""</code>, и <code>bool</code> могут предоставить свою реализацию операции <code>!</code>, если та не была перегружена, а хотя бы одна из них была перегружена. * Ключ <code>nomethod</code> может использоваться для объявления универсальной перегрузки, которая будет вызываться для любой не перегруженной индивидуально операции. * Установка флага <code>fallback</code> даёт модулю подсказку, как он должен поступать с вызовом, если не удаётся найти для операции перегруженную реализацию. ==== Реализующая процедура ==== Перегрузка бинарных и унарных операций происходит по одному прототипу входящих параметров<source lang="perl">my ($self, $other, $swap, $nomethod, $binary) = @_;</source>Здесь * <code>$self</code> — ссылка на объект класса, для которого была перегружена операция; * <code>$other</code> — второй операнд или параметр унарной операции; * <code>$swap</code> — флаг, который говорит о том, находится ли ссылка на объект слева (ЛОЖЬ) от знака операции или справа (ИСТИНА). Реализующая процедура обычно возвращает ссылку на результат. Здесь многое зависит от того, какой смысл закладывается в перегрузку. Флаг <code>$swap</code> многогранный. Он используется и в бинарных, и унарных операциях, но ЛОЖЬ в них представляется по-разному. В бинарных операциях ЛОЖЬ представляется пустой строкой <code><nowiki>''</nowiki></code>, а в унарных операциях и операциях класса <code>assign</code> используется <code>undef</code>. Существуют также 4-й и 5-й параметры, которые инициализируются в особых ситуациях. Если перегружена специальная операция <code>nomethod</code>, которая по смыслу похожа на <code>AUTOLOAD</code> (но для операций), 4-й параметр всегда инициализируется знаком операции. Для побитовых операций (<code>&</code>, <code>|</code>, <code>^</code> и <code>~</code>) инициализируется 5-й параметр, чтобы, возможно, подсказать реализации о необходимости работать с операндами как с числами. ==== Автогенерируемые операции ==== Если вызывается операция для некоторого класса и при этом для неё нет перегруженной реализации, модуль <code>overload</code> руководствуется встроенным в него флагом <code>fallback</code>, который по умолчанию имеет значение ИСТИНА. Алгоритм поиска реализации операции таков: # Если операция перегружена в объекте вызываемого класса, то использовать реализацию в этом классе, иначе идём дальше. # Если <code>fallback</code> ИСТИНА или <code>undef</code>, попытаться сгенерировать автоматическую реализацию. # Если операция не относится к категории <code>assign</code>, то повторить шаг 1 для второго операнда. # Повторить шаг 2 для второго операнда. # Если для первого операнда все сводится к <code>nomethod</code> реализации, то использовать её. # Если для второго операнда все сводится к <code>nomethod</code> реализации, то использовать её. # Если <code>fallback</code> ИСТИНА и не нашлось ни одной реализации, то попытаться обработать операнды в соответствии с типом операции. Например, если операция арифметическая, то попытаться привести операнды к числам; если строковая — строкам и т.д. # Если ничего из этого не может корректно отработать, то бросить исключение. В этом алгоритме для унарных операции опускаются шаги, связанные со вторым операндом. Хотя правила выше кажутся прозрачными, существует очень много подводных камней в ситуациях, когда не удаётся найти реализацию, поэтому стоит перегружать операции всегда с большой внимательностью. Для некоторых операций могут использоваться близкие по смыслу операции, которые могут предоставить свою реализацию, если целевая не была определена. Вы можете ознакомиться с ними в официальной документации [https://perldoc.perl.org/overload#Magic-Autogeneration Magic-Autogeneration]. ==== Пример перегрузки ==== На практике перегрузка зачастую используется, чтобы выразить идею программы более наглядно — добавить синтаксического сахара. Пример ниже демонстрирует модуль, который, используя операцию <code><<</code>, представляет поток строк, который, возможно, используется шаблонизатором<ref>Программой, которая, используя некоторый шаблон, генерирует конечный текстовый документ.</ref>. В данный поток можно встраивать условия, чтобы игнорировать некоторые части шаблона в зависимости от текущих условий. Внимательно изучите следующий код. <source lang="perl"> 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; </source> Данный модуль представляет класс <code>StringStream</code>, который имеет два атрибута: <code>stream</code> и <code>if_stack</code>. Атрибут <code>stream</code> представляет собой ссылку на строковый массив, в который набираются части результирующей строки. Чтобы в потоке строк иметь возможность игнорировать некоторые части, класс реализует собственные операции, которые могут представлять условия. Они реализуются за счет встроенных классов, которые не видны клиентскому коду, но которые может интерпретировать <code>StringStream</code>. Эти классы имитируют конструкцию <code>If...ElseIf...Else</code>, но, чтобы отмечать границу конструкции, используется терминирующая операция <code>Endl</code>. Создать экземпляры встроенных классов можно только с помощью функций-оболочек, которые имеют имена <code>If</code>, <code>ElseIf</code>, <code>Else</code> и <code>Endl</code>, причем в <code>If</code> и <code>ElseIf</code> можно передавать выражения, которые выполняют роль условных конструкций. Весь секрет этого класса кроется в том, что он и его скрытые классы перегружают знак операции <code><<</code>, который отсылает к одной единственной процедуре <code>__stream_element</code>. Данная процедура анализирует второй операнд и, используя массив <code>if_stack</code>, отключает части потока строк, в зависимости от результатов условных выражений. Данная система не проверяет некоторые некорректные ситуации и ожидает, что ни один <code>ElseIf</code> не будет встречаться раньше чем <code>If</code>; <code>Else</code> не будет стоять раньше <code>If</code> и <code>ElseIf</code>, а каждая открытое условие <code>If</code> будет терминироваться <code>Endl</code>. Кроме операции <code><<</code> класс <code>StringStream</code> также перегружает операцию <code>q{""}</code>, которая используется в скалярном контексте, чтобы сформировать из набранной строки окончательную. Ниже показан пример использования. <source lang="perl"> #!/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 ; </source> В данном примере анализируется входящий массив аргументов и, в зависимости от переданного числа аргументов, печать выводится по-разному: <source lang="perl"> # Предполагается, что файл модуля лежит в рабочем каталоге. $ 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 </source> Обратите внимание, что мы могли бы конструировать строку без использования этого «сахара», но конечная конструкция изобиловала бы множеством операций конкатенации, ветвлений и циклов. Другими словами, мы концентрируемся на задаче сформировать строку по нашим правилам простыми средствами. == Объектно-ориентированный подход в системе ввода-вывода == С появлением в Perl 5 модулей, в систему ввода-вывода также был добавлен ООП подход в виде интерфейсного класса [https://perldoc.perl.org/IO::Handle IO::Handle] и его классов-потомков, таких как <code>IO::File</code>, <code>IO::Pipe</code>, <code>IO::Socket</code> и других. Это позволяет облегчить написание программ, требующих работы с операциями [[../Ввод и вывод|ввода и вывода]], рассмотренные нами ранее. В данном разделе мы рассмотрим этот интерфейс, чтобы продемонстрировать, как ООП подход может упростить и унифицировать написание кода, связанного с вводом-выводом по файловым дескрипторам. === Интерфейс IO::Handle === Интерфейс, реализуемый модулем <code>IO::Handle</code>, содержит универсальные методы, применяемые для всех объектов, которые в своей реализации открывают файловый дескриптор. Более специализированные классы, например <code>IO::File</code> (обычный файл), предоставляют дополнительные методы, учитывающие нюансы работы с данным типом файла, но так или иначе переопределяют методы, вводимые классом <code>IO::Handle</code>. Вместе эти классы сглаживают некоторые недостатки встроенных дескрипторов файлов Perl и упрощают понимание и сопровождение программ. Объект <code>IO::Handle</code> может быть построен одним из двух конструкторов: * '''Конструктор без аргументов''' (<code>new()</code>) позволяет построить пустой объект класса <code>IO::Handle</code>. Далее необходимо сделать библиотечный вызов <code>fdopen()</code> через одноименный метод, чтобы открыть файловый дескриптор с определенным режимом. Так как этот вызов требует знания флагов и атрибутов, его вызов не очень удобен на практике. Конструкторы в классах, наследующих этот интерфейс, скрывают этот вызов в своих реализациях. * '''Конструктор с аргументами''' (<code>new_from_fd ()</code>) позволяет построить объект и привязать к нему уже открытый дескриптор. Главным образом используется, когда нет нужной реализации интерфейса, но требуется использовать методы <code>IO::Handle</code>. Методы <code>IO::Handle</code> в основном копируют одноименные функции ввода-вывода: <source lang="perl"> $io->close # Закрыть дескриптор. $io->eof # Возвращает признак конца потока EOF. $io->fcntl( FUNCTION, SCALAR ) # Управляет флагами файлового дескриптора. $io->fileno # Возвращает номер файлового дескриптора. $io->format_write( [FORMAT_NAME] ) # Аналог функции write(), т.е. запись по формату. $io->getc # Прочитать очередной символ. $io->ioctl( FUNCTION, SCALAR ) # Делает системный вызов ioctl() для управления устройством ввода-вывода. $io->read ( BUF, LEN, [OFFSET] ) # Буферизированное чтение. $io->write ( BUF, LEN [, OFFSET ] ) # Буферизированная запись. $io->print ( ARGS ) # Буферизированная запись. $io->printf ( FMT, [ARGS] ) # Буферизированная запись по форматной строке. $io->say ( ARGS ) # Буферизированная запись с переносом строки. $io->stat # Реализация функции stat(). $io->sysread ( BUF, LEN, [OFFSET] ) # Не буферизированное чтение $io->syswrite ( BUF, [LEN, [OFFSET]] ) # Не буферизированная запись. $io->truncate ( LEN ) # Смещает указатель записи в начало, что аналогично удалению данных. $io->opened # Возвращает ИСТИНУ, если дескриптор открыт. $io->getline # Возвращает строку до разделителя. $io->getlines # Возвращает строки до конца потока. $io->ungetc ( ORD ) # Возвращает из потока символ с указанным порядковым номером. $io->error # Возвращает ИСТИНУ, если возникала ошибка ввода-вывода. $io->clearerr # Сбрасывает флаг ошибки. Возвращает -1, если дескриптор находится в состоянии ошибки. $io->sync # Реализует синхронизацию данных в буфере и на носителе на уровне системы (не PerlIO). Может не поддерживаться на некоторых системах. $io->flush # Сброс буферов ввода-вывода, связанных с дескриптором. $io->printflush ( ARGS ) # Реализует сброс буферов только для текущей операции, а затем восстанавливает состояние флага сброса. $io->blocking ( [ BOOL ] ) # Если в аргументе передается ИСТИНА, делает операции ввода-вывода неблокирующими. </source> Также интерфейс позволяет управлять встроенными переменными языка Perl, управляющими вводом-выводом. Следующие методы управляют значениями для конкретного экземляра класса: <source lang="perl"> $io->autoflush ( [BOOL] ) # Управляет $| (управление буферизацией) $io->format_page_number( [NUM] ) # Управляет $% (номер страницы при выводе по формату) $io->format_lines_per_page( [NUM] ) # Управляет $= (число строк на страницу при выводе по формату) $io->format_lines_left( [NUM] ) # Управляет $- (число строк на текущей странице при выводе по формату) $io->format_name( [STR] ) # Управляет $~ (имя текущего формата) $io->format_top_name( [STR] ) # Управляет $^ (имя формата, который является верхним колонтитулом) $io->input_line_number( [NUM]) # Управляет $. (номер последней прочитанной строки последнего удачного чтения) </source> Следующие переменные управляются из этого интерфейса, но применяются ко всем открытым дескрипторам (т.е. методы являются статическими): <source lang="perl"> IO::Handle->format_line_break_characters( [STR] ) # $: (хранит символы переноса строк) IO::Handle->format_formfeed( [STR]) # $^L (управляющий символ перехода на новую страницу при выводе по формату) IO::Handle->output_field_separator( [STR] ) # $, (разделитель полей при печати функцией print) IO::Handle->output_record_separator( [STR] ) # $\ (символ, добавляемый в конец при печати функцией print) IO::Handle->input_record_separator( [STR] ) # $/ (символ разделителя записей при чтении из файлов) </source> Ниже показан небольшой пример работы с <code>IO::Handle</code>. <source lang="perl"> # Файл: handle.pl use strict; use warnings; use IO::Handle; my @strings; # Открываем дубликат дескриптора STDIN, чтобы работать с ним из экземпляра IO::Handle. my $io = IO::Handle->new_from_fd(fileno(STDIN),"r"); if ($io->opened) { push @strings, $_ while $_ = $io->getline; $io->close; print "Record number: " . @strings . "\n"; } # Следующая печать показывает, что закрылся только дубликат, а не STDIN. print "Object \$io " . ($io->opened ? "is opened" : "is closed") . "\n"; # При подключении модуля IO::Handle, все открытые дескрипторы неявно получают доступ к интерфейсным методам. print "STDIN " . (STDIN->opened ? "is opened" : "is closed") . "\n"; our $out; # Открываем дубликат дескриптора STDOUT, чтобы работать с ним из экземпляра IO::Handle. # Для примера, дубликат открывается методом fdopen(). { $out = IO::Handle->new(); if ($out->fdopen(fileno(STDOUT),"w")) { print "Printing 1:\n"; foreach my $line (@strings) { $out->write($line); } } # При обнулении ссылки, будет вызван деструктор, в котором close() вызывается неявно. undef $out; } # Мы могли не создавать дубликат STDOUT, а писать в него напрямую через интерфейс. print "Printing 2:\n"; foreach my $line (@strings) { STDOUT->write($line); } </source> <source lang="bash"> $ echo -e "aaa\nbbb\nccc" | perl handle.pl Record number: 3 Object $io is closed STDIN is opened Printing 1: aaa bbb ccc Printing 2: aaa bbb ccc </source> Приведенный выше пример плохо показывает, чем ООП парадигма в данном случае лучше процедурной, однако, мы всё же перечислим некоторые преимущества такого подхода: * Вы можете заметить, что вы не работаете с дескрипторами напрямую. По сути вы работаете с ссылками на объекты, которые инкапсулируют дескриптор внутри себя. Если бы программа была больше и в ней бы требовалось передавать дескриптор различным её частям, поддерживать код с передачей ссылки на объект намного проще, чем передачу дескриптора. * Жизненный цикл объекта отчасти перекладывается на систему очистки ссылок Perl: вам легче освобождать ресурсы системы, так как их освобождают автоматически вызываемые деструкторы. * В начале исходного файла вы всегда подключаете нужный вам модуль пространства <code>IO::</code>, что может давать подсказку читающему программу, что данный код работает с определенным типом файла. При работе с дескрипторами напрямую, невозможно дать такую подсказку без длинного комментария. В большой программе (в несколько тысяч строк), чтобы уловить намерения работы с дескриптором, вам придется внимательно изучить все вызовы, в которых участвует дескриптор. * При любых фатальных ошибках конкретная реализация интерфейса, как правило, выбрасывает исключение, которое перехватывать проще, чем проверять коды возврата. === Примеры === Ниже приведено несколько примеров применения потомков <code>IO::Handle</code>. Следующая программа открывает простой файл, переданный аргументом, и считает сколько в нём строк. В этом примере используется класс <code>IO::File</code> для работы с файлом в ООП стиле. <source lang="perl"> # Файл: line_counter.pl use strict; use warnings; use IO::File; my $file = shift; my $counter = 0; my $io = IO::File->new($file) or die "Cannot open $file: $!\n"; $counter++ while defined $io->getline; STDOUT->print("File '$file' contains $counter lines\n"); </source> <source lang="bash"> $ cat > file.txt <<EOF 1 2 3 4 5 6 EOF $ perl line_counter.pl file.txt File 'file.txt' contains 6 lines </source> Вернемся к примеру, рассмотренному в разделе [[../Ввод и вывод#Открытие канала через pipe()|Открытие канала через pipe()]]. При работе с каналом в процедурном стиле код получается довольно громоздким. Теперь посмотрите на то, как код будет выглядеть, если управлять каналом через объект класса <code>IO::Pipe</code>. <source lang="perl"> # Файл: pipe.pl use strict; use warnings; use IO::Pipe; # Строим объект одностороннего канала. my $pipe = IO::Pipe->new(); # Создаем со-процесс. my $pid = fork(); if (defined $pid) { if ($pid == 0) { # Пересоздаем объект так, чтобы на этом конце можно было только писать в канал. # Также отключаем буферизацию. $pipe->writer()->autoflush(); $pipe->print("Hello from child process\n"); $pipe->close(); exit 0; } else { # Пересоздаем объект так, чтобы на этом конце можно было только читать канал. $pipe->reader(); while (defined (my $line = $pipe->getline)) { STDOUT->print("Parent received: $line"); } $pipe->close(); waitpid $pid, 0; } } else { die "Could not fork: $!"; } </source> <source lang="bash"> $ perl pipe.pl Parent received: Hello from child process </source> Обратите внимание, что код стал намного чище. Наконец, продемонстрируем простейший Web-клиент, использующий модуль <code>IO::Socket</code>. Использование ООП подхода в этой задаче избавляет вас от изнурительного труда по настройке сетевого сокета через библиотеку <code>Socket</code>. <source lang="perl"> # Файл: pcurl.pl use strict; use warnings; # Импортируем IO::Socket и подключаем некоторые константы. use IO::Socket qw ( :DEFAULT :crlf ); # Изменяем стандартный разделитель строк на разделитель CRLFCRLF, так как им # заканчивается список заголовков. IO::Handle->input_record_separator( CRLF . CRLF ); # Пользователь передает URL для подключения. my $url = shift or die "pcurl.pl <URL>\n"; my $data; # Регулярными выражениями выделяем в URL хост и путь до ресурса. Этот клиент работает # только по протоколу HTTP. my ($host, $path) = $url =~ m!^http://([^/]+)(/[^\#]*)! or die "Invalid URL.\n"; # Открываем сетевой сокет и пытаемся подключиться к сетевой службе по порту 80. my $socket = IO::Socket::INET->new(PeerAddr => $host, PeerPort => 'http(80)') or die "Cannot connect: $!"; # Посылаем запрос на сервер по переданному пути. $socket->print("GET $path HTTP/1.0", CRLF, CRLF); # Отделяем заголовки от полезной нагрузки. my $header = <$socket>; $header =~ s/$CRLF/\n/g; # Печатаем заголовки. STDOUT->print($header); # Печатаем сообщение ответа. STDOUT->print($data) while ($socket->read($data, 1024) > 0); </source> Для примера, обратимся к ресурсу [http://httpbin.org/ip httpbin.org/ip], который является эхо-сервером, возвращающим ваш IP адрес, по которому вы к нему подключаетесь. <source lang="perl"> $ perl pcurl.pl 'http://httpbin.org/ip' HTTP/1.1 200 OK Date: Sat, 27 Sep 2025 08:43:20 GMT Content-Type: application/json Content-Length: 29 Connection: close Server: gunicorn/19.9.0 Access-Control-Allow-Origin: * Access-Control-Allow-Credentials: true { "origin": "5.206.96.5" } </source> Надеемся, что эти простейшие примеры дадут вам представления о некоторых преимуществах ООП подхода. == Примечания == {{примечания}} 4b1off6areudchl45wag5nwjc5asy0h 270385 270384 2026-10-18T09:09:34Z ScriptMaster 15708 /* Метод isa */ 270385 wikitext text/x-wiki {{Навигация учебника}} В языке Perl не существовало специального синтаксиса для описания классов до версии 5.38. Для их реализации использовались существующие синтаксические конструкции. ''Класс в Perl'' представляет собой пакет, а функции в пакете представляют его ''методы''. Таблица символов класса представляет его содержимое — список полей и методов. ''Объект в Perl'' — это ссылка на экземпляр класса, которая строится с помощью специальной функции класса — ''конструктора''. Функция <code>ref()</code> возвращает для ссылки на объект не стандартный идентификатор типа <code>SCALAR</code>, <code>ARRAY</code> и др., а возвращает имя класса, которому принадлежит объект<ref>По внутренней терминологии такая ссылка называется благословлённой ({{lang-en|blessed}})</ref>. В общих чертах, конструктор любого класса для конструирования ссылки на объект должен вызывать функцию <source lang="perl"> bless <ссылка> [, <имя-класса>] </source> которая «''благословляет''» ({{lang-en|to bless}} — благословлять) ссылку на то, чтобы принадлежать к классу, указанному вторым аргументом. Если имя класса опущено, то используется имя текущего пакета. Именно ссылка, возвращаемая этим методом, должна возвращаться из конструктора. После того как объект построен, к нему можно обращаться через квалифицированное имя <code>$<имя-класса>::<ссылка></code>. Наследование в Perl еще сильнее отличается от того, что есть в других языках программирования. В Perl наследуются только методы. Наследование данных реализует сам программист. Наследование методов реализовано так: с каждым пакетом ассоциирован свой массив <code>@ISA</code>, в котором хранится список базовых классов пакета. Если внутри класса вызывается метод, которого нет в текущем классе, то интерпретатор в поисках метода просматривает по порядку методы каждого класса массива <code>@ISA</code>. Затем просматривается предопределенный класс <code>UNIVERSAL</code>. Если и после этого метод не был найден, то классы снова просматриваются в том же порядке в поисках процедуры <code>AUTOLOAD</code>. Если такая находится, то вызывается она вместо отсутствующего метода. В эту процедуру будут переданы все параметры, а в переменной <code>$AUTOLOAD</code> будет хранится имя вызываемого метода. == Объявление класса == === Конструктор === Конструктор класса является простой функцией пакета. Она может иметь любое имя, но на практике обычно используют идентификатор <code>new</code>, как устоявшееся имя для любого конструктора. Самый простой конструктор имеет следующий вид: <source lang="perl"> package MyClass; sub new { my $class = shift; # Передаем конструктору имя класса my $self = {}; # Конструируем ссылку bless $self, $class; # Конструируем объект return $self; # Возвращаем ссылку } # --------------------------------------------- package main; # Конструируем объект $object = MyClass::new("MyClass"); </source> Для примера мы объявляем класс и конструируем его экземпляр в одном исходном файле. Здесь мы это делаем только для демонстрации: на практике классы следует объявлять в отдельных исходных файлах и подключать их через директиву <code>use()</code>. Имя ссылки <code>$self</code> является устоявшимся, и мы настоятельно рекомендуем использовать ее в своих проектах. Данный пример демонстрирует пустой бесполезный класс, в котором нет полей, так как мы конструируем объект из ссылки на пустой хеш. На практике обычно в конструктор передается массив или другой хеш, которым инициализируется ссылка <code>$self</code>. В общем случае не обязательно использовать именно хеш, но его преимущество в том, что мы можем использовать произвольные ключи. Также мы можем передавать массив значений, которыми затем мы можем инициализировать анонимный хеш. Другими словами, подходы здесь могут быть самые разные. На практике конструктор класса обычно имеет следующий вид: <source lang="perl"> sub new { # Предполагается, что $init это ссылка на структуру с инициирующими данными my ( $class, $init ) = @_; $class = ref( $class ) || $class; # Чтобы иметь возможность взять имя по ссылке. # Примечание: если имя класса не будет передано, будет взято имя ближайшего пространства имен. my $self = {}; bless $self, $class; # ... Код инициализирующий поля в ссылке $self через $init ... # ... return $self; } </source> === Деструктор === Когда ссылка на объект выходит из зоны видимости, она удаляется по нулевому счетчику ссылок. Программист может контролировать действия, которые исполнятся перед очисткой ссылки, через ''деструктор'' объекта. Деструктор объекта нужен, чтобы корректно завершить жизненный цикл объекта, например, закрыть открытые объектом файловые дескрипторы. Деструктор всегда вызывается автоматически. Деструктор всегда должен быть объявлен внутри класса и всегда должен иметь имя <code>DESTROY</code>. Также деструктор должен принимать аргумент в виде ссылки на удаляемый объект. Деструктор является необязательным методом объекта, так как ссылка на удаляемый объект в любом случае будет очищаться правильно. Данный метод позволяет вам лучше контролировать этот процесс. Деструктор не вызывает автоматически другие деструкторы, другими словами, если ваш класс наследует другой, деструктор базового класса нужно вызвать явно в деструкторе дочернего. Ниже приведен простой пример деструктора. <source lang="perl"> 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 удаляется перед завершением программы. </source> Если вызвать программу, можно убедиться, что деструктор был вызван для каждого из двух объектов: <source lang=""> Call destructor to delete an instance of MyClass class Call destructor to delete an instance of MyClass class </source> === Другие методы === Методы в Perl могут вызываться от имени конкретного объекта или от имени всего класса. В последнем случае такие методы называются ''статическими''. Статическому методу в первом аргументе всегда передается имя класса, а не статическому — ссылка на объект. Типичным примером статического метода является конструктор (именно поэтому мы ожидаем в первом аргументе имя класса). В Perl методы выполняются в пространстве имен того пакета, в котором они были определены, а не в том, в котором они вызываются. Именно поэтому многие статические методы игнорируют свой первый аргумент. Не статические методы выполняют самую разную работу. Обычно эти действия направлены на инкапсулированные в объекте данные. В Perl полностью инкапсулировать данные невозможно, так как вы можете при желании исправлять их прямо через ссылку на объект (если конечно знаете как он устроен). На практике всегда следует изменять инкапсулированные данные через методы класса, игнорируя то, что сам объект является простой ссылкой, так как в этом и есть ООП подход. <source lang="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 </source> Результат работы программы <source lang="bash"> -- 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 </source> Методы класса можно вызывать двумя способами. Первый способ имеет вид <source lang="perl"> <имя-метода> <имя-класса-или-объект>, <параметры>; 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'}; </source> <source lang="bash"> -- 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 </source> Данная форма представляет собой вызов функции, вложенный в другой вызов. Второй формой мы пользовались в самом первом примере этого раздела: <source lang="perl"> <класс-или-объект>-><метод>(<параметры>) $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'); </source> <source lang="bash"> -- 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 </source> Вторая форма требует обязательного заключения аргументов в скобки. В большинстве случаев вторая форма предпочтительнее в смысле читаемости текста программы, так как оператор разыменовывания наглядно отделяет части выражения. При использовании первой формы могут возникнуть трудноуловимые ошибки, особенно когда действует область видимости, в которой существует функция с тем же именем, что и у метода класса. На практике, особенно для такого языка, как Perl, расточительно создавать полный набор геттеров и сеттеров. В большинстве случаев достаточно написать универсальный сеттер, либо объединить геттер и сеттер одного поля в одном методе: <source lang="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"; </source> === Наследование === Для реализации механизма наследования в Perl используется специальный массив <code>@ISA</code>, в который помещаются родительские классы слева направо от ближайшего к дальнему предку. Если интерпретатор встречает вызов метода, которого нет в данном классе, то он сначала пройдется по классам из <code>@ISA</code> в поисках метода. Если вам нужно вызвать метод родительского класса из дочернего класса, вы можете воспользоваться квалифицированным вызовом метода. Если вам нужен метод ближайшего предка, вы можете использовать имя псевдокласса <code>SUPER</code> (но только из методов потомка). <source lang="perl"> 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; </source> <source lang="bash"> -- 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 </source> В данном примере мы имеем два класса <code>Parent</code> и <code>Child</code>. Родительский класс объявляет два метода: метод <code>Parent::set()</code> нужен, чтобы устанавливать поля структуры класса; метод <code>Parent::show()</code> распечатывает все поля структуры класса. Дочерний класс наследует метод <code>Parent::set()</code>, поэтому мы можем вызывать его без квалификатора типа, и переопределяет метод <code>Parent::show()</code>. Также дочерний класс в своем конструкторе вводит поле <code>born</code>, которое по умолчанию инициализируется нулевым значением. Обратите внимание, как мы определяем методы дочернего класса: все они вводят небольшие изменения в алгоритм, но все равно вызывают методы родительского класса. На практике не всегда нужно поступать так, но конструкторы и деструкторы по логике вещей всегда должны обращаться к конструкторам и деструкторам предков, причем конструирование должно происходить сверху вниз (от дальнего предка к последнему потомку), а для деструкторов снизу вверх (от дальнего потомка к дальнему предку). В последнем операторе мы пытаемся вызывать несуществующий метод из объекта дочернего класса. Так как в родительском классе объявлен метод <code>AUTOLOAD</code>, то будет вызван именно он. ==== Множественное наследование ==== Язык Perl поддерживает множественное наследование за счет массива <code>@ISA</code>. В этом массиве вы можете разместить любое количество родительских классов, методы которых будут просматриваться, если реализации соответствующего метода нет в потомке. Ниже показано наследование, при котором класс <code>Child</code> объединяет в себе свойства двух родительских классов. <source lang="perl"> package Parent1; sub new { my $class = shift; bless {}, $class; } sub greet { return "Parent1::greet\n"; } package Parent2; sub new { my $class = shift; bless {}, $class; } sub talk { return "Parent2::talk\n"; } sub greet { return "Parent2::greet\n"; } package Child; @ISA = qw(Parent1 Parent2); sub new { my $class = shift; return bless {}, $class; } package main; my $child = Child->new; print $child->greet(); # Вызовется реализация Parent1, так как этот родитель в списке наследования раньше. print $child->talk(); # Вызовется реализация Parent2. print $child->Parent2::greet(); # Вызов реализации Parent2. </source> <pre> Parent1::greet Parent2::talk Parent2::greet </pre> Множественное наследование обычно следует избегать, но если всё-таки приходится его использовать, следует быть предельно внимательным и учитывать вероятность получения [[w:Ромбовидное наследование|ромбовидного наследования]], при котором есть вероятность унаследовать один и тот же метод у двух и более родителей. Для языка Perl это не является особой проблемой, так как родители проверяются всегда в одном порядке, но это может приводить к логической ошибке в программе и неправильному поведению объекта класса потомка. Если необходимо изменить порядок проверки родительских классов, следует использовать модуль [https://perldoc.perl.org/mro MRO]. Множественное наследование можно избежать, если использовать [[w:Агрегирование (программирование)|агрегирование]] вместо наследования. Также можно использовать интерфейс ролей класса <code>UNIVERSAL</code>, в котором определен метод <code>DOES()</code>. Переопределив этот метод в потомках, вы можете управлять вызовами в зависимости от того, какую роль берет на себя конкретная реализация. === Использование таблицы символов для генерации методов на ходу === Некоторые стандартные методы, такие как геттеры и сеттеры, могут быть сгенерированы по контексту самой структуры класса. Для этого мы можем пройтись по полям структуры класса и сгенерировать из имен полей стандартные методы устанавливающие и возвращающие значения. Внимательно изучите следующий пример. <source lang="perl"> 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"; </source> <source lang=""> Larry Wall Garry Wall </source> В примере выше мы генерируем как будто бы пустой класс. На самом деле он генерирует свои методы на ходу, а именно при вызове конструктора. Для этого он для каждого поля хеша, передаваемого в конструктор, генерирует анонимную функцию, к которой можно обращаться по ссылке. Для геттеров имя ссылки будет <code>get_<имя-поля></code>, а для сеттеров — <code>set_<имя-поля></code>. Этот пример демонстрирует, что в принципе в Perl можно создавать очень сложные абстрактные классы, но вероятнее всего вам не захочется этим заниматься. == Шаблон модуля, несущего в себе класс == <source lang="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__ Документация </source> == Пакет UNIVERSAL == Все классы в <code>@ISA</code> наследуют пакет с именем <code>UNIVERSAL</code>, который предоставляет несколько методов, реализующих рефлексию классов в Perl. Его можно сравнить с классом <code>Object</code> в языке Java, но <code>UNIVERSAL</code> устроен намного проще. Пакет <code>UNIVERSAL</code> объявляет всего 4 метода, которыми модули могут пользоваться для исследования возможностей текущего программного окружения. === Метод VERSION === Возвращает значение переменной <code>$VERSION</code> пакета (модуля). Переменная <code>$VERSION</code> может быть объявлена непосредственно в пакете, но рекомендуется инициализировать её в директиве <code>package</code>, так как это более наглядно. <source lang="perl"> 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"; </source> <pre> SomePackage version: 1.0 SomePackage version: 1.0 </pre> У метода есть необязательный аргумент, в котором вы можете передать ожидаемый номер версии. Если фактический номер версии оказывается меньше запрашиваемого, функция выбрасывает исключение. Предполагается, что более старшие версии не совместимы с младшими. <source lang="perl"> 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 $@; </source> <pre> SomePackage version 2 required--this is only version 1.0 at .\universal.pl line 18. </pre> === Метод DOES === Проверяет, есть ли в цепочке наследования текущего класса класс с именем, передаваемом в аргументе. Если есть, то возвращает ИСТИНУ, иначе ЛОЖЬ. <source lang="perl"> 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'); </source> <pre> The Child inherits the Parent The Child does not inherit the AnotherClass The Child inherits the Parent </pre> === Метод can === Проверяет, существует ли метод с указанным именем в цепочке наследования или нет. Если метод существует, то метод возвращает ссылку на него, иначе возвращается ЛОЖЬ. <source lang="perl"> 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); </source> <pre> The Parent has 'parentMethod' The Child has 'parentMethod' Child method </pre> === Метод isa === По умолчанию <code>isa</code> и <code>DOES</code> работают абсолютно одинаково, однако метод <code>isa</code> задумывался, чтобы проверить утверждение ''инстанцирована ли ссылка от переданного в аргументе класса ИЛИ этот класс есть в цепочке наследования''<ref>Сравните с операцией <code>instanceof</code> в языке Java.</ref>, а <code>DOES</code> призвана определить, ''может ли этот класс выполнять данный класс задач''. Некоторые CPAN модули переопределяют внутри себя <code>DOES</code>, поэтому он может возвращать отличные от <code>isa</code> ответы. Чтобы уловить суть, рассмотрим такой пример. <source lang="perl"> package Logger 1.0; # ... Реализация всего того, что должен уметь типичный класс, # умеющий логировать. sub write { my ($class, $msg) = @_; print STDOUT "$msg"; } # # ... # package Animal 1.0; # # ... # package Dog; use parent -norequire, qw ( Logger Animal ); sub new { my $class = shift; return bless {}, $class; } sub whoAmI { my ($class) = @_; return __PACKAGE__; } # # ... # package main; my $o = Dog->new(); if ($o->DOES('Logger')) { $o->write("This object can write log messages\n"); } if ($o->isa('Animal')) { print STDOUT $o->whoAmI . " is " . "Animal" . "\n"; } else { print STDOUT $o->whoAmI . " is not " . "Animal" . "\n"; } </source> <pre> This object can write log messages Dog is Animal </pre> В этом примере у нас есть класс <code>Dog</code> (''собака''), который наследует классы <code>Logger</code> и <code>Animal</code> (''животное''). С точки зрения бизнес-логики, ''собака является животным'', т.е. метод <code>isa()</code> должен подчеркивать отношение ООП ''являюсь''. С другой стороны, класс умеет пользоваться подсистемой логирования приложения и писать в общий журнал сообщения. Таким образом <code>DOES()</code> сообщает, что объект наделен ролью ''логера''. Вам может быть сейчас не понятно, почему мы должны разделять эти возможности, но представьте себе модуль логирования, который написан отдельно от вашего приложения, и не знает системы наследования вашего приложения. Обычно вы просто передаете сконструированные объекты этому модулю в виде ссылок, при этом самому модулю важно понять существует ли возможность вызова методов логирования подсистемы логтрования, что и делается через <code>DOES()</code>. == Подведение итогов == Описанный выше подход к ООП не является единственным. Существуют модули CPAN, которые пытаются улучшить эту систему, обогащая описанные выше скудные конструкции (например, модуль Moose). Такие модули, как правило, используются в больших проектах. Однако, как бы там ни было, CPAN модули могут требовать загрузки множества зависимостей и могут замедлять скорость исполнения программы из-за своей внутренней реализации. В маленьких проектах достаточно встроенного в Perl ООП. == Perl 5.38: class или попытка сдвинуться с мёртвой точки == Очень долго тема ООП в Perl стояла на месте, но с версии 5.38 разработчики интерпретатора решили сделать новый шаг в этом направлении и ввели новое ключевое слово в язык — <code>class</code>. Дело в том, что у старого подхода есть много недостатков, что не позволительно для ООП парадигмы, в частности: * По сути у классов нет понятия ''поля класса'', а то что есть не обладает полноценной инкапсуляцией. Кроме того, никак не реализуется наследование полей в дочерние классы. Все эти моменты идут на откуп программисту, который, конечно, в этом разберётся, но вероятно напишет не очень понятный код. * Методы класса внешне не выглядят инкапсулировано: не запрещено разбросать их по пакетам, пользуясь уловками интерпретации, а также никакой приватности реализовать в них нельзя. Кроме того, нужно всегда помнить, что в первый аргумент любого метода передаётся ссылка на объект, что вынуждает писать одинаковую первую строку для всех методов, что очень утомляет (сравните с автоматической ссылкой <code>this</code> в C++). Реализация <code>class</code> на момент 2025 года ещё относительно сырая и ей стоит пользоваться осторожно, но можно потихоньку присматриваться. Если вы хотите использовать эту возможность, то обновите интерпретатор минимум до версии 5.40, потому что первые реализации имеют достаточно серьезные ошибки. === Объявление класса === Так как на момент версии 5.40 возможность является экспериментальной, её нужно включать так: <source lang="perl"> use feature 'class'; # Отключает предупреждения об экспериментальной возможности, которые засоряют вывод. no warnings 'experimental::class'; </source> В синтаксисе чувствуется, что разработчики вдохновлялись языком C++, так как синтаксис очень похож: <source lang="perl"> class <имя> <версия> [: <атрибуты-наследования>] [{ <блок-класса> }] # Также класс может быть объявлен, но не определен. class <имя> [<версия>]; </source> Внутренне слово <code>class</code> работает как <code>package</code>, но дополнительно оно генерирует конструктор по умолчанию для пакета. Номер версии для класса используется, когда используется наследование и у класса есть несколько реализаций, чтобы не сломать обратную совместимость. Номер версии может быть опущен, если атрибуты наследования не используются. Для <code>class</code> было введено слово <code>__CLASS__</code>, которое автоматически разворачивается в имя класса в пределах его определения. Им следует пользоваться для манипуляций с элементами класса, если они происходят до инстанцирования объекта. Вот примеры объявления класса <code>Person</code>: <source lang="perl"> class Person 1.000 { # ... } class WithoutVersion { # ... } # Объявление класса class Empty; </source> === Поля класса === Чтобы объявить поле в классе, используется ключевое слово <code>field</code>. Это ключевое слово инкапсулирует поле в классе и гарантирует, что каждый инстанцированный объект класса получит свой набор полей в памяти программы. Полный синтаксис поля такой: <source lang="perl"> class ClassName { field <переменная> [: <атрибуты>] [= <выражение-вычисляющее-инициализирующее-значение>]; } </source> Например, <source lang="perl"> class Person 1.000 { field $name = "Larry"; field $surname = "Wall"; field $born; } </source> Данный синтаксис позволяет присвоить значение полю до вызова конструктора, а также, когда значение для поля не передается через конструктор. Что-то похожее есть в языке Java, но здесь вы можете использовать полноценное Perl-выражение справа от присваивания. === Методы класса === Чтобы объявить метод, используется ключевое слово <code>method</code>. Методы уже становятся очень похожими на методы языка C++, в частности вы можете обращаться к полям класса не используя ссылку на объект. С помощью ключевого слова можно объявлять удобные сигнатуры: <source lang="perl"> class ClassName { method [<имя-метода>] [<сигнатура-метода>] { <блок-метода> } } </source> Сигнатуры в новой реализации поддерживают значения по умолчанию. Внутри методов вы можете обращаться к экземпляру объекта по ссылке <code>$self</code>. Ниже представлены примеры. <source lang="perl"> 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"; </source> <pre> Person: Name: Larry, Surname: Wall, Born: Person: Name: Larry, Surname: Wall, Born: 27.09.1954 { "name" : "Larry", "surname" : "Wall", "born" : "27.09.1954" } </pre> === Атрибуты === Атрибуты призваны для установки правил видимости и доступа к различным частям класса как внутри него самого, так и из классов-потомков. В документации говорится, что атрибуты будут: * у класса; * у полей класса; * у методов (но на момент 5.40 ни одного атрибута для методов ещё не реализовано). ==== Атрибуты класса ==== У класса на момент 5.40 поддерживаются следующие атрибуты: * <code>:isa</code> — атрибут устанавливает отношение между классами типа ''родитель-потомок''. В атрибуте вписывается имя класса родителя и опционально минимальная необходимая версия этого класса (если фактическая версия родителя меньше запрашиваемого, исполнение прерывается). Так как у полей всегда лексическая видимость, эта система умеет реализовывать только приватное наследование полей в терминах языка C++. Если класс ещё не был загружен в пространство текущего пакета, неявно вызывается процедура <code>require</code>.<source lang="perl"> 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) { # ... } </source> ==== Атрибуты полей ==== У полей на момент 5.42 поддерживаются следующие атрибуты: * <code>:param</code> — указывает на то, что начальное значение для этого поля берется из именованного параметра конструктора. По умолчанию, именованный параметр конструктора и имя поля совпадают, но в параметрах атрибута можно указать другое имя, если так удобно или того требует ситуация. Вы можете оставить выражение, которое присваивает значение по умолчанию, но если его нет, значение всегда должно присваиваться через конструктор.<source lang="perl"> 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 </source> * <code>:reader</code> — генерирует для поля геттер. По умолчанию имя геттера совпадает с именем поля, но в параметре атрибута можно указать другое имя.<source lang="perl"> 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"; </source> * <code>:writer</code> — генерирует для поля сеттер. На момент версии 5.42 сеттер можно сгенерировать только для скалярного поля, иначе будет сгенерирована ошибка времени компиляции. По умолчанию имя сеттера генерируется по шаблону <code>set_<имя-поля></code>, но в параметре атрибута можно указать другое имя. Все генерируемые автоматически сеттеры возвращают ссылку на объект, поэтому сеттеры можно вызывать по цепочке.<source lang="perl"> class ModernPerson { field $name :writer; field $surname :writer(surname); field $born :writer = "unknown"; method printAsString { print __CLASS__ . ":" . " Name: " . $name . ", Surname: " . $surname . ", Born: " . $born . "\n" ; } } my $o = ModernPerson->new; $o->set_name("Larry"); # Вызов по цепочке. $o->surname("Wall")->set_born("27.09.1954"); $o->printAsString; </source> === Жизненный цикл объекта класса === Так как <code>class</code> это по сути замаскированный <code>package</code>, то всё что было сказано ранее в классическом подходе Perl к ООП справедливо и здесь в отношении жизненного цикла. Правда есть одно отличие: для <code>class</code> был добавлен специальный именованный блок <code>ADJUST</code>, который семантически очень похож на <code>BEGIN</code>, но из него вам доступна ссылка на инстанцированный экземпляр класса, т.е. этот блок выполняется сразу за конструктором при конструировании каждого нового объекта. Вы можете указать сколько угодно таких блоков и они будут выполняться в порядке появления. Ниже показаны этапы жизненного цикла на конкретном примере. <source lang="perl"> 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; } </source> <pre> 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 </pre> Мы можем видеть, что при наследовании конструкторы и блоки <code>ADJUST</code> вызываются автоматически в порядке от родителя к потомку. Как и раньше, для деструкторов мы должны закладывать вызов деструктора родителя в деструкторе потомка . == Перегрузка операций классов == В этом разделе мы разберем одну из центральных функций ООП в Perl — ''перегрузка операций''. Многие программисты ругают Perl за очень сложный синтаксис ООП, но на самом деле Perl по большому счёту не нужна ООП парадигма в той форме, в которой она есть, например, в языке Java. Perl в первую очередь всегда решал задачи системного администрирования, где скорее важны минимализм и практичность, так как у системных администраторов время на решение входящих запросов очень ограничено. В Perl существует по меньшей мере два подхода перегружать операции: * '''Перегрузка связыванием'''. Данный тип перегрузки опирается на функцию <code>tie()</code>, которая привязывает объект-делегат к переменной определенного типа данных и переопределяет операции для этой переменной (привязывается к ней). Данный тип перегрузки концентрируется на этапах жизненного цикла объекта и перегружает через ''конструктор'', ''деструктор'', операции ''присваивания'' и ''копирования''. * '''Перегрузка операций класса'''. Реализуется через модуль <code>overload</code> и позволяет перегружать знаки операций для выражений, в которых используется объект некоторого класса. === Перегрузка связыванием === Идея этого подхода кроется в желании обобщить работу с хранилищами данных по отношению к типам данных языка Perl. В языке Perl можно любую структуру представить комбинацией стандартных типов языка (скаляр, массив и хеш-массив). С другой стороны, сценарии Perl обычно конечной целью ставят перед собой прочитать данные из некоторого источника и записать данные в некоторый источник. Обычно протокол работы с определенным типом хранилища данных всегда строго определен. Отсюда возникает желание одни и те же данные записывать в разные типы хранилищ одинаковым, с точки зрения интерфейса, способом. Здесь и появляется функция <code>tie()</code>, которая привязывает реализацию-делегат к экземпляру стандартного типа данных. При этом делегат внутри себя полностью управляет протоколом работы с хранилищем, а наружу для клиентского кода перегружает операции ''присваивание'' и ''извлечение'' через знак операции <code>=</code>. Данный подход впервые появился в Perl 5 и поддерживает привязывание для: * скаляров (<code>Tie::Scalar</code>), * массивов (<code>Tie::Array</code>), * хеш-массивов (<code>Tie::Hash</code>), * файловых дескрипторов (<code>Tie::Handle</code>). Основу интерфейса <code>tie()</code> составляют следующие функции: <source lang="perl"> # Строит экземпляр делегата и привязывает его к переменной. tie <переменная-к-которой-привязывается-делегат>, <класс-делегата>, <список-аргументов-для-конструктора-делегата> # Отвязывает делегата от переменной и удаляет его. untie <переменная-к-которой-привязывается-делегат> # Возвращает ссылку на экземпляр делегата. tied <переменная-к-которой-привязывается-делегат> </source> Состав интерфейсных методов для каждого типа данных отличается, так как каждый тип в чём-то специфичен, но в общем каждый тип представляет следующие методы: * <code>TIEHASH</code>, <code>TIEARRAY</code>, <code>TIEHANDLE</code> и <code>TIESCALAR</code> — конструктор делегата соответственно для хеш-массива, массива, дескриптора и скаляра. Сигнатура конструктора для всех типов одинаковая: в первом аргументе передается имя пакета делегата, а в последующих список аргументов для него. * <code>FETCH</code> — определен для всех типов, кроме дескриптора. Вызывается каждый раз, когда связанная переменная участвует в выражении как правосторонний операнд, т.е. значение из источника извлекается. * <code>STORE</code> — определен для всех типов, кроме дескриптора. Вызывается каждый раз, когда связанная переменная участвует в выражении как левосторонний операнд, т.е. значение в источник записывается. * <code>DESTROY</code> — деструктор делегата. Вам не обязательно переопределять все методы, предоставляемые интерфейсом, так как тривиальные реализации всегда есть в соответствующем пакете <code>Tie::</code>. ==== Связывание скаляров ==== Основы работы с tie-интерфейсом проще всего показать на скаляре, так как для скаляра определено самое малое количество методов: * <code>TIESCALAR</code> — конструктор делегата. * <code>FETCH</code> — метод, извлекающий данные из привязанного скаляра. * <code>STORE</code> — метод, записывающий данные в привязанный скаляр. * <code>DESTROY</code> — деструктор делегата. Ниже показан небольшой пример делегирующего класса. <source lang="perl"> 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 </source> <pre> Tie TieScalarExample: 1, 2, 3 To fetch a record Storing a value: 15 Before untie() </pre> В комментариях к примеру показано, в какие моменты вызываются интерфейсные методы. В этом примере мы привязываем делегата <code>TieScalarExample</code> к скаляру <code>$aScalar</code>, после чего любая операция <code>=</code> будет переводиться на методы привязанного делегата до момента вызова <code>untie()</code> в зависимости от того, в левом или правом операнде операции участвует связанный скаляр. Перед отвязыванием делегата вызывается деструктор делегата. В предыдущем примере делегат по сути ничего не делает, но на практике часто за делегатом скаляра стоит реальное хранилище данных, а сам делегат выступает его драйвером. Ниже представлен конкретный пример, в котором делегат логирует все значения, которые проходят через скаляр в любом направлении. <source lang="perl"> #!/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; </source> Если вы откроете файл лога, то увидите следующие строки: <pre> 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 </pre> а на консоли <source lang="bash"> $ ./tiescalar.pl Printing: Apple Printing: Pear Printing: Grapes Printing: Banana </source> Вы можете увидеть странную запись в логах <pre> package main, ./tiescalar.pl line 54 FETCHED none </pre> Она говорит о том, что списковая операция <code>print</code> внутренне тоже обращается к скаляру. ==== Связывание массивов ==== Интерфейс для массивов уже заметно богаче: * <code>TIEARRAY</code> и <code>DESTROY</code> — конструктор и деструктор делегата. * <code>STORE</code> — вызывается, когда по конкретному индексу записывается значение в массив. * <code>FETCH</code> — вызывается, когда по конкретному индексу извлекается значение из массива. * <code>DELETE</code> — вызывается, когда удаляется элемент по индексу. * <code>CLEAR</code> — вызывается для операции <code>delete</code> для всего массива. * <code>PUSH</code>, <code>POP</code>, <code>SHIFT</code>, <code>UNSHIFT</code>, <code>SPLICE</code> — переопределяет стандартные одноименные операции над массивом. * <code>EXISTS</code> — вызывается, когда проверяется существование значение по индексу. * <code>EXTEND</code> — предполагается, что метод расширяет занимаемую память под массив на указанное число позиций. * <code>FETCHSIZE</code> — предполагается, что возвращает реальное число элементов в массиве. * <code>STORESIZE</code> — предполагается, что подравнивает размер массива под указанное значение. Если часть элементов выходит за пределы, они должны быть удалены. Если новый размер больше текущего, то новые значения должны быть проинициализированы <code>undef</code>. Ниже показано, в какие моменты вызываются методы интерфейса. <source lang="perl"> 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 </source> ==== Связывание хеш-массивов ==== Для хеш-массивов определены следующие методы: * <code>TIEHASH</code> и <code>DESTOROY</code> — конструктор и деструктор делегата. * <code>STORE</code> — сохраняет значение в хеш-массив по ключу. * <code>FETCH</code> — извлекает значение из хеш-массива по ключу. * <code>FIRSTKEY</code> — возвращает самый первый ключ в массиве. * <code>NEXTKEY</code> — возвращает следующий ключ. Используется для перебора элементов хеш-массивов через <code>each()</code>. * <code>EXISTS</code> — проверяет существование ключа. * <code>DELETE</code> — удаляет значение из хеш-массива по ключу. * <code>CLEAR</code> — удаляет хеш-массив целиком. * <code>SCALAR</code> — вызывается, когда к хеш-массиву происходит обращение в скалярном контексте. Ниже показано, в какие моменты вызываются методы интерфейса. <source lang="perl"> 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 </source> Следует дать пояснения по методам <code>FIRSTKEY</code> и <code>NEXTKEY</code>. Эти методы реализуют подобие итератора. Метод <code>FIRSTKEY</code> вызывается всегда, когда хеш-массив передается функции <code>keys()</code> или <code>each()</code>. Этот метод должен сбросить состояние итератора, если оно не начальное, и вернуть начало хеш-массива. Метод <code>NEXTKEY</code> возвращает последующий элемент, вычисленный от последнего, переданного аргументом <code>$lastkey</code>. Если возвращать нечего, нужно вернуть значение <code>undef</code>, которое говорит, что элементы закончились. ==== Связывание дескрипторов ==== Связывание для файловых дескрипторов в Perl очень полезный функционал в *nix системах, так как в них через файловые дескрипторы можно получить доступ к любой части системы. Например, можно подключаться к блочным или символьным устройствам через специальные файлы и работать с ними через операции файловых дескрипторов из кода Perl. Так как через дескрипторы ходят символьные потоки, в них нет методов <code>STORE</code> и <code>FETCH</code>, а используются методы <code>WRITE</code> и <code>READ</code>. Интерфейс поддерживает следующие методы: * <code>TIEHANDLE</code> и <code>DESTROY</code> — конструктор и деструктор делегата. * <code>WRITE</code> — записывает указанное число байтов с некоторого начального адреса и некоторого смещения от его начала. * <code>READ</code> — читает указанное число байтов с некоторого начального адреса и некоторого смещения от его начала. * <code>READLINE</code> — читает несколько байтов до некоторого разделителя. * <code>GETC</code> — читает очередной символ в символьном потоке. * <code>PRINT</code> — печатает значения в переданном списке. * <code>PRINTF</code> — печатает значения в списке с использованием форматной строки. * <code>OPEN</code> — открывает или переоткрывает файловый дескриптор. * <code>CLOSE</code> — закрывает файловый дескриптор. * <code>BINMODE</code> — указывает на то, что читаемый поток представляет собой поток байтов, а не отдельных символов (другими словами, включает бинарный режим чтения). * <code>EOF</code> — возвращает истину, если поток закончился. * <code>TELL</code> — возвращает текущую позицию в файле. * <code>SEEK</code> — передвигает позицию в файле относительно некоторой опорной точки. Ниже показано, в какие моменты вызываются методы интерфейса. <source lang="perl"> use strict; package TieHandleExample; sub TIEHANDLE { my ($class, @argv) = @_; return bless {}, $class; } sub WRITE { my ($self, $address, $length, $offset) = @_; } sub READ { my ($self, $address, $length, $offset) = @_; } 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, $offset, $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 $offset, 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 </source> Для этого типа связывания мы приведем два конкретных примера использования. Наверное вы знаете Unix утилиту [[w:tee|tee]]. Основной задачей этой утилиты является копирование и перенаправление основного потока. Например, этим пользуются, когда вывод программы нужно видеть на консоли и одновременно с этим логировать его в файл (возможно в несколько файлов). В Perl можно реализовать возможности <code>tee</code> следующим образом. <source lang="perl"> #!/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; </source> В примере выше мы открываем 5 дескрипторов: 4 связывается с файлами (<code>tmp1</code>, <code>tmp2</code>, <code>tmp3</code>, <code>tmp4</code>), причем <code>tmp3</code> открывается на дозапись, и один связывается со стандартным потоком вывода (<code>-</code>). Все эти дескрипторы представляет один общий, который мы назвали <code>BROADCAST</code> и к которому мы привязали свою реализацию метода <code>PRINT</code>. Она не очень сложная и занимается тем, что для каждого открытого ранее дескриптора вызывает функцию <code>print</code> и передает список для печати. После запуска программы, вы можете видеть, как создаются 4 файла, и один и тот же вывод транслируется в каждый из них и на консоль. Следующий пример показывает, как приложение может переключать источник ввода. Если приложению не передано ни одного аргумента командной оболочки, то приложение читает стандартный поток ввода. <source lang="perl"> 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; </source> <source lang="bash"> # Аргументы переданы явно $ perl ./selecthandle.pl 1 2 3 1 2 3 # А теперь данные поставляются через STDIN. $ seq 1 3 | perl ./selecthandle.pl 1 2 3 </source> === Перегрузка операций через модуль overload === Второй подход перегрузки операций заключается в использовании директивного модуля <code>overload</code>. Данный модуль позволяет перегрузить часть стандартных операций в отношении произвольного класса. Данный модуль разрешает перегружать только те операции, которые перечислены в хеш-массиве <code>%overload::ops</code>. На момент версии 5.40 состав перегружаемых операций таков: <source lang="bash"> $ 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' }; </source> Обратите внимание, что операции в этом массиве отсортированы по категориям. Большинство операций в этом списке однозначно соответствуют их знакам, но есть и исключения. * Операции <code>not</code> нет в списке перегружаемых операций, однако, если вы перегружаете <code>!</code>, то при вызове <code>not</code> будет использоваться реализация для <code>!</code>. * Точно так же операция унарного минуса <code>-</code> будет использовать реализацию для <code>neg</code>. * При перегрузке инкремента <code>++</code> и декремента <code>--</code>, Perl не будет делать отдельные реализации для префиксной и постфиксной формы (как, например, это делается в языке C++), однако точка вызова их в выражении будет поставлена так, чтобы отрабатывала префиксная или постфиксная форма. Эти операции находятся в категории <code>mutators</code>, что говорит о том, что они работают не с копией значения, а ссылкой на него. * Операцию присваивания <code>=</code> нельзя перегрузить с помощью этого модуля, так как она зарезервирована для конструктора копирования класса. Единственный способ её перегрузить — это использовать интерфейс <code>tie()</code>. Тем не менее, вы можете перегружать прочие разновидности присваивания (категория <code>assign</code>), так как они работают с ссылкой. * Операции<pre>+ - * / % ** << >> x . & | ^ &. |. ^.</pre>не должны изменять свои операнды, так как они передаются по ссылке и это было бы некорректным поведением. Другими словами, они должны конструировать новое значение в качестве результата. * Все операции тестирования файла (<code>-f</code>, <code>-x</code> и др.) перегружаются одной и той же операцией <code>-X</code>, и перегрузить их по-отдельности невозможно. Тем не менее, вы можете распознать какой тест передаётся через второй аргумент, несмотря на то, что операция унарная. Обычно, если вам требуется перегрузить операции для вашего класса, минимально рекомендуется перегружать следующие: <pre> + - * / % ** << >> x <=> cmp & | ^ ~ &. |. ^. ~. atan2 cos sin exp log sqrt int "" 0+ bool ~~ </pre> ==== Основы перегрузки ==== * Перегрузка операции происходит в момент вызова модуля <code>overload</code>. Вы должны указать знак операции из таблицы <code>%overload::ops</code> в качестве ключа, а затем присвоить ссылку на процедуру любым доступным способом<source lang="perl"> use overload "-" => "minus", # Перегрузка с помощью символической ссылки. "*=" => \&muas, # Перегрузка с помощью жесткой ссылки. '""' => sub { ...; }; # Объявление анонимной процедуры на месте. </source> * Объявленные процедуры должны быть реализованы в ближайшем к директиве пакете. Обычно это пакет класса, которому требуется перегрузка операций. Допустимо указывать реализацию из другого пакета. Кроме того, если реализация наследуется, то к ней справедливы все правила наследования, описанные выше. Например, если есть классы <code>A -> B -> C</code>, где стрелка указывает на родителя, и классы <code>B</code> и <code>С</code> перегружают одну и ту же операцию, <code>A</code> будет искать по списку <code>@ISA</code> ближайшую в цепочке наследования реализацию. * Все перегружающие процедуры объявляются одинаково<source lang="perl"> sub overloadImpl { my ($self, $other, $swap) = @_; ... return $result; } </source>Однако, интерпретация входящих аргументов и тип возвращаемого значения зависят от смысла операции (см. ниже). * Для некоторых операций, которые связаны по смыслу разными знаками, Perl может генерировать реализацию автоматически для той части, которая не была перегружена явно. Например, операции <code>0+</code><ref>Операция <code>0+</code> называется «Венерой» из-за внешней схожести с [[w:Зеркало Венеры|зеркалом Венеры]]. Данная операция пытается преобразовать строку в число в скалярном контексте.</ref>, <code>""</code>, и <code>bool</code> могут предоставить свою реализацию операции <code>!</code>, если та не была перегружена, а хотя бы одна из них была перегружена. * Ключ <code>nomethod</code> может использоваться для объявления универсальной перегрузки, которая будет вызываться для любой не перегруженной индивидуально операции. * Установка флага <code>fallback</code> даёт модулю подсказку, как он должен поступать с вызовом, если не удаётся найти для операции перегруженную реализацию. ==== Реализующая процедура ==== Перегрузка бинарных и унарных операций происходит по одному прототипу входящих параметров<source lang="perl">my ($self, $other, $swap, $nomethod, $binary) = @_;</source>Здесь * <code>$self</code> — ссылка на объект класса, для которого была перегружена операция; * <code>$other</code> — второй операнд или параметр унарной операции; * <code>$swap</code> — флаг, который говорит о том, находится ли ссылка на объект слева (ЛОЖЬ) от знака операции или справа (ИСТИНА). Реализующая процедура обычно возвращает ссылку на результат. Здесь многое зависит от того, какой смысл закладывается в перегрузку. Флаг <code>$swap</code> многогранный. Он используется и в бинарных, и унарных операциях, но ЛОЖЬ в них представляется по-разному. В бинарных операциях ЛОЖЬ представляется пустой строкой <code><nowiki>''</nowiki></code>, а в унарных операциях и операциях класса <code>assign</code> используется <code>undef</code>. Существуют также 4-й и 5-й параметры, которые инициализируются в особых ситуациях. Если перегружена специальная операция <code>nomethod</code>, которая по смыслу похожа на <code>AUTOLOAD</code> (но для операций), 4-й параметр всегда инициализируется знаком операции. Для побитовых операций (<code>&</code>, <code>|</code>, <code>^</code> и <code>~</code>) инициализируется 5-й параметр, чтобы, возможно, подсказать реализации о необходимости работать с операндами как с числами. ==== Автогенерируемые операции ==== Если вызывается операция для некоторого класса и при этом для неё нет перегруженной реализации, модуль <code>overload</code> руководствуется встроенным в него флагом <code>fallback</code>, который по умолчанию имеет значение ИСТИНА. Алгоритм поиска реализации операции таков: # Если операция перегружена в объекте вызываемого класса, то использовать реализацию в этом классе, иначе идём дальше. # Если <code>fallback</code> ИСТИНА или <code>undef</code>, попытаться сгенерировать автоматическую реализацию. # Если операция не относится к категории <code>assign</code>, то повторить шаг 1 для второго операнда. # Повторить шаг 2 для второго операнда. # Если для первого операнда все сводится к <code>nomethod</code> реализации, то использовать её. # Если для второго операнда все сводится к <code>nomethod</code> реализации, то использовать её. # Если <code>fallback</code> ИСТИНА и не нашлось ни одной реализации, то попытаться обработать операнды в соответствии с типом операции. Например, если операция арифметическая, то попытаться привести операнды к числам; если строковая — строкам и т.д. # Если ничего из этого не может корректно отработать, то бросить исключение. В этом алгоритме для унарных операции опускаются шаги, связанные со вторым операндом. Хотя правила выше кажутся прозрачными, существует очень много подводных камней в ситуациях, когда не удаётся найти реализацию, поэтому стоит перегружать операции всегда с большой внимательностью. Для некоторых операций могут использоваться близкие по смыслу операции, которые могут предоставить свою реализацию, если целевая не была определена. Вы можете ознакомиться с ними в официальной документации [https://perldoc.perl.org/overload#Magic-Autogeneration Magic-Autogeneration]. ==== Пример перегрузки ==== На практике перегрузка зачастую используется, чтобы выразить идею программы более наглядно — добавить синтаксического сахара. Пример ниже демонстрирует модуль, который, используя операцию <code><<</code>, представляет поток строк, который, возможно, используется шаблонизатором<ref>Программой, которая, используя некоторый шаблон, генерирует конечный текстовый документ.</ref>. В данный поток можно встраивать условия, чтобы игнорировать некоторые части шаблона в зависимости от текущих условий. Внимательно изучите следующий код. <source lang="perl"> 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; </source> Данный модуль представляет класс <code>StringStream</code>, который имеет два атрибута: <code>stream</code> и <code>if_stack</code>. Атрибут <code>stream</code> представляет собой ссылку на строковый массив, в который набираются части результирующей строки. Чтобы в потоке строк иметь возможность игнорировать некоторые части, класс реализует собственные операции, которые могут представлять условия. Они реализуются за счет встроенных классов, которые не видны клиентскому коду, но которые может интерпретировать <code>StringStream</code>. Эти классы имитируют конструкцию <code>If...ElseIf...Else</code>, но, чтобы отмечать границу конструкции, используется терминирующая операция <code>Endl</code>. Создать экземпляры встроенных классов можно только с помощью функций-оболочек, которые имеют имена <code>If</code>, <code>ElseIf</code>, <code>Else</code> и <code>Endl</code>, причем в <code>If</code> и <code>ElseIf</code> можно передавать выражения, которые выполняют роль условных конструкций. Весь секрет этого класса кроется в том, что он и его скрытые классы перегружают знак операции <code><<</code>, который отсылает к одной единственной процедуре <code>__stream_element</code>. Данная процедура анализирует второй операнд и, используя массив <code>if_stack</code>, отключает части потока строк, в зависимости от результатов условных выражений. Данная система не проверяет некоторые некорректные ситуации и ожидает, что ни один <code>ElseIf</code> не будет встречаться раньше чем <code>If</code>; <code>Else</code> не будет стоять раньше <code>If</code> и <code>ElseIf</code>, а каждая открытое условие <code>If</code> будет терминироваться <code>Endl</code>. Кроме операции <code><<</code> класс <code>StringStream</code> также перегружает операцию <code>q{""}</code>, которая используется в скалярном контексте, чтобы сформировать из набранной строки окончательную. Ниже показан пример использования. <source lang="perl"> #!/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 ; </source> В данном примере анализируется входящий массив аргументов и, в зависимости от переданного числа аргументов, печать выводится по-разному: <source lang="perl"> # Предполагается, что файл модуля лежит в рабочем каталоге. $ 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 </source> Обратите внимание, что мы могли бы конструировать строку без использования этого «сахара», но конечная конструкция изобиловала бы множеством операций конкатенации, ветвлений и циклов. Другими словами, мы концентрируемся на задаче сформировать строку по нашим правилам простыми средствами. == Объектно-ориентированный подход в системе ввода-вывода == С появлением в Perl 5 модулей, в систему ввода-вывода также был добавлен ООП подход в виде интерфейсного класса [https://perldoc.perl.org/IO::Handle IO::Handle] и его классов-потомков, таких как <code>IO::File</code>, <code>IO::Pipe</code>, <code>IO::Socket</code> и других. Это позволяет облегчить написание программ, требующих работы с операциями [[../Ввод и вывод|ввода и вывода]], рассмотренные нами ранее. В данном разделе мы рассмотрим этот интерфейс, чтобы продемонстрировать, как ООП подход может упростить и унифицировать написание кода, связанного с вводом-выводом по файловым дескрипторам. === Интерфейс IO::Handle === Интерфейс, реализуемый модулем <code>IO::Handle</code>, содержит универсальные методы, применяемые для всех объектов, которые в своей реализации открывают файловый дескриптор. Более специализированные классы, например <code>IO::File</code> (обычный файл), предоставляют дополнительные методы, учитывающие нюансы работы с данным типом файла, но так или иначе переопределяют методы, вводимые классом <code>IO::Handle</code>. Вместе эти классы сглаживают некоторые недостатки встроенных дескрипторов файлов Perl и упрощают понимание и сопровождение программ. Объект <code>IO::Handle</code> может быть построен одним из двух конструкторов: * '''Конструктор без аргументов''' (<code>new()</code>) позволяет построить пустой объект класса <code>IO::Handle</code>. Далее необходимо сделать библиотечный вызов <code>fdopen()</code> через одноименный метод, чтобы открыть файловый дескриптор с определенным режимом. Так как этот вызов требует знания флагов и атрибутов, его вызов не очень удобен на практике. Конструкторы в классах, наследующих этот интерфейс, скрывают этот вызов в своих реализациях. * '''Конструктор с аргументами''' (<code>new_from_fd ()</code>) позволяет построить объект и привязать к нему уже открытый дескриптор. Главным образом используется, когда нет нужной реализации интерфейса, но требуется использовать методы <code>IO::Handle</code>. Методы <code>IO::Handle</code> в основном копируют одноименные функции ввода-вывода: <source lang="perl"> $io->close # Закрыть дескриптор. $io->eof # Возвращает признак конца потока EOF. $io->fcntl( FUNCTION, SCALAR ) # Управляет флагами файлового дескриптора. $io->fileno # Возвращает номер файлового дескриптора. $io->format_write( [FORMAT_NAME] ) # Аналог функции write(), т.е. запись по формату. $io->getc # Прочитать очередной символ. $io->ioctl( FUNCTION, SCALAR ) # Делает системный вызов ioctl() для управления устройством ввода-вывода. $io->read ( BUF, LEN, [OFFSET] ) # Буферизированное чтение. $io->write ( BUF, LEN [, OFFSET ] ) # Буферизированная запись. $io->print ( ARGS ) # Буферизированная запись. $io->printf ( FMT, [ARGS] ) # Буферизированная запись по форматной строке. $io->say ( ARGS ) # Буферизированная запись с переносом строки. $io->stat # Реализация функции stat(). $io->sysread ( BUF, LEN, [OFFSET] ) # Не буферизированное чтение $io->syswrite ( BUF, [LEN, [OFFSET]] ) # Не буферизированная запись. $io->truncate ( LEN ) # Смещает указатель записи в начало, что аналогично удалению данных. $io->opened # Возвращает ИСТИНУ, если дескриптор открыт. $io->getline # Возвращает строку до разделителя. $io->getlines # Возвращает строки до конца потока. $io->ungetc ( ORD ) # Возвращает из потока символ с указанным порядковым номером. $io->error # Возвращает ИСТИНУ, если возникала ошибка ввода-вывода. $io->clearerr # Сбрасывает флаг ошибки. Возвращает -1, если дескриптор находится в состоянии ошибки. $io->sync # Реализует синхронизацию данных в буфере и на носителе на уровне системы (не PerlIO). Может не поддерживаться на некоторых системах. $io->flush # Сброс буферов ввода-вывода, связанных с дескриптором. $io->printflush ( ARGS ) # Реализует сброс буферов только для текущей операции, а затем восстанавливает состояние флага сброса. $io->blocking ( [ BOOL ] ) # Если в аргументе передается ИСТИНА, делает операции ввода-вывода неблокирующими. </source> Также интерфейс позволяет управлять встроенными переменными языка Perl, управляющими вводом-выводом. Следующие методы управляют значениями для конкретного экземляра класса: <source lang="perl"> $io->autoflush ( [BOOL] ) # Управляет $| (управление буферизацией) $io->format_page_number( [NUM] ) # Управляет $% (номер страницы при выводе по формату) $io->format_lines_per_page( [NUM] ) # Управляет $= (число строк на страницу при выводе по формату) $io->format_lines_left( [NUM] ) # Управляет $- (число строк на текущей странице при выводе по формату) $io->format_name( [STR] ) # Управляет $~ (имя текущего формата) $io->format_top_name( [STR] ) # Управляет $^ (имя формата, который является верхним колонтитулом) $io->input_line_number( [NUM]) # Управляет $. (номер последней прочитанной строки последнего удачного чтения) </source> Следующие переменные управляются из этого интерфейса, но применяются ко всем открытым дескрипторам (т.е. методы являются статическими): <source lang="perl"> IO::Handle->format_line_break_characters( [STR] ) # $: (хранит символы переноса строк) IO::Handle->format_formfeed( [STR]) # $^L (управляющий символ перехода на новую страницу при выводе по формату) IO::Handle->output_field_separator( [STR] ) # $, (разделитель полей при печати функцией print) IO::Handle->output_record_separator( [STR] ) # $\ (символ, добавляемый в конец при печати функцией print) IO::Handle->input_record_separator( [STR] ) # $/ (символ разделителя записей при чтении из файлов) </source> Ниже показан небольшой пример работы с <code>IO::Handle</code>. <source lang="perl"> # Файл: handle.pl use strict; use warnings; use IO::Handle; my @strings; # Открываем дубликат дескриптора STDIN, чтобы работать с ним из экземпляра IO::Handle. my $io = IO::Handle->new_from_fd(fileno(STDIN),"r"); if ($io->opened) { push @strings, $_ while $_ = $io->getline; $io->close; print "Record number: " . @strings . "\n"; } # Следующая печать показывает, что закрылся только дубликат, а не STDIN. print "Object \$io " . ($io->opened ? "is opened" : "is closed") . "\n"; # При подключении модуля IO::Handle, все открытые дескрипторы неявно получают доступ к интерфейсным методам. print "STDIN " . (STDIN->opened ? "is opened" : "is closed") . "\n"; our $out; # Открываем дубликат дескриптора STDOUT, чтобы работать с ним из экземпляра IO::Handle. # Для примера, дубликат открывается методом fdopen(). { $out = IO::Handle->new(); if ($out->fdopen(fileno(STDOUT),"w")) { print "Printing 1:\n"; foreach my $line (@strings) { $out->write($line); } } # При обнулении ссылки, будет вызван деструктор, в котором close() вызывается неявно. undef $out; } # Мы могли не создавать дубликат STDOUT, а писать в него напрямую через интерфейс. print "Printing 2:\n"; foreach my $line (@strings) { STDOUT->write($line); } </source> <source lang="bash"> $ echo -e "aaa\nbbb\nccc" | perl handle.pl Record number: 3 Object $io is closed STDIN is opened Printing 1: aaa bbb ccc Printing 2: aaa bbb ccc </source> Приведенный выше пример плохо показывает, чем ООП парадигма в данном случае лучше процедурной, однако, мы всё же перечислим некоторые преимущества такого подхода: * Вы можете заметить, что вы не работаете с дескрипторами напрямую. По сути вы работаете с ссылками на объекты, которые инкапсулируют дескриптор внутри себя. Если бы программа была больше и в ней бы требовалось передавать дескриптор различным её частям, поддерживать код с передачей ссылки на объект намного проще, чем передачу дескриптора. * Жизненный цикл объекта отчасти перекладывается на систему очистки ссылок Perl: вам легче освобождать ресурсы системы, так как их освобождают автоматически вызываемые деструкторы. * В начале исходного файла вы всегда подключаете нужный вам модуль пространства <code>IO::</code>, что может давать подсказку читающему программу, что данный код работает с определенным типом файла. При работе с дескрипторами напрямую, невозможно дать такую подсказку без длинного комментария. В большой программе (в несколько тысяч строк), чтобы уловить намерения работы с дескриптором, вам придется внимательно изучить все вызовы, в которых участвует дескриптор. * При любых фатальных ошибках конкретная реализация интерфейса, как правило, выбрасывает исключение, которое перехватывать проще, чем проверять коды возврата. === Примеры === Ниже приведено несколько примеров применения потомков <code>IO::Handle</code>. Следующая программа открывает простой файл, переданный аргументом, и считает сколько в нём строк. В этом примере используется класс <code>IO::File</code> для работы с файлом в ООП стиле. <source lang="perl"> # Файл: line_counter.pl use strict; use warnings; use IO::File; my $file = shift; my $counter = 0; my $io = IO::File->new($file) or die "Cannot open $file: $!\n"; $counter++ while defined $io->getline; STDOUT->print("File '$file' contains $counter lines\n"); </source> <source lang="bash"> $ cat > file.txt <<EOF 1 2 3 4 5 6 EOF $ perl line_counter.pl file.txt File 'file.txt' contains 6 lines </source> Вернемся к примеру, рассмотренному в разделе [[../Ввод и вывод#Открытие канала через pipe()|Открытие канала через pipe()]]. При работе с каналом в процедурном стиле код получается довольно громоздким. Теперь посмотрите на то, как код будет выглядеть, если управлять каналом через объект класса <code>IO::Pipe</code>. <source lang="perl"> # Файл: pipe.pl use strict; use warnings; use IO::Pipe; # Строим объект одностороннего канала. my $pipe = IO::Pipe->new(); # Создаем со-процесс. my $pid = fork(); if (defined $pid) { if ($pid == 0) { # Пересоздаем объект так, чтобы на этом конце можно было только писать в канал. # Также отключаем буферизацию. $pipe->writer()->autoflush(); $pipe->print("Hello from child process\n"); $pipe->close(); exit 0; } else { # Пересоздаем объект так, чтобы на этом конце можно было только читать канал. $pipe->reader(); while (defined (my $line = $pipe->getline)) { STDOUT->print("Parent received: $line"); } $pipe->close(); waitpid $pid, 0; } } else { die "Could not fork: $!"; } </source> <source lang="bash"> $ perl pipe.pl Parent received: Hello from child process </source> Обратите внимание, что код стал намного чище. Наконец, продемонстрируем простейший Web-клиент, использующий модуль <code>IO::Socket</code>. Использование ООП подхода в этой задаче избавляет вас от изнурительного труда по настройке сетевого сокета через библиотеку <code>Socket</code>. <source lang="perl"> # Файл: pcurl.pl use strict; use warnings; # Импортируем IO::Socket и подключаем некоторые константы. use IO::Socket qw ( :DEFAULT :crlf ); # Изменяем стандартный разделитель строк на разделитель CRLFCRLF, так как им # заканчивается список заголовков. IO::Handle->input_record_separator( CRLF . CRLF ); # Пользователь передает URL для подключения. my $url = shift or die "pcurl.pl <URL>\n"; my $data; # Регулярными выражениями выделяем в URL хост и путь до ресурса. Этот клиент работает # только по протоколу HTTP. my ($host, $path) = $url =~ m!^http://([^/]+)(/[^\#]*)! or die "Invalid URL.\n"; # Открываем сетевой сокет и пытаемся подключиться к сетевой службе по порту 80. my $socket = IO::Socket::INET->new(PeerAddr => $host, PeerPort => 'http(80)') or die "Cannot connect: $!"; # Посылаем запрос на сервер по переданному пути. $socket->print("GET $path HTTP/1.0", CRLF, CRLF); # Отделяем заголовки от полезной нагрузки. my $header = <$socket>; $header =~ s/$CRLF/\n/g; # Печатаем заголовки. STDOUT->print($header); # Печатаем сообщение ответа. STDOUT->print($data) while ($socket->read($data, 1024) > 0); </source> Для примера, обратимся к ресурсу [http://httpbin.org/ip httpbin.org/ip], который является эхо-сервером, возвращающим ваш IP адрес, по которому вы к нему подключаетесь. <source lang="perl"> $ perl pcurl.pl 'http://httpbin.org/ip' HTTP/1.1 200 OK Date: Sat, 27 Sep 2025 08:43:20 GMT Content-Type: application/json Content-Length: 29 Connection: close Server: gunicorn/19.9.0 Access-Control-Allow-Origin: * Access-Control-Allow-Credentials: true { "origin": "5.206.96.5" } </source> Надеемся, что эти простейшие примеры дадут вам представления о некоторых преимуществах ООП подхода. == Примечания == {{примечания}} 3qtu3hdemux6jg6psmc2hdglzq6qnaw 270386 270385 2026-10-18T09:10:02Z ScriptMaster 15708 /* Метод isa */ 270386 wikitext text/x-wiki {{Навигация учебника}} В языке Perl не существовало специального синтаксиса для описания классов до версии 5.38. Для их реализации использовались существующие синтаксические конструкции. ''Класс в Perl'' представляет собой пакет, а функции в пакете представляют его ''методы''. Таблица символов класса представляет его содержимое — список полей и методов. ''Объект в Perl'' — это ссылка на экземпляр класса, которая строится с помощью специальной функции класса — ''конструктора''. Функция <code>ref()</code> возвращает для ссылки на объект не стандартный идентификатор типа <code>SCALAR</code>, <code>ARRAY</code> и др., а возвращает имя класса, которому принадлежит объект<ref>По внутренней терминологии такая ссылка называется благословлённой ({{lang-en|blessed}})</ref>. В общих чертах, конструктор любого класса для конструирования ссылки на объект должен вызывать функцию <source lang="perl"> bless <ссылка> [, <имя-класса>] </source> которая «''благословляет''» ({{lang-en|to bless}} — благословлять) ссылку на то, чтобы принадлежать к классу, указанному вторым аргументом. Если имя класса опущено, то используется имя текущего пакета. Именно ссылка, возвращаемая этим методом, должна возвращаться из конструктора. После того как объект построен, к нему можно обращаться через квалифицированное имя <code>$<имя-класса>::<ссылка></code>. Наследование в Perl еще сильнее отличается от того, что есть в других языках программирования. В Perl наследуются только методы. Наследование данных реализует сам программист. Наследование методов реализовано так: с каждым пакетом ассоциирован свой массив <code>@ISA</code>, в котором хранится список базовых классов пакета. Если внутри класса вызывается метод, которого нет в текущем классе, то интерпретатор в поисках метода просматривает по порядку методы каждого класса массива <code>@ISA</code>. Затем просматривается предопределенный класс <code>UNIVERSAL</code>. Если и после этого метод не был найден, то классы снова просматриваются в том же порядке в поисках процедуры <code>AUTOLOAD</code>. Если такая находится, то вызывается она вместо отсутствующего метода. В эту процедуру будут переданы все параметры, а в переменной <code>$AUTOLOAD</code> будет хранится имя вызываемого метода. == Объявление класса == === Конструктор === Конструктор класса является простой функцией пакета. Она может иметь любое имя, но на практике обычно используют идентификатор <code>new</code>, как устоявшееся имя для любого конструктора. Самый простой конструктор имеет следующий вид: <source lang="perl"> package MyClass; sub new { my $class = shift; # Передаем конструктору имя класса my $self = {}; # Конструируем ссылку bless $self, $class; # Конструируем объект return $self; # Возвращаем ссылку } # --------------------------------------------- package main; # Конструируем объект $object = MyClass::new("MyClass"); </source> Для примера мы объявляем класс и конструируем его экземпляр в одном исходном файле. Здесь мы это делаем только для демонстрации: на практике классы следует объявлять в отдельных исходных файлах и подключать их через директиву <code>use()</code>. Имя ссылки <code>$self</code> является устоявшимся, и мы настоятельно рекомендуем использовать ее в своих проектах. Данный пример демонстрирует пустой бесполезный класс, в котором нет полей, так как мы конструируем объект из ссылки на пустой хеш. На практике обычно в конструктор передается массив или другой хеш, которым инициализируется ссылка <code>$self</code>. В общем случае не обязательно использовать именно хеш, но его преимущество в том, что мы можем использовать произвольные ключи. Также мы можем передавать массив значений, которыми затем мы можем инициализировать анонимный хеш. Другими словами, подходы здесь могут быть самые разные. На практике конструктор класса обычно имеет следующий вид: <source lang="perl"> sub new { # Предполагается, что $init это ссылка на структуру с инициирующими данными my ( $class, $init ) = @_; $class = ref( $class ) || $class; # Чтобы иметь возможность взять имя по ссылке. # Примечание: если имя класса не будет передано, будет взято имя ближайшего пространства имен. my $self = {}; bless $self, $class; # ... Код инициализирующий поля в ссылке $self через $init ... # ... return $self; } </source> === Деструктор === Когда ссылка на объект выходит из зоны видимости, она удаляется по нулевому счетчику ссылок. Программист может контролировать действия, которые исполнятся перед очисткой ссылки, через ''деструктор'' объекта. Деструктор объекта нужен, чтобы корректно завершить жизненный цикл объекта, например, закрыть открытые объектом файловые дескрипторы. Деструктор всегда вызывается автоматически. Деструктор всегда должен быть объявлен внутри класса и всегда должен иметь имя <code>DESTROY</code>. Также деструктор должен принимать аргумент в виде ссылки на удаляемый объект. Деструктор является необязательным методом объекта, так как ссылка на удаляемый объект в любом случае будет очищаться правильно. Данный метод позволяет вам лучше контролировать этот процесс. Деструктор не вызывает автоматически другие деструкторы, другими словами, если ваш класс наследует другой, деструктор базового класса нужно вызвать явно в деструкторе дочернего. Ниже приведен простой пример деструктора. <source lang="perl"> 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 удаляется перед завершением программы. </source> Если вызвать программу, можно убедиться, что деструктор был вызван для каждого из двух объектов: <source lang=""> Call destructor to delete an instance of MyClass class Call destructor to delete an instance of MyClass class </source> === Другие методы === Методы в Perl могут вызываться от имени конкретного объекта или от имени всего класса. В последнем случае такие методы называются ''статическими''. Статическому методу в первом аргументе всегда передается имя класса, а не статическому — ссылка на объект. Типичным примером статического метода является конструктор (именно поэтому мы ожидаем в первом аргументе имя класса). В Perl методы выполняются в пространстве имен того пакета, в котором они были определены, а не в том, в котором они вызываются. Именно поэтому многие статические методы игнорируют свой первый аргумент. Не статические методы выполняют самую разную работу. Обычно эти действия направлены на инкапсулированные в объекте данные. В Perl полностью инкапсулировать данные невозможно, так как вы можете при желании исправлять их прямо через ссылку на объект (если конечно знаете как он устроен). На практике всегда следует изменять инкапсулированные данные через методы класса, игнорируя то, что сам объект является простой ссылкой, так как в этом и есть ООП подход. <source lang="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 </source> Результат работы программы <source lang="bash"> -- 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 </source> Методы класса можно вызывать двумя способами. Первый способ имеет вид <source lang="perl"> <имя-метода> <имя-класса-или-объект>, <параметры>; 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'}; </source> <source lang="bash"> -- 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 </source> Данная форма представляет собой вызов функции, вложенный в другой вызов. Второй формой мы пользовались в самом первом примере этого раздела: <source lang="perl"> <класс-или-объект>-><метод>(<параметры>) $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'); </source> <source lang="bash"> -- 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 </source> Вторая форма требует обязательного заключения аргументов в скобки. В большинстве случаев вторая форма предпочтительнее в смысле читаемости текста программы, так как оператор разыменовывания наглядно отделяет части выражения. При использовании первой формы могут возникнуть трудноуловимые ошибки, особенно когда действует область видимости, в которой существует функция с тем же именем, что и у метода класса. На практике, особенно для такого языка, как Perl, расточительно создавать полный набор геттеров и сеттеров. В большинстве случаев достаточно написать универсальный сеттер, либо объединить геттер и сеттер одного поля в одном методе: <source lang="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"; </source> === Наследование === Для реализации механизма наследования в Perl используется специальный массив <code>@ISA</code>, в который помещаются родительские классы слева направо от ближайшего к дальнему предку. Если интерпретатор встречает вызов метода, которого нет в данном классе, то он сначала пройдется по классам из <code>@ISA</code> в поисках метода. Если вам нужно вызвать метод родительского класса из дочернего класса, вы можете воспользоваться квалифицированным вызовом метода. Если вам нужен метод ближайшего предка, вы можете использовать имя псевдокласса <code>SUPER</code> (но только из методов потомка). <source lang="perl"> 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; </source> <source lang="bash"> -- 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 </source> В данном примере мы имеем два класса <code>Parent</code> и <code>Child</code>. Родительский класс объявляет два метода: метод <code>Parent::set()</code> нужен, чтобы устанавливать поля структуры класса; метод <code>Parent::show()</code> распечатывает все поля структуры класса. Дочерний класс наследует метод <code>Parent::set()</code>, поэтому мы можем вызывать его без квалификатора типа, и переопределяет метод <code>Parent::show()</code>. Также дочерний класс в своем конструкторе вводит поле <code>born</code>, которое по умолчанию инициализируется нулевым значением. Обратите внимание, как мы определяем методы дочернего класса: все они вводят небольшие изменения в алгоритм, но все равно вызывают методы родительского класса. На практике не всегда нужно поступать так, но конструкторы и деструкторы по логике вещей всегда должны обращаться к конструкторам и деструкторам предков, причем конструирование должно происходить сверху вниз (от дальнего предка к последнему потомку), а для деструкторов снизу вверх (от дальнего потомка к дальнему предку). В последнем операторе мы пытаемся вызывать несуществующий метод из объекта дочернего класса. Так как в родительском классе объявлен метод <code>AUTOLOAD</code>, то будет вызван именно он. ==== Множественное наследование ==== Язык Perl поддерживает множественное наследование за счет массива <code>@ISA</code>. В этом массиве вы можете разместить любое количество родительских классов, методы которых будут просматриваться, если реализации соответствующего метода нет в потомке. Ниже показано наследование, при котором класс <code>Child</code> объединяет в себе свойства двух родительских классов. <source lang="perl"> package Parent1; sub new { my $class = shift; bless {}, $class; } sub greet { return "Parent1::greet\n"; } package Parent2; sub new { my $class = shift; bless {}, $class; } sub talk { return "Parent2::talk\n"; } sub greet { return "Parent2::greet\n"; } package Child; @ISA = qw(Parent1 Parent2); sub new { my $class = shift; return bless {}, $class; } package main; my $child = Child->new; print $child->greet(); # Вызовется реализация Parent1, так как этот родитель в списке наследования раньше. print $child->talk(); # Вызовется реализация Parent2. print $child->Parent2::greet(); # Вызов реализации Parent2. </source> <pre> Parent1::greet Parent2::talk Parent2::greet </pre> Множественное наследование обычно следует избегать, но если всё-таки приходится его использовать, следует быть предельно внимательным и учитывать вероятность получения [[w:Ромбовидное наследование|ромбовидного наследования]], при котором есть вероятность унаследовать один и тот же метод у двух и более родителей. Для языка Perl это не является особой проблемой, так как родители проверяются всегда в одном порядке, но это может приводить к логической ошибке в программе и неправильному поведению объекта класса потомка. Если необходимо изменить порядок проверки родительских классов, следует использовать модуль [https://perldoc.perl.org/mro MRO]. Множественное наследование можно избежать, если использовать [[w:Агрегирование (программирование)|агрегирование]] вместо наследования. Также можно использовать интерфейс ролей класса <code>UNIVERSAL</code>, в котором определен метод <code>DOES()</code>. Переопределив этот метод в потомках, вы можете управлять вызовами в зависимости от того, какую роль берет на себя конкретная реализация. === Использование таблицы символов для генерации методов на ходу === Некоторые стандартные методы, такие как геттеры и сеттеры, могут быть сгенерированы по контексту самой структуры класса. Для этого мы можем пройтись по полям структуры класса и сгенерировать из имен полей стандартные методы устанавливающие и возвращающие значения. Внимательно изучите следующий пример. <source lang="perl"> 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"; </source> <source lang=""> Larry Wall Garry Wall </source> В примере выше мы генерируем как будто бы пустой класс. На самом деле он генерирует свои методы на ходу, а именно при вызове конструктора. Для этого он для каждого поля хеша, передаваемого в конструктор, генерирует анонимную функцию, к которой можно обращаться по ссылке. Для геттеров имя ссылки будет <code>get_<имя-поля></code>, а для сеттеров — <code>set_<имя-поля></code>. Этот пример демонстрирует, что в принципе в Perl можно создавать очень сложные абстрактные классы, но вероятнее всего вам не захочется этим заниматься. == Шаблон модуля, несущего в себе класс == <source lang="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__ Документация </source> == Пакет UNIVERSAL == Все классы в <code>@ISA</code> наследуют пакет с именем <code>UNIVERSAL</code>, который предоставляет несколько методов, реализующих рефлексию классов в Perl. Его можно сравнить с классом <code>Object</code> в языке Java, но <code>UNIVERSAL</code> устроен намного проще. Пакет <code>UNIVERSAL</code> объявляет всего 4 метода, которыми модули могут пользоваться для исследования возможностей текущего программного окружения. === Метод VERSION === Возвращает значение переменной <code>$VERSION</code> пакета (модуля). Переменная <code>$VERSION</code> может быть объявлена непосредственно в пакете, но рекомендуется инициализировать её в директиве <code>package</code>, так как это более наглядно. <source lang="perl"> 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"; </source> <pre> SomePackage version: 1.0 SomePackage version: 1.0 </pre> У метода есть необязательный аргумент, в котором вы можете передать ожидаемый номер версии. Если фактический номер версии оказывается меньше запрашиваемого, функция выбрасывает исключение. Предполагается, что более старшие версии не совместимы с младшими. <source lang="perl"> 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 $@; </source> <pre> SomePackage version 2 required--this is only version 1.0 at .\universal.pl line 18. </pre> === Метод DOES === Проверяет, есть ли в цепочке наследования текущего класса класс с именем, передаваемом в аргументе. Если есть, то возвращает ИСТИНУ, иначе ЛОЖЬ. <source lang="perl"> 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'); </source> <pre> The Child inherits the Parent The Child does not inherit the AnotherClass The Child inherits the Parent </pre> === Метод can === Проверяет, существует ли метод с указанным именем в цепочке наследования или нет. Если метод существует, то метод возвращает ссылку на него, иначе возвращается ЛОЖЬ. <source lang="perl"> 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); </source> <pre> The Parent has 'parentMethod' The Child has 'parentMethod' Child method </pre> === Метод isa === По умолчанию <code>isa</code> и <code>DOES</code> работают абсолютно одинаково, однако метод <code>isa</code> задумывался, чтобы проверить утверждение ''инстанцирована ли ссылка от переданного в аргументе класса ИЛИ этот класс есть в цепочке наследования''<ref>Сравните с операцией <code>instanceof</code> в языке Java.</ref>, а <code>DOES</code> призвана определить, ''может ли этот класс выполнять данный класс задач''. Некоторые CPAN модули переопределяют внутри себя <code>DOES</code>, поэтому он может возвращать отличные от <code>isa</code> ответы. Чтобы уловить суть, рассмотрим такой пример. <source lang="perl"> package Logger 1.0; # ... Реализация всего того, что должен уметь типичный класс, # умеющий логировать. sub write { my ($class, $msg) = @_; print STDOUT "$msg"; } # # ... # package Animal 1.0; # # ... # package Dog; use parent -norequire, qw ( Logger Animal ); sub new { my $class = shift; return bless {}, $class; } sub whoAmI { my ($class) = @_; return __PACKAGE__; } # # ... # package main; my $o = Dog->new(); if ($o->DOES('Logger')) { $o->write("This object can write log messages\n"); } if ($o->isa('Animal')) { print STDOUT $o->whoAmI . " is " . "Animal" . "\n"; } else { print STDOUT $o->whoAmI . " is not " . "Animal" . "\n"; } </source> <pre> This object can write log messages Dog is Animal </pre> В этом примере у нас есть класс <code>Dog</code> (''собака''), который наследует классы <code>Logger</code> и <code>Animal</code> (''животное''). С точки зрения бизнес-логики, ''собака является животным'', т.е. метод <code>isa()</code> должен подчеркивать отношение ООП ''являюсь''. С другой стороны, класс умеет пользоваться подсистемой логирования приложения и писать в общий журнал сообщения. Таким образом <code>DOES()</code> сообщает, что объект наделен ролью ''логера''. Вам может быть сейчас не понятно, почему мы должны разделять эти возможности, но представьте себе модуль логирования, который написан отдельно от вашего приложения, и не знает системы наследования вашего приложения. Обычно вы просто передаете сконструированные объекты этому модулю в виде ссылок, при этом самому модулю важно понять существует ли возможность вызова методов логирования подсистемы логирования, что и делается через <code>DOES()</code>. == Подведение итогов == Описанный выше подход к ООП не является единственным. Существуют модули CPAN, которые пытаются улучшить эту систему, обогащая описанные выше скудные конструкции (например, модуль Moose). Такие модули, как правило, используются в больших проектах. Однако, как бы там ни было, CPAN модули могут требовать загрузки множества зависимостей и могут замедлять скорость исполнения программы из-за своей внутренней реализации. В маленьких проектах достаточно встроенного в Perl ООП. == Perl 5.38: class или попытка сдвинуться с мёртвой точки == Очень долго тема ООП в Perl стояла на месте, но с версии 5.38 разработчики интерпретатора решили сделать новый шаг в этом направлении и ввели новое ключевое слово в язык — <code>class</code>. Дело в том, что у старого подхода есть много недостатков, что не позволительно для ООП парадигмы, в частности: * По сути у классов нет понятия ''поля класса'', а то что есть не обладает полноценной инкапсуляцией. Кроме того, никак не реализуется наследование полей в дочерние классы. Все эти моменты идут на откуп программисту, который, конечно, в этом разберётся, но вероятно напишет не очень понятный код. * Методы класса внешне не выглядят инкапсулировано: не запрещено разбросать их по пакетам, пользуясь уловками интерпретации, а также никакой приватности реализовать в них нельзя. Кроме того, нужно всегда помнить, что в первый аргумент любого метода передаётся ссылка на объект, что вынуждает писать одинаковую первую строку для всех методов, что очень утомляет (сравните с автоматической ссылкой <code>this</code> в C++). Реализация <code>class</code> на момент 2025 года ещё относительно сырая и ей стоит пользоваться осторожно, но можно потихоньку присматриваться. Если вы хотите использовать эту возможность, то обновите интерпретатор минимум до версии 5.40, потому что первые реализации имеют достаточно серьезные ошибки. === Объявление класса === Так как на момент версии 5.40 возможность является экспериментальной, её нужно включать так: <source lang="perl"> use feature 'class'; # Отключает предупреждения об экспериментальной возможности, которые засоряют вывод. no warnings 'experimental::class'; </source> В синтаксисе чувствуется, что разработчики вдохновлялись языком C++, так как синтаксис очень похож: <source lang="perl"> class <имя> <версия> [: <атрибуты-наследования>] [{ <блок-класса> }] # Также класс может быть объявлен, но не определен. class <имя> [<версия>]; </source> Внутренне слово <code>class</code> работает как <code>package</code>, но дополнительно оно генерирует конструктор по умолчанию для пакета. Номер версии для класса используется, когда используется наследование и у класса есть несколько реализаций, чтобы не сломать обратную совместимость. Номер версии может быть опущен, если атрибуты наследования не используются. Для <code>class</code> было введено слово <code>__CLASS__</code>, которое автоматически разворачивается в имя класса в пределах его определения. Им следует пользоваться для манипуляций с элементами класса, если они происходят до инстанцирования объекта. Вот примеры объявления класса <code>Person</code>: <source lang="perl"> class Person 1.000 { # ... } class WithoutVersion { # ... } # Объявление класса class Empty; </source> === Поля класса === Чтобы объявить поле в классе, используется ключевое слово <code>field</code>. Это ключевое слово инкапсулирует поле в классе и гарантирует, что каждый инстанцированный объект класса получит свой набор полей в памяти программы. Полный синтаксис поля такой: <source lang="perl"> class ClassName { field <переменная> [: <атрибуты>] [= <выражение-вычисляющее-инициализирующее-значение>]; } </source> Например, <source lang="perl"> class Person 1.000 { field $name = "Larry"; field $surname = "Wall"; field $born; } </source> Данный синтаксис позволяет присвоить значение полю до вызова конструктора, а также, когда значение для поля не передается через конструктор. Что-то похожее есть в языке Java, но здесь вы можете использовать полноценное Perl-выражение справа от присваивания. === Методы класса === Чтобы объявить метод, используется ключевое слово <code>method</code>. Методы уже становятся очень похожими на методы языка C++, в частности вы можете обращаться к полям класса не используя ссылку на объект. С помощью ключевого слова можно объявлять удобные сигнатуры: <source lang="perl"> class ClassName { method [<имя-метода>] [<сигнатура-метода>] { <блок-метода> } } </source> Сигнатуры в новой реализации поддерживают значения по умолчанию. Внутри методов вы можете обращаться к экземпляру объекта по ссылке <code>$self</code>. Ниже представлены примеры. <source lang="perl"> 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"; </source> <pre> Person: Name: Larry, Surname: Wall, Born: Person: Name: Larry, Surname: Wall, Born: 27.09.1954 { "name" : "Larry", "surname" : "Wall", "born" : "27.09.1954" } </pre> === Атрибуты === Атрибуты призваны для установки правил видимости и доступа к различным частям класса как внутри него самого, так и из классов-потомков. В документации говорится, что атрибуты будут: * у класса; * у полей класса; * у методов (но на момент 5.40 ни одного атрибута для методов ещё не реализовано). ==== Атрибуты класса ==== У класса на момент 5.40 поддерживаются следующие атрибуты: * <code>:isa</code> — атрибут устанавливает отношение между классами типа ''родитель-потомок''. В атрибуте вписывается имя класса родителя и опционально минимальная необходимая версия этого класса (если фактическая версия родителя меньше запрашиваемого, исполнение прерывается). Так как у полей всегда лексическая видимость, эта система умеет реализовывать только приватное наследование полей в терминах языка C++. Если класс ещё не был загружен в пространство текущего пакета, неявно вызывается процедура <code>require</code>.<source lang="perl"> 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) { # ... } </source> ==== Атрибуты полей ==== У полей на момент 5.42 поддерживаются следующие атрибуты: * <code>:param</code> — указывает на то, что начальное значение для этого поля берется из именованного параметра конструктора. По умолчанию, именованный параметр конструктора и имя поля совпадают, но в параметрах атрибута можно указать другое имя, если так удобно или того требует ситуация. Вы можете оставить выражение, которое присваивает значение по умолчанию, но если его нет, значение всегда должно присваиваться через конструктор.<source lang="perl"> 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 </source> * <code>:reader</code> — генерирует для поля геттер. По умолчанию имя геттера совпадает с именем поля, но в параметре атрибута можно указать другое имя.<source lang="perl"> 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"; </source> * <code>:writer</code> — генерирует для поля сеттер. На момент версии 5.42 сеттер можно сгенерировать только для скалярного поля, иначе будет сгенерирована ошибка времени компиляции. По умолчанию имя сеттера генерируется по шаблону <code>set_<имя-поля></code>, но в параметре атрибута можно указать другое имя. Все генерируемые автоматически сеттеры возвращают ссылку на объект, поэтому сеттеры можно вызывать по цепочке.<source lang="perl"> class ModernPerson { field $name :writer; field $surname :writer(surname); field $born :writer = "unknown"; method printAsString { print __CLASS__ . ":" . " Name: " . $name . ", Surname: " . $surname . ", Born: " . $born . "\n" ; } } my $o = ModernPerson->new; $o->set_name("Larry"); # Вызов по цепочке. $o->surname("Wall")->set_born("27.09.1954"); $o->printAsString; </source> === Жизненный цикл объекта класса === Так как <code>class</code> это по сути замаскированный <code>package</code>, то всё что было сказано ранее в классическом подходе Perl к ООП справедливо и здесь в отношении жизненного цикла. Правда есть одно отличие: для <code>class</code> был добавлен специальный именованный блок <code>ADJUST</code>, который семантически очень похож на <code>BEGIN</code>, но из него вам доступна ссылка на инстанцированный экземпляр класса, т.е. этот блок выполняется сразу за конструктором при конструировании каждого нового объекта. Вы можете указать сколько угодно таких блоков и они будут выполняться в порядке появления. Ниже показаны этапы жизненного цикла на конкретном примере. <source lang="perl"> 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; } </source> <pre> 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 </pre> Мы можем видеть, что при наследовании конструкторы и блоки <code>ADJUST</code> вызываются автоматически в порядке от родителя к потомку. Как и раньше, для деструкторов мы должны закладывать вызов деструктора родителя в деструкторе потомка . == Перегрузка операций классов == В этом разделе мы разберем одну из центральных функций ООП в Perl — ''перегрузка операций''. Многие программисты ругают Perl за очень сложный синтаксис ООП, но на самом деле Perl по большому счёту не нужна ООП парадигма в той форме, в которой она есть, например, в языке Java. Perl в первую очередь всегда решал задачи системного администрирования, где скорее важны минимализм и практичность, так как у системных администраторов время на решение входящих запросов очень ограничено. В Perl существует по меньшей мере два подхода перегружать операции: * '''Перегрузка связыванием'''. Данный тип перегрузки опирается на функцию <code>tie()</code>, которая привязывает объект-делегат к переменной определенного типа данных и переопределяет операции для этой переменной (привязывается к ней). Данный тип перегрузки концентрируется на этапах жизненного цикла объекта и перегружает через ''конструктор'', ''деструктор'', операции ''присваивания'' и ''копирования''. * '''Перегрузка операций класса'''. Реализуется через модуль <code>overload</code> и позволяет перегружать знаки операций для выражений, в которых используется объект некоторого класса. === Перегрузка связыванием === Идея этого подхода кроется в желании обобщить работу с хранилищами данных по отношению к типам данных языка Perl. В языке Perl можно любую структуру представить комбинацией стандартных типов языка (скаляр, массив и хеш-массив). С другой стороны, сценарии Perl обычно конечной целью ставят перед собой прочитать данные из некоторого источника и записать данные в некоторый источник. Обычно протокол работы с определенным типом хранилища данных всегда строго определен. Отсюда возникает желание одни и те же данные записывать в разные типы хранилищ одинаковым, с точки зрения интерфейса, способом. Здесь и появляется функция <code>tie()</code>, которая привязывает реализацию-делегат к экземпляру стандартного типа данных. При этом делегат внутри себя полностью управляет протоколом работы с хранилищем, а наружу для клиентского кода перегружает операции ''присваивание'' и ''извлечение'' через знак операции <code>=</code>. Данный подход впервые появился в Perl 5 и поддерживает привязывание для: * скаляров (<code>Tie::Scalar</code>), * массивов (<code>Tie::Array</code>), * хеш-массивов (<code>Tie::Hash</code>), * файловых дескрипторов (<code>Tie::Handle</code>). Основу интерфейса <code>tie()</code> составляют следующие функции: <source lang="perl"> # Строит экземпляр делегата и привязывает его к переменной. tie <переменная-к-которой-привязывается-делегат>, <класс-делегата>, <список-аргументов-для-конструктора-делегата> # Отвязывает делегата от переменной и удаляет его. untie <переменная-к-которой-привязывается-делегат> # Возвращает ссылку на экземпляр делегата. tied <переменная-к-которой-привязывается-делегат> </source> Состав интерфейсных методов для каждого типа данных отличается, так как каждый тип в чём-то специфичен, но в общем каждый тип представляет следующие методы: * <code>TIEHASH</code>, <code>TIEARRAY</code>, <code>TIEHANDLE</code> и <code>TIESCALAR</code> — конструктор делегата соответственно для хеш-массива, массива, дескриптора и скаляра. Сигнатура конструктора для всех типов одинаковая: в первом аргументе передается имя пакета делегата, а в последующих список аргументов для него. * <code>FETCH</code> — определен для всех типов, кроме дескриптора. Вызывается каждый раз, когда связанная переменная участвует в выражении как правосторонний операнд, т.е. значение из источника извлекается. * <code>STORE</code> — определен для всех типов, кроме дескриптора. Вызывается каждый раз, когда связанная переменная участвует в выражении как левосторонний операнд, т.е. значение в источник записывается. * <code>DESTROY</code> — деструктор делегата. Вам не обязательно переопределять все методы, предоставляемые интерфейсом, так как тривиальные реализации всегда есть в соответствующем пакете <code>Tie::</code>. ==== Связывание скаляров ==== Основы работы с tie-интерфейсом проще всего показать на скаляре, так как для скаляра определено самое малое количество методов: * <code>TIESCALAR</code> — конструктор делегата. * <code>FETCH</code> — метод, извлекающий данные из привязанного скаляра. * <code>STORE</code> — метод, записывающий данные в привязанный скаляр. * <code>DESTROY</code> — деструктор делегата. Ниже показан небольшой пример делегирующего класса. <source lang="perl"> 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 </source> <pre> Tie TieScalarExample: 1, 2, 3 To fetch a record Storing a value: 15 Before untie() </pre> В комментариях к примеру показано, в какие моменты вызываются интерфейсные методы. В этом примере мы привязываем делегата <code>TieScalarExample</code> к скаляру <code>$aScalar</code>, после чего любая операция <code>=</code> будет переводиться на методы привязанного делегата до момента вызова <code>untie()</code> в зависимости от того, в левом или правом операнде операции участвует связанный скаляр. Перед отвязыванием делегата вызывается деструктор делегата. В предыдущем примере делегат по сути ничего не делает, но на практике часто за делегатом скаляра стоит реальное хранилище данных, а сам делегат выступает его драйвером. Ниже представлен конкретный пример, в котором делегат логирует все значения, которые проходят через скаляр в любом направлении. <source lang="perl"> #!/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; </source> Если вы откроете файл лога, то увидите следующие строки: <pre> 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 </pre> а на консоли <source lang="bash"> $ ./tiescalar.pl Printing: Apple Printing: Pear Printing: Grapes Printing: Banana </source> Вы можете увидеть странную запись в логах <pre> package main, ./tiescalar.pl line 54 FETCHED none </pre> Она говорит о том, что списковая операция <code>print</code> внутренне тоже обращается к скаляру. ==== Связывание массивов ==== Интерфейс для массивов уже заметно богаче: * <code>TIEARRAY</code> и <code>DESTROY</code> — конструктор и деструктор делегата. * <code>STORE</code> — вызывается, когда по конкретному индексу записывается значение в массив. * <code>FETCH</code> — вызывается, когда по конкретному индексу извлекается значение из массива. * <code>DELETE</code> — вызывается, когда удаляется элемент по индексу. * <code>CLEAR</code> — вызывается для операции <code>delete</code> для всего массива. * <code>PUSH</code>, <code>POP</code>, <code>SHIFT</code>, <code>UNSHIFT</code>, <code>SPLICE</code> — переопределяет стандартные одноименные операции над массивом. * <code>EXISTS</code> — вызывается, когда проверяется существование значение по индексу. * <code>EXTEND</code> — предполагается, что метод расширяет занимаемую память под массив на указанное число позиций. * <code>FETCHSIZE</code> — предполагается, что возвращает реальное число элементов в массиве. * <code>STORESIZE</code> — предполагается, что подравнивает размер массива под указанное значение. Если часть элементов выходит за пределы, они должны быть удалены. Если новый размер больше текущего, то новые значения должны быть проинициализированы <code>undef</code>. Ниже показано, в какие моменты вызываются методы интерфейса. <source lang="perl"> 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 </source> ==== Связывание хеш-массивов ==== Для хеш-массивов определены следующие методы: * <code>TIEHASH</code> и <code>DESTOROY</code> — конструктор и деструктор делегата. * <code>STORE</code> — сохраняет значение в хеш-массив по ключу. * <code>FETCH</code> — извлекает значение из хеш-массива по ключу. * <code>FIRSTKEY</code> — возвращает самый первый ключ в массиве. * <code>NEXTKEY</code> — возвращает следующий ключ. Используется для перебора элементов хеш-массивов через <code>each()</code>. * <code>EXISTS</code> — проверяет существование ключа. * <code>DELETE</code> — удаляет значение из хеш-массива по ключу. * <code>CLEAR</code> — удаляет хеш-массив целиком. * <code>SCALAR</code> — вызывается, когда к хеш-массиву происходит обращение в скалярном контексте. Ниже показано, в какие моменты вызываются методы интерфейса. <source lang="perl"> 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 </source> Следует дать пояснения по методам <code>FIRSTKEY</code> и <code>NEXTKEY</code>. Эти методы реализуют подобие итератора. Метод <code>FIRSTKEY</code> вызывается всегда, когда хеш-массив передается функции <code>keys()</code> или <code>each()</code>. Этот метод должен сбросить состояние итератора, если оно не начальное, и вернуть начало хеш-массива. Метод <code>NEXTKEY</code> возвращает последующий элемент, вычисленный от последнего, переданного аргументом <code>$lastkey</code>. Если возвращать нечего, нужно вернуть значение <code>undef</code>, которое говорит, что элементы закончились. ==== Связывание дескрипторов ==== Связывание для файловых дескрипторов в Perl очень полезный функционал в *nix системах, так как в них через файловые дескрипторы можно получить доступ к любой части системы. Например, можно подключаться к блочным или символьным устройствам через специальные файлы и работать с ними через операции файловых дескрипторов из кода Perl. Так как через дескрипторы ходят символьные потоки, в них нет методов <code>STORE</code> и <code>FETCH</code>, а используются методы <code>WRITE</code> и <code>READ</code>. Интерфейс поддерживает следующие методы: * <code>TIEHANDLE</code> и <code>DESTROY</code> — конструктор и деструктор делегата. * <code>WRITE</code> — записывает указанное число байтов с некоторого начального адреса и некоторого смещения от его начала. * <code>READ</code> — читает указанное число байтов с некоторого начального адреса и некоторого смещения от его начала. * <code>READLINE</code> — читает несколько байтов до некоторого разделителя. * <code>GETC</code> — читает очередной символ в символьном потоке. * <code>PRINT</code> — печатает значения в переданном списке. * <code>PRINTF</code> — печатает значения в списке с использованием форматной строки. * <code>OPEN</code> — открывает или переоткрывает файловый дескриптор. * <code>CLOSE</code> — закрывает файловый дескриптор. * <code>BINMODE</code> — указывает на то, что читаемый поток представляет собой поток байтов, а не отдельных символов (другими словами, включает бинарный режим чтения). * <code>EOF</code> — возвращает истину, если поток закончился. * <code>TELL</code> — возвращает текущую позицию в файле. * <code>SEEK</code> — передвигает позицию в файле относительно некоторой опорной точки. Ниже показано, в какие моменты вызываются методы интерфейса. <source lang="perl"> use strict; package TieHandleExample; sub TIEHANDLE { my ($class, @argv) = @_; return bless {}, $class; } sub WRITE { my ($self, $address, $length, $offset) = @_; } sub READ { my ($self, $address, $length, $offset) = @_; } 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, $offset, $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 $offset, 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 </source> Для этого типа связывания мы приведем два конкретных примера использования. Наверное вы знаете Unix утилиту [[w:tee|tee]]. Основной задачей этой утилиты является копирование и перенаправление основного потока. Например, этим пользуются, когда вывод программы нужно видеть на консоли и одновременно с этим логировать его в файл (возможно в несколько файлов). В Perl можно реализовать возможности <code>tee</code> следующим образом. <source lang="perl"> #!/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; </source> В примере выше мы открываем 5 дескрипторов: 4 связывается с файлами (<code>tmp1</code>, <code>tmp2</code>, <code>tmp3</code>, <code>tmp4</code>), причем <code>tmp3</code> открывается на дозапись, и один связывается со стандартным потоком вывода (<code>-</code>). Все эти дескрипторы представляет один общий, который мы назвали <code>BROADCAST</code> и к которому мы привязали свою реализацию метода <code>PRINT</code>. Она не очень сложная и занимается тем, что для каждого открытого ранее дескриптора вызывает функцию <code>print</code> и передает список для печати. После запуска программы, вы можете видеть, как создаются 4 файла, и один и тот же вывод транслируется в каждый из них и на консоль. Следующий пример показывает, как приложение может переключать источник ввода. Если приложению не передано ни одного аргумента командной оболочки, то приложение читает стандартный поток ввода. <source lang="perl"> 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; </source> <source lang="bash"> # Аргументы переданы явно $ perl ./selecthandle.pl 1 2 3 1 2 3 # А теперь данные поставляются через STDIN. $ seq 1 3 | perl ./selecthandle.pl 1 2 3 </source> === Перегрузка операций через модуль overload === Второй подход перегрузки операций заключается в использовании директивного модуля <code>overload</code>. Данный модуль позволяет перегрузить часть стандартных операций в отношении произвольного класса. Данный модуль разрешает перегружать только те операции, которые перечислены в хеш-массиве <code>%overload::ops</code>. На момент версии 5.40 состав перегружаемых операций таков: <source lang="bash"> $ 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' }; </source> Обратите внимание, что операции в этом массиве отсортированы по категориям. Большинство операций в этом списке однозначно соответствуют их знакам, но есть и исключения. * Операции <code>not</code> нет в списке перегружаемых операций, однако, если вы перегружаете <code>!</code>, то при вызове <code>not</code> будет использоваться реализация для <code>!</code>. * Точно так же операция унарного минуса <code>-</code> будет использовать реализацию для <code>neg</code>. * При перегрузке инкремента <code>++</code> и декремента <code>--</code>, Perl не будет делать отдельные реализации для префиксной и постфиксной формы (как, например, это делается в языке C++), однако точка вызова их в выражении будет поставлена так, чтобы отрабатывала префиксная или постфиксная форма. Эти операции находятся в категории <code>mutators</code>, что говорит о том, что они работают не с копией значения, а ссылкой на него. * Операцию присваивания <code>=</code> нельзя перегрузить с помощью этого модуля, так как она зарезервирована для конструктора копирования класса. Единственный способ её перегрузить — это использовать интерфейс <code>tie()</code>. Тем не менее, вы можете перегружать прочие разновидности присваивания (категория <code>assign</code>), так как они работают с ссылкой. * Операции<pre>+ - * / % ** << >> x . & | ^ &. |. ^.</pre>не должны изменять свои операнды, так как они передаются по ссылке и это было бы некорректным поведением. Другими словами, они должны конструировать новое значение в качестве результата. * Все операции тестирования файла (<code>-f</code>, <code>-x</code> и др.) перегружаются одной и той же операцией <code>-X</code>, и перегрузить их по-отдельности невозможно. Тем не менее, вы можете распознать какой тест передаётся через второй аргумент, несмотря на то, что операция унарная. Обычно, если вам требуется перегрузить операции для вашего класса, минимально рекомендуется перегружать следующие: <pre> + - * / % ** << >> x <=> cmp & | ^ ~ &. |. ^. ~. atan2 cos sin exp log sqrt int "" 0+ bool ~~ </pre> ==== Основы перегрузки ==== * Перегрузка операции происходит в момент вызова модуля <code>overload</code>. Вы должны указать знак операции из таблицы <code>%overload::ops</code> в качестве ключа, а затем присвоить ссылку на процедуру любым доступным способом<source lang="perl"> use overload "-" => "minus", # Перегрузка с помощью символической ссылки. "*=" => \&muas, # Перегрузка с помощью жесткой ссылки. '""' => sub { ...; }; # Объявление анонимной процедуры на месте. </source> * Объявленные процедуры должны быть реализованы в ближайшем к директиве пакете. Обычно это пакет класса, которому требуется перегрузка операций. Допустимо указывать реализацию из другого пакета. Кроме того, если реализация наследуется, то к ней справедливы все правила наследования, описанные выше. Например, если есть классы <code>A -> B -> C</code>, где стрелка указывает на родителя, и классы <code>B</code> и <code>С</code> перегружают одну и ту же операцию, <code>A</code> будет искать по списку <code>@ISA</code> ближайшую в цепочке наследования реализацию. * Все перегружающие процедуры объявляются одинаково<source lang="perl"> sub overloadImpl { my ($self, $other, $swap) = @_; ... return $result; } </source>Однако, интерпретация входящих аргументов и тип возвращаемого значения зависят от смысла операции (см. ниже). * Для некоторых операций, которые связаны по смыслу разными знаками, Perl может генерировать реализацию автоматически для той части, которая не была перегружена явно. Например, операции <code>0+</code><ref>Операция <code>0+</code> называется «Венерой» из-за внешней схожести с [[w:Зеркало Венеры|зеркалом Венеры]]. Данная операция пытается преобразовать строку в число в скалярном контексте.</ref>, <code>""</code>, и <code>bool</code> могут предоставить свою реализацию операции <code>!</code>, если та не была перегружена, а хотя бы одна из них была перегружена. * Ключ <code>nomethod</code> может использоваться для объявления универсальной перегрузки, которая будет вызываться для любой не перегруженной индивидуально операции. * Установка флага <code>fallback</code> даёт модулю подсказку, как он должен поступать с вызовом, если не удаётся найти для операции перегруженную реализацию. ==== Реализующая процедура ==== Перегрузка бинарных и унарных операций происходит по одному прототипу входящих параметров<source lang="perl">my ($self, $other, $swap, $nomethod, $binary) = @_;</source>Здесь * <code>$self</code> — ссылка на объект класса, для которого была перегружена операция; * <code>$other</code> — второй операнд или параметр унарной операции; * <code>$swap</code> — флаг, который говорит о том, находится ли ссылка на объект слева (ЛОЖЬ) от знака операции или справа (ИСТИНА). Реализующая процедура обычно возвращает ссылку на результат. Здесь многое зависит от того, какой смысл закладывается в перегрузку. Флаг <code>$swap</code> многогранный. Он используется и в бинарных, и унарных операциях, но ЛОЖЬ в них представляется по-разному. В бинарных операциях ЛОЖЬ представляется пустой строкой <code><nowiki>''</nowiki></code>, а в унарных операциях и операциях класса <code>assign</code> используется <code>undef</code>. Существуют также 4-й и 5-й параметры, которые инициализируются в особых ситуациях. Если перегружена специальная операция <code>nomethod</code>, которая по смыслу похожа на <code>AUTOLOAD</code> (но для операций), 4-й параметр всегда инициализируется знаком операции. Для побитовых операций (<code>&</code>, <code>|</code>, <code>^</code> и <code>~</code>) инициализируется 5-й параметр, чтобы, возможно, подсказать реализации о необходимости работать с операндами как с числами. ==== Автогенерируемые операции ==== Если вызывается операция для некоторого класса и при этом для неё нет перегруженной реализации, модуль <code>overload</code> руководствуется встроенным в него флагом <code>fallback</code>, который по умолчанию имеет значение ИСТИНА. Алгоритм поиска реализации операции таков: # Если операция перегружена в объекте вызываемого класса, то использовать реализацию в этом классе, иначе идём дальше. # Если <code>fallback</code> ИСТИНА или <code>undef</code>, попытаться сгенерировать автоматическую реализацию. # Если операция не относится к категории <code>assign</code>, то повторить шаг 1 для второго операнда. # Повторить шаг 2 для второго операнда. # Если для первого операнда все сводится к <code>nomethod</code> реализации, то использовать её. # Если для второго операнда все сводится к <code>nomethod</code> реализации, то использовать её. # Если <code>fallback</code> ИСТИНА и не нашлось ни одной реализации, то попытаться обработать операнды в соответствии с типом операции. Например, если операция арифметическая, то попытаться привести операнды к числам; если строковая — строкам и т.д. # Если ничего из этого не может корректно отработать, то бросить исключение. В этом алгоритме для унарных операции опускаются шаги, связанные со вторым операндом. Хотя правила выше кажутся прозрачными, существует очень много подводных камней в ситуациях, когда не удаётся найти реализацию, поэтому стоит перегружать операции всегда с большой внимательностью. Для некоторых операций могут использоваться близкие по смыслу операции, которые могут предоставить свою реализацию, если целевая не была определена. Вы можете ознакомиться с ними в официальной документации [https://perldoc.perl.org/overload#Magic-Autogeneration Magic-Autogeneration]. ==== Пример перегрузки ==== На практике перегрузка зачастую используется, чтобы выразить идею программы более наглядно — добавить синтаксического сахара. Пример ниже демонстрирует модуль, который, используя операцию <code><<</code>, представляет поток строк, который, возможно, используется шаблонизатором<ref>Программой, которая, используя некоторый шаблон, генерирует конечный текстовый документ.</ref>. В данный поток можно встраивать условия, чтобы игнорировать некоторые части шаблона в зависимости от текущих условий. Внимательно изучите следующий код. <source lang="perl"> 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; </source> Данный модуль представляет класс <code>StringStream</code>, который имеет два атрибута: <code>stream</code> и <code>if_stack</code>. Атрибут <code>stream</code> представляет собой ссылку на строковый массив, в который набираются части результирующей строки. Чтобы в потоке строк иметь возможность игнорировать некоторые части, класс реализует собственные операции, которые могут представлять условия. Они реализуются за счет встроенных классов, которые не видны клиентскому коду, но которые может интерпретировать <code>StringStream</code>. Эти классы имитируют конструкцию <code>If...ElseIf...Else</code>, но, чтобы отмечать границу конструкции, используется терминирующая операция <code>Endl</code>. Создать экземпляры встроенных классов можно только с помощью функций-оболочек, которые имеют имена <code>If</code>, <code>ElseIf</code>, <code>Else</code> и <code>Endl</code>, причем в <code>If</code> и <code>ElseIf</code> можно передавать выражения, которые выполняют роль условных конструкций. Весь секрет этого класса кроется в том, что он и его скрытые классы перегружают знак операции <code><<</code>, который отсылает к одной единственной процедуре <code>__stream_element</code>. Данная процедура анализирует второй операнд и, используя массив <code>if_stack</code>, отключает части потока строк, в зависимости от результатов условных выражений. Данная система не проверяет некоторые некорректные ситуации и ожидает, что ни один <code>ElseIf</code> не будет встречаться раньше чем <code>If</code>; <code>Else</code> не будет стоять раньше <code>If</code> и <code>ElseIf</code>, а каждая открытое условие <code>If</code> будет терминироваться <code>Endl</code>. Кроме операции <code><<</code> класс <code>StringStream</code> также перегружает операцию <code>q{""}</code>, которая используется в скалярном контексте, чтобы сформировать из набранной строки окончательную. Ниже показан пример использования. <source lang="perl"> #!/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 ; </source> В данном примере анализируется входящий массив аргументов и, в зависимости от переданного числа аргументов, печать выводится по-разному: <source lang="perl"> # Предполагается, что файл модуля лежит в рабочем каталоге. $ 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 </source> Обратите внимание, что мы могли бы конструировать строку без использования этого «сахара», но конечная конструкция изобиловала бы множеством операций конкатенации, ветвлений и циклов. Другими словами, мы концентрируемся на задаче сформировать строку по нашим правилам простыми средствами. == Объектно-ориентированный подход в системе ввода-вывода == С появлением в Perl 5 модулей, в систему ввода-вывода также был добавлен ООП подход в виде интерфейсного класса [https://perldoc.perl.org/IO::Handle IO::Handle] и его классов-потомков, таких как <code>IO::File</code>, <code>IO::Pipe</code>, <code>IO::Socket</code> и других. Это позволяет облегчить написание программ, требующих работы с операциями [[../Ввод и вывод|ввода и вывода]], рассмотренные нами ранее. В данном разделе мы рассмотрим этот интерфейс, чтобы продемонстрировать, как ООП подход может упростить и унифицировать написание кода, связанного с вводом-выводом по файловым дескрипторам. === Интерфейс IO::Handle === Интерфейс, реализуемый модулем <code>IO::Handle</code>, содержит универсальные методы, применяемые для всех объектов, которые в своей реализации открывают файловый дескриптор. Более специализированные классы, например <code>IO::File</code> (обычный файл), предоставляют дополнительные методы, учитывающие нюансы работы с данным типом файла, но так или иначе переопределяют методы, вводимые классом <code>IO::Handle</code>. Вместе эти классы сглаживают некоторые недостатки встроенных дескрипторов файлов Perl и упрощают понимание и сопровождение программ. Объект <code>IO::Handle</code> может быть построен одним из двух конструкторов: * '''Конструктор без аргументов''' (<code>new()</code>) позволяет построить пустой объект класса <code>IO::Handle</code>. Далее необходимо сделать библиотечный вызов <code>fdopen()</code> через одноименный метод, чтобы открыть файловый дескриптор с определенным режимом. Так как этот вызов требует знания флагов и атрибутов, его вызов не очень удобен на практике. Конструкторы в классах, наследующих этот интерфейс, скрывают этот вызов в своих реализациях. * '''Конструктор с аргументами''' (<code>new_from_fd ()</code>) позволяет построить объект и привязать к нему уже открытый дескриптор. Главным образом используется, когда нет нужной реализации интерфейса, но требуется использовать методы <code>IO::Handle</code>. Методы <code>IO::Handle</code> в основном копируют одноименные функции ввода-вывода: <source lang="perl"> $io->close # Закрыть дескриптор. $io->eof # Возвращает признак конца потока EOF. $io->fcntl( FUNCTION, SCALAR ) # Управляет флагами файлового дескриптора. $io->fileno # Возвращает номер файлового дескриптора. $io->format_write( [FORMAT_NAME] ) # Аналог функции write(), т.е. запись по формату. $io->getc # Прочитать очередной символ. $io->ioctl( FUNCTION, SCALAR ) # Делает системный вызов ioctl() для управления устройством ввода-вывода. $io->read ( BUF, LEN, [OFFSET] ) # Буферизированное чтение. $io->write ( BUF, LEN [, OFFSET ] ) # Буферизированная запись. $io->print ( ARGS ) # Буферизированная запись. $io->printf ( FMT, [ARGS] ) # Буферизированная запись по форматной строке. $io->say ( ARGS ) # Буферизированная запись с переносом строки. $io->stat # Реализация функции stat(). $io->sysread ( BUF, LEN, [OFFSET] ) # Не буферизированное чтение $io->syswrite ( BUF, [LEN, [OFFSET]] ) # Не буферизированная запись. $io->truncate ( LEN ) # Смещает указатель записи в начало, что аналогично удалению данных. $io->opened # Возвращает ИСТИНУ, если дескриптор открыт. $io->getline # Возвращает строку до разделителя. $io->getlines # Возвращает строки до конца потока. $io->ungetc ( ORD ) # Возвращает из потока символ с указанным порядковым номером. $io->error # Возвращает ИСТИНУ, если возникала ошибка ввода-вывода. $io->clearerr # Сбрасывает флаг ошибки. Возвращает -1, если дескриптор находится в состоянии ошибки. $io->sync # Реализует синхронизацию данных в буфере и на носителе на уровне системы (не PerlIO). Может не поддерживаться на некоторых системах. $io->flush # Сброс буферов ввода-вывода, связанных с дескриптором. $io->printflush ( ARGS ) # Реализует сброс буферов только для текущей операции, а затем восстанавливает состояние флага сброса. $io->blocking ( [ BOOL ] ) # Если в аргументе передается ИСТИНА, делает операции ввода-вывода неблокирующими. </source> Также интерфейс позволяет управлять встроенными переменными языка Perl, управляющими вводом-выводом. Следующие методы управляют значениями для конкретного экземляра класса: <source lang="perl"> $io->autoflush ( [BOOL] ) # Управляет $| (управление буферизацией) $io->format_page_number( [NUM] ) # Управляет $% (номер страницы при выводе по формату) $io->format_lines_per_page( [NUM] ) # Управляет $= (число строк на страницу при выводе по формату) $io->format_lines_left( [NUM] ) # Управляет $- (число строк на текущей странице при выводе по формату) $io->format_name( [STR] ) # Управляет $~ (имя текущего формата) $io->format_top_name( [STR] ) # Управляет $^ (имя формата, который является верхним колонтитулом) $io->input_line_number( [NUM]) # Управляет $. (номер последней прочитанной строки последнего удачного чтения) </source> Следующие переменные управляются из этого интерфейса, но применяются ко всем открытым дескрипторам (т.е. методы являются статическими): <source lang="perl"> IO::Handle->format_line_break_characters( [STR] ) # $: (хранит символы переноса строк) IO::Handle->format_formfeed( [STR]) # $^L (управляющий символ перехода на новую страницу при выводе по формату) IO::Handle->output_field_separator( [STR] ) # $, (разделитель полей при печати функцией print) IO::Handle->output_record_separator( [STR] ) # $\ (символ, добавляемый в конец при печати функцией print) IO::Handle->input_record_separator( [STR] ) # $/ (символ разделителя записей при чтении из файлов) </source> Ниже показан небольшой пример работы с <code>IO::Handle</code>. <source lang="perl"> # Файл: handle.pl use strict; use warnings; use IO::Handle; my @strings; # Открываем дубликат дескриптора STDIN, чтобы работать с ним из экземпляра IO::Handle. my $io = IO::Handle->new_from_fd(fileno(STDIN),"r"); if ($io->opened) { push @strings, $_ while $_ = $io->getline; $io->close; print "Record number: " . @strings . "\n"; } # Следующая печать показывает, что закрылся только дубликат, а не STDIN. print "Object \$io " . ($io->opened ? "is opened" : "is closed") . "\n"; # При подключении модуля IO::Handle, все открытые дескрипторы неявно получают доступ к интерфейсным методам. print "STDIN " . (STDIN->opened ? "is opened" : "is closed") . "\n"; our $out; # Открываем дубликат дескриптора STDOUT, чтобы работать с ним из экземпляра IO::Handle. # Для примера, дубликат открывается методом fdopen(). { $out = IO::Handle->new(); if ($out->fdopen(fileno(STDOUT),"w")) { print "Printing 1:\n"; foreach my $line (@strings) { $out->write($line); } } # При обнулении ссылки, будет вызван деструктор, в котором close() вызывается неявно. undef $out; } # Мы могли не создавать дубликат STDOUT, а писать в него напрямую через интерфейс. print "Printing 2:\n"; foreach my $line (@strings) { STDOUT->write($line); } </source> <source lang="bash"> $ echo -e "aaa\nbbb\nccc" | perl handle.pl Record number: 3 Object $io is closed STDIN is opened Printing 1: aaa bbb ccc Printing 2: aaa bbb ccc </source> Приведенный выше пример плохо показывает, чем ООП парадигма в данном случае лучше процедурной, однако, мы всё же перечислим некоторые преимущества такого подхода: * Вы можете заметить, что вы не работаете с дескрипторами напрямую. По сути вы работаете с ссылками на объекты, которые инкапсулируют дескриптор внутри себя. Если бы программа была больше и в ней бы требовалось передавать дескриптор различным её частям, поддерживать код с передачей ссылки на объект намного проще, чем передачу дескриптора. * Жизненный цикл объекта отчасти перекладывается на систему очистки ссылок Perl: вам легче освобождать ресурсы системы, так как их освобождают автоматически вызываемые деструкторы. * В начале исходного файла вы всегда подключаете нужный вам модуль пространства <code>IO::</code>, что может давать подсказку читающему программу, что данный код работает с определенным типом файла. При работе с дескрипторами напрямую, невозможно дать такую подсказку без длинного комментария. В большой программе (в несколько тысяч строк), чтобы уловить намерения работы с дескриптором, вам придется внимательно изучить все вызовы, в которых участвует дескриптор. * При любых фатальных ошибках конкретная реализация интерфейса, как правило, выбрасывает исключение, которое перехватывать проще, чем проверять коды возврата. === Примеры === Ниже приведено несколько примеров применения потомков <code>IO::Handle</code>. Следующая программа открывает простой файл, переданный аргументом, и считает сколько в нём строк. В этом примере используется класс <code>IO::File</code> для работы с файлом в ООП стиле. <source lang="perl"> # Файл: line_counter.pl use strict; use warnings; use IO::File; my $file = shift; my $counter = 0; my $io = IO::File->new($file) or die "Cannot open $file: $!\n"; $counter++ while defined $io->getline; STDOUT->print("File '$file' contains $counter lines\n"); </source> <source lang="bash"> $ cat > file.txt <<EOF 1 2 3 4 5 6 EOF $ perl line_counter.pl file.txt File 'file.txt' contains 6 lines </source> Вернемся к примеру, рассмотренному в разделе [[../Ввод и вывод#Открытие канала через pipe()|Открытие канала через pipe()]]. При работе с каналом в процедурном стиле код получается довольно громоздким. Теперь посмотрите на то, как код будет выглядеть, если управлять каналом через объект класса <code>IO::Pipe</code>. <source lang="perl"> # Файл: pipe.pl use strict; use warnings; use IO::Pipe; # Строим объект одностороннего канала. my $pipe = IO::Pipe->new(); # Создаем со-процесс. my $pid = fork(); if (defined $pid) { if ($pid == 0) { # Пересоздаем объект так, чтобы на этом конце можно было только писать в канал. # Также отключаем буферизацию. $pipe->writer()->autoflush(); $pipe->print("Hello from child process\n"); $pipe->close(); exit 0; } else { # Пересоздаем объект так, чтобы на этом конце можно было только читать канал. $pipe->reader(); while (defined (my $line = $pipe->getline)) { STDOUT->print("Parent received: $line"); } $pipe->close(); waitpid $pid, 0; } } else { die "Could not fork: $!"; } </source> <source lang="bash"> $ perl pipe.pl Parent received: Hello from child process </source> Обратите внимание, что код стал намного чище. Наконец, продемонстрируем простейший Web-клиент, использующий модуль <code>IO::Socket</code>. Использование ООП подхода в этой задаче избавляет вас от изнурительного труда по настройке сетевого сокета через библиотеку <code>Socket</code>. <source lang="perl"> # Файл: pcurl.pl use strict; use warnings; # Импортируем IO::Socket и подключаем некоторые константы. use IO::Socket qw ( :DEFAULT :crlf ); # Изменяем стандартный разделитель строк на разделитель CRLFCRLF, так как им # заканчивается список заголовков. IO::Handle->input_record_separator( CRLF . CRLF ); # Пользователь передает URL для подключения. my $url = shift or die "pcurl.pl <URL>\n"; my $data; # Регулярными выражениями выделяем в URL хост и путь до ресурса. Этот клиент работает # только по протоколу HTTP. my ($host, $path) = $url =~ m!^http://([^/]+)(/[^\#]*)! or die "Invalid URL.\n"; # Открываем сетевой сокет и пытаемся подключиться к сетевой службе по порту 80. my $socket = IO::Socket::INET->new(PeerAddr => $host, PeerPort => 'http(80)') or die "Cannot connect: $!"; # Посылаем запрос на сервер по переданному пути. $socket->print("GET $path HTTP/1.0", CRLF, CRLF); # Отделяем заголовки от полезной нагрузки. my $header = <$socket>; $header =~ s/$CRLF/\n/g; # Печатаем заголовки. STDOUT->print($header); # Печатаем сообщение ответа. STDOUT->print($data) while ($socket->read($data, 1024) > 0); </source> Для примера, обратимся к ресурсу [http://httpbin.org/ip httpbin.org/ip], который является эхо-сервером, возвращающим ваш IP адрес, по которому вы к нему подключаетесь. <source lang="perl"> $ perl pcurl.pl 'http://httpbin.org/ip' HTTP/1.1 200 OK Date: Sat, 27 Sep 2025 08:43:20 GMT Content-Type: application/json Content-Length: 29 Connection: close Server: gunicorn/19.9.0 Access-Control-Allow-Origin: * Access-Control-Allow-Credentials: true { "origin": "5.206.96.5" } </source> Надеемся, что эти простейшие примеры дадут вам представления о некоторых преимуществах ООП подхода. == Примечания == {{примечания}} q4avab9ri1fc7nvt498vao58r8h75ac 270387 270386 2026-10-18T09:31:35Z ScriptMaster 15708 /* Метод isa */ 270387 wikitext text/x-wiki {{Навигация учебника}} В языке Perl не существовало специального синтаксиса для описания классов до версии 5.38. Для их реализации использовались существующие синтаксические конструкции. ''Класс в Perl'' представляет собой пакет, а функции в пакете представляют его ''методы''. Таблица символов класса представляет его содержимое — список полей и методов. ''Объект в Perl'' — это ссылка на экземпляр класса, которая строится с помощью специальной функции класса — ''конструктора''. Функция <code>ref()</code> возвращает для ссылки на объект не стандартный идентификатор типа <code>SCALAR</code>, <code>ARRAY</code> и др., а возвращает имя класса, которому принадлежит объект<ref>По внутренней терминологии такая ссылка называется благословлённой ({{lang-en|blessed}})</ref>. В общих чертах, конструктор любого класса для конструирования ссылки на объект должен вызывать функцию <source lang="perl"> bless <ссылка> [, <имя-класса>] </source> которая «''благословляет''» ({{lang-en|to bless}} — благословлять) ссылку на то, чтобы принадлежать к классу, указанному вторым аргументом. Если имя класса опущено, то используется имя текущего пакета. Именно ссылка, возвращаемая этим методом, должна возвращаться из конструктора. После того как объект построен, к нему можно обращаться через квалифицированное имя <code>$<имя-класса>::<ссылка></code>. Наследование в Perl еще сильнее отличается от того, что есть в других языках программирования. В Perl наследуются только методы. Наследование данных реализует сам программист. Наследование методов реализовано так: с каждым пакетом ассоциирован свой массив <code>@ISA</code>, в котором хранится список базовых классов пакета. Если внутри класса вызывается метод, которого нет в текущем классе, то интерпретатор в поисках метода просматривает по порядку методы каждого класса массива <code>@ISA</code>. Затем просматривается предопределенный класс <code>UNIVERSAL</code>. Если и после этого метод не был найден, то классы снова просматриваются в том же порядке в поисках процедуры <code>AUTOLOAD</code>. Если такая находится, то вызывается она вместо отсутствующего метода. В эту процедуру будут переданы все параметры, а в переменной <code>$AUTOLOAD</code> будет хранится имя вызываемого метода. == Объявление класса == === Конструктор === Конструктор класса является простой функцией пакета. Она может иметь любое имя, но на практике обычно используют идентификатор <code>new</code>, как устоявшееся имя для любого конструктора. Самый простой конструктор имеет следующий вид: <source lang="perl"> package MyClass; sub new { my $class = shift; # Передаем конструктору имя класса my $self = {}; # Конструируем ссылку bless $self, $class; # Конструируем объект return $self; # Возвращаем ссылку } # --------------------------------------------- package main; # Конструируем объект $object = MyClass::new("MyClass"); </source> Для примера мы объявляем класс и конструируем его экземпляр в одном исходном файле. Здесь мы это делаем только для демонстрации: на практике классы следует объявлять в отдельных исходных файлах и подключать их через директиву <code>use()</code>. Имя ссылки <code>$self</code> является устоявшимся, и мы настоятельно рекомендуем использовать ее в своих проектах. Данный пример демонстрирует пустой бесполезный класс, в котором нет полей, так как мы конструируем объект из ссылки на пустой хеш. На практике обычно в конструктор передается массив или другой хеш, которым инициализируется ссылка <code>$self</code>. В общем случае не обязательно использовать именно хеш, но его преимущество в том, что мы можем использовать произвольные ключи. Также мы можем передавать массив значений, которыми затем мы можем инициализировать анонимный хеш. Другими словами, подходы здесь могут быть самые разные. На практике конструктор класса обычно имеет следующий вид: <source lang="perl"> sub new { # Предполагается, что $init это ссылка на структуру с инициирующими данными my ( $class, $init ) = @_; $class = ref( $class ) || $class; # Чтобы иметь возможность взять имя по ссылке. # Примечание: если имя класса не будет передано, будет взято имя ближайшего пространства имен. my $self = {}; bless $self, $class; # ... Код инициализирующий поля в ссылке $self через $init ... # ... return $self; } </source> === Деструктор === Когда ссылка на объект выходит из зоны видимости, она удаляется по нулевому счетчику ссылок. Программист может контролировать действия, которые исполнятся перед очисткой ссылки, через ''деструктор'' объекта. Деструктор объекта нужен, чтобы корректно завершить жизненный цикл объекта, например, закрыть открытые объектом файловые дескрипторы. Деструктор всегда вызывается автоматически. Деструктор всегда должен быть объявлен внутри класса и всегда должен иметь имя <code>DESTROY</code>. Также деструктор должен принимать аргумент в виде ссылки на удаляемый объект. Деструктор является необязательным методом объекта, так как ссылка на удаляемый объект в любом случае будет очищаться правильно. Данный метод позволяет вам лучше контролировать этот процесс. Деструктор не вызывает автоматически другие деструкторы, другими словами, если ваш класс наследует другой, деструктор базового класса нужно вызвать явно в деструкторе дочернего. Ниже приведен простой пример деструктора. <source lang="perl"> 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 удаляется перед завершением программы. </source> Если вызвать программу, можно убедиться, что деструктор был вызван для каждого из двух объектов: <source lang=""> Call destructor to delete an instance of MyClass class Call destructor to delete an instance of MyClass class </source> === Другие методы === Методы в Perl могут вызываться от имени конкретного объекта или от имени всего класса. В последнем случае такие методы называются ''статическими''. Статическому методу в первом аргументе всегда передается имя класса, а не статическому — ссылка на объект. Типичным примером статического метода является конструктор (именно поэтому мы ожидаем в первом аргументе имя класса). В Perl методы выполняются в пространстве имен того пакета, в котором они были определены, а не в том, в котором они вызываются. Именно поэтому многие статические методы игнорируют свой первый аргумент. Не статические методы выполняют самую разную работу. Обычно эти действия направлены на инкапсулированные в объекте данные. В Perl полностью инкапсулировать данные невозможно, так как вы можете при желании исправлять их прямо через ссылку на объект (если конечно знаете как он устроен). На практике всегда следует изменять инкапсулированные данные через методы класса, игнорируя то, что сам объект является простой ссылкой, так как в этом и есть ООП подход. <source lang="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 </source> Результат работы программы <source lang="bash"> -- 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 </source> Методы класса можно вызывать двумя способами. Первый способ имеет вид <source lang="perl"> <имя-метода> <имя-класса-или-объект>, <параметры>; 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'}; </source> <source lang="bash"> -- 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 </source> Данная форма представляет собой вызов функции, вложенный в другой вызов. Второй формой мы пользовались в самом первом примере этого раздела: <source lang="perl"> <класс-или-объект>-><метод>(<параметры>) $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'); </source> <source lang="bash"> -- 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 </source> Вторая форма требует обязательного заключения аргументов в скобки. В большинстве случаев вторая форма предпочтительнее в смысле читаемости текста программы, так как оператор разыменовывания наглядно отделяет части выражения. При использовании первой формы могут возникнуть трудноуловимые ошибки, особенно когда действует область видимости, в которой существует функция с тем же именем, что и у метода класса. На практике, особенно для такого языка, как Perl, расточительно создавать полный набор геттеров и сеттеров. В большинстве случаев достаточно написать универсальный сеттер, либо объединить геттер и сеттер одного поля в одном методе: <source lang="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"; </source> === Наследование === Для реализации механизма наследования в Perl используется специальный массив <code>@ISA</code>, в который помещаются родительские классы слева направо от ближайшего к дальнему предку. Если интерпретатор встречает вызов метода, которого нет в данном классе, то он сначала пройдется по классам из <code>@ISA</code> в поисках метода. Если вам нужно вызвать метод родительского класса из дочернего класса, вы можете воспользоваться квалифицированным вызовом метода. Если вам нужен метод ближайшего предка, вы можете использовать имя псевдокласса <code>SUPER</code> (но только из методов потомка). <source lang="perl"> 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; </source> <source lang="bash"> -- 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 </source> В данном примере мы имеем два класса <code>Parent</code> и <code>Child</code>. Родительский класс объявляет два метода: метод <code>Parent::set()</code> нужен, чтобы устанавливать поля структуры класса; метод <code>Parent::show()</code> распечатывает все поля структуры класса. Дочерний класс наследует метод <code>Parent::set()</code>, поэтому мы можем вызывать его без квалификатора типа, и переопределяет метод <code>Parent::show()</code>. Также дочерний класс в своем конструкторе вводит поле <code>born</code>, которое по умолчанию инициализируется нулевым значением. Обратите внимание, как мы определяем методы дочернего класса: все они вводят небольшие изменения в алгоритм, но все равно вызывают методы родительского класса. На практике не всегда нужно поступать так, но конструкторы и деструкторы по логике вещей всегда должны обращаться к конструкторам и деструкторам предков, причем конструирование должно происходить сверху вниз (от дальнего предка к последнему потомку), а для деструкторов снизу вверх (от дальнего потомка к дальнему предку). В последнем операторе мы пытаемся вызывать несуществующий метод из объекта дочернего класса. Так как в родительском классе объявлен метод <code>AUTOLOAD</code>, то будет вызван именно он. ==== Множественное наследование ==== Язык Perl поддерживает множественное наследование за счет массива <code>@ISA</code>. В этом массиве вы можете разместить любое количество родительских классов, методы которых будут просматриваться, если реализации соответствующего метода нет в потомке. Ниже показано наследование, при котором класс <code>Child</code> объединяет в себе свойства двух родительских классов. <source lang="perl"> package Parent1; sub new { my $class = shift; bless {}, $class; } sub greet { return "Parent1::greet\n"; } package Parent2; sub new { my $class = shift; bless {}, $class; } sub talk { return "Parent2::talk\n"; } sub greet { return "Parent2::greet\n"; } package Child; @ISA = qw(Parent1 Parent2); sub new { my $class = shift; return bless {}, $class; } package main; my $child = Child->new; print $child->greet(); # Вызовется реализация Parent1, так как этот родитель в списке наследования раньше. print $child->talk(); # Вызовется реализация Parent2. print $child->Parent2::greet(); # Вызов реализации Parent2. </source> <pre> Parent1::greet Parent2::talk Parent2::greet </pre> Множественное наследование обычно следует избегать, но если всё-таки приходится его использовать, следует быть предельно внимательным и учитывать вероятность получения [[w:Ромбовидное наследование|ромбовидного наследования]], при котором есть вероятность унаследовать один и тот же метод у двух и более родителей. Для языка Perl это не является особой проблемой, так как родители проверяются всегда в одном порядке, но это может приводить к логической ошибке в программе и неправильному поведению объекта класса потомка. Если необходимо изменить порядок проверки родительских классов, следует использовать модуль [https://perldoc.perl.org/mro MRO]. Множественное наследование можно избежать, если использовать [[w:Агрегирование (программирование)|агрегирование]] вместо наследования. Также можно использовать интерфейс ролей класса <code>UNIVERSAL</code>, в котором определен метод <code>DOES()</code>. Переопределив этот метод в потомках, вы можете управлять вызовами в зависимости от того, какую роль берет на себя конкретная реализация. === Использование таблицы символов для генерации методов на ходу === Некоторые стандартные методы, такие как геттеры и сеттеры, могут быть сгенерированы по контексту самой структуры класса. Для этого мы можем пройтись по полям структуры класса и сгенерировать из имен полей стандартные методы устанавливающие и возвращающие значения. Внимательно изучите следующий пример. <source lang="perl"> 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"; </source> <source lang=""> Larry Wall Garry Wall </source> В примере выше мы генерируем как будто бы пустой класс. На самом деле он генерирует свои методы на ходу, а именно при вызове конструктора. Для этого он для каждого поля хеша, передаваемого в конструктор, генерирует анонимную функцию, к которой можно обращаться по ссылке. Для геттеров имя ссылки будет <code>get_<имя-поля></code>, а для сеттеров — <code>set_<имя-поля></code>. Этот пример демонстрирует, что в принципе в Perl можно создавать очень сложные абстрактные классы, но вероятнее всего вам не захочется этим заниматься. == Шаблон модуля, несущего в себе класс == <source lang="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__ Документация </source> == Пакет UNIVERSAL == Все классы в <code>@ISA</code> наследуют пакет с именем <code>UNIVERSAL</code>, который предоставляет несколько методов, реализующих рефлексию классов в Perl. Его можно сравнить с классом <code>Object</code> в языке Java, но <code>UNIVERSAL</code> устроен намного проще. Пакет <code>UNIVERSAL</code> объявляет всего 4 метода, которыми модули могут пользоваться для исследования возможностей текущего программного окружения. === Метод VERSION === Возвращает значение переменной <code>$VERSION</code> пакета (модуля). Переменная <code>$VERSION</code> может быть объявлена непосредственно в пакете, но рекомендуется инициализировать её в директиве <code>package</code>, так как это более наглядно. <source lang="perl"> 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"; </source> <pre> SomePackage version: 1.0 SomePackage version: 1.0 </pre> У метода есть необязательный аргумент, в котором вы можете передать ожидаемый номер версии. Если фактический номер версии оказывается меньше запрашиваемого, функция выбрасывает исключение. Предполагается, что более старшие версии не совместимы с младшими. <source lang="perl"> 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 $@; </source> <pre> SomePackage version 2 required--this is only version 1.0 at .\universal.pl line 18. </pre> === Метод DOES === Проверяет, есть ли в цепочке наследования текущего класса класс с именем, передаваемом в аргументе. Если есть, то возвращает ИСТИНУ, иначе ЛОЖЬ. <source lang="perl"> 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'); </source> <pre> The Child inherits the Parent The Child does not inherit the AnotherClass The Child inherits the Parent </pre> === Метод can === Проверяет, существует ли метод с указанным именем в цепочке наследования или нет. Если метод существует, то метод возвращает ссылку на него, иначе возвращается ЛОЖЬ. <source lang="perl"> 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); </source> <pre> The Parent has 'parentMethod' The Child has 'parentMethod' Child method </pre> === Метод isa === По умолчанию <code>isa</code> и <code>DOES</code> работают абсолютно одинаково, однако метод <code>isa</code> задумывался, чтобы проверить утверждение ''инстанцирована ли ссылка от переданного в аргументе класса ИЛИ этот класс есть в цепочке наследования''<ref>Сравните с операцией <code>instanceof</code> в языке Java.</ref>, а <code>DOES</code> призвана определить, ''может ли этот класс выполнять данный класс задач''. Некоторые CPAN модули переопределяют внутри себя <code>DOES</code>, поэтому он может возвращать отличные от <code>isa</code> ответы. Чтобы уловить суть, рассмотрим такой пример. <source lang="perl"> package Logger 1.0; # ... Реализация всего того, что должен уметь типичный класс, # умеющий логировать. sub write { my ($class, $msg) = @_; print STDOUT "$msg"; } # # ... # package Animal 1.0; # # ... # package Dog; use parent -norequire, qw ( Logger Animal ); sub new { my $class = shift; return bless {}, $class; } sub whoAmI { my ($class) = @_; return __PACKAGE__; } # # ... # package main; my $o = Dog->new(); if ($o->DOES('Logger')) { $o->write("This object can write log messages\n"); } if ($o->isa('Animal')) { print STDOUT $o->whoAmI . " is " . "Animal" . "\n"; } else { print STDOUT $o->whoAmI . " is not " . "Animal" . "\n"; } </source> <pre> This object can write log messages Dog is Animal </pre> В этом примере у нас есть класс <code>Dog</code> (''собака''), который наследует классы <code>Logger</code> и <code>Animal</code> (''животное''). С точки зрения бизнес-логики, ''собака является животным'', т.е. метод <code>isa()</code> должен подчеркивать отношение ООП ''являюсь''. С другой стороны, класс умеет пользоваться подсистемой логирования приложения и писать в общий журнал сообщения. Таким образом <code>DOES()</code> сообщает, что объект наделен ролью ''логера''. Вам может быть сейчас не понятно, почему мы должны разделять эти возможности, но представьте себе модуль логирования, который написан отдельно от вашего приложения, и не знает системы наследования вашего приложения. Обычно вы просто передаете сконструированные объекты этому модулю в виде ссылок, при этом самому модулю важно понять существует ли возможность вызова методов логирования подсистемы логирования, что и делается через <code>DOES()</code><ref>Опять, если сравнивать с таким языком, как Java, в котором ООП возведено в абсолют, <code>DOES()</code> близок к понятию <code>interface</code>, а <code>isa()</code> к оператору <code>instanceof</code>.</ref>. == Подведение итогов == Описанный выше подход к ООП не является единственным. Существуют модули CPAN, которые пытаются улучшить эту систему, обогащая описанные выше скудные конструкции (например, модуль Moose). Такие модули, как правило, используются в больших проектах. Однако, как бы там ни было, CPAN модули могут требовать загрузки множества зависимостей и могут замедлять скорость исполнения программы из-за своей внутренней реализации. В маленьких проектах достаточно встроенного в Perl ООП. == Perl 5.38: class или попытка сдвинуться с мёртвой точки == Очень долго тема ООП в Perl стояла на месте, но с версии 5.38 разработчики интерпретатора решили сделать новый шаг в этом направлении и ввели новое ключевое слово в язык — <code>class</code>. Дело в том, что у старого подхода есть много недостатков, что не позволительно для ООП парадигмы, в частности: * По сути у классов нет понятия ''поля класса'', а то что есть не обладает полноценной инкапсуляцией. Кроме того, никак не реализуется наследование полей в дочерние классы. Все эти моменты идут на откуп программисту, который, конечно, в этом разберётся, но вероятно напишет не очень понятный код. * Методы класса внешне не выглядят инкапсулировано: не запрещено разбросать их по пакетам, пользуясь уловками интерпретации, а также никакой приватности реализовать в них нельзя. Кроме того, нужно всегда помнить, что в первый аргумент любого метода передаётся ссылка на объект, что вынуждает писать одинаковую первую строку для всех методов, что очень утомляет (сравните с автоматической ссылкой <code>this</code> в C++). Реализация <code>class</code> на момент 2025 года ещё относительно сырая и ей стоит пользоваться осторожно, но можно потихоньку присматриваться. Если вы хотите использовать эту возможность, то обновите интерпретатор минимум до версии 5.40, потому что первые реализации имеют достаточно серьезные ошибки. === Объявление класса === Так как на момент версии 5.40 возможность является экспериментальной, её нужно включать так: <source lang="perl"> use feature 'class'; # Отключает предупреждения об экспериментальной возможности, которые засоряют вывод. no warnings 'experimental::class'; </source> В синтаксисе чувствуется, что разработчики вдохновлялись языком C++, так как синтаксис очень похож: <source lang="perl"> class <имя> <версия> [: <атрибуты-наследования>] [{ <блок-класса> }] # Также класс может быть объявлен, но не определен. class <имя> [<версия>]; </source> Внутренне слово <code>class</code> работает как <code>package</code>, но дополнительно оно генерирует конструктор по умолчанию для пакета. Номер версии для класса используется, когда используется наследование и у класса есть несколько реализаций, чтобы не сломать обратную совместимость. Номер версии может быть опущен, если атрибуты наследования не используются. Для <code>class</code> было введено слово <code>__CLASS__</code>, которое автоматически разворачивается в имя класса в пределах его определения. Им следует пользоваться для манипуляций с элементами класса, если они происходят до инстанцирования объекта. Вот примеры объявления класса <code>Person</code>: <source lang="perl"> class Person 1.000 { # ... } class WithoutVersion { # ... } # Объявление класса class Empty; </source> === Поля класса === Чтобы объявить поле в классе, используется ключевое слово <code>field</code>. Это ключевое слово инкапсулирует поле в классе и гарантирует, что каждый инстанцированный объект класса получит свой набор полей в памяти программы. Полный синтаксис поля такой: <source lang="perl"> class ClassName { field <переменная> [: <атрибуты>] [= <выражение-вычисляющее-инициализирующее-значение>]; } </source> Например, <source lang="perl"> class Person 1.000 { field $name = "Larry"; field $surname = "Wall"; field $born; } </source> Данный синтаксис позволяет присвоить значение полю до вызова конструктора, а также, когда значение для поля не передается через конструктор. Что-то похожее есть в языке Java, но здесь вы можете использовать полноценное Perl-выражение справа от присваивания. === Методы класса === Чтобы объявить метод, используется ключевое слово <code>method</code>. Методы уже становятся очень похожими на методы языка C++, в частности вы можете обращаться к полям класса не используя ссылку на объект. С помощью ключевого слова можно объявлять удобные сигнатуры: <source lang="perl"> class ClassName { method [<имя-метода>] [<сигнатура-метода>] { <блок-метода> } } </source> Сигнатуры в новой реализации поддерживают значения по умолчанию. Внутри методов вы можете обращаться к экземпляру объекта по ссылке <code>$self</code>. Ниже представлены примеры. <source lang="perl"> 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"; </source> <pre> Person: Name: Larry, Surname: Wall, Born: Person: Name: Larry, Surname: Wall, Born: 27.09.1954 { "name" : "Larry", "surname" : "Wall", "born" : "27.09.1954" } </pre> === Атрибуты === Атрибуты призваны для установки правил видимости и доступа к различным частям класса как внутри него самого, так и из классов-потомков. В документации говорится, что атрибуты будут: * у класса; * у полей класса; * у методов (но на момент 5.40 ни одного атрибута для методов ещё не реализовано). ==== Атрибуты класса ==== У класса на момент 5.40 поддерживаются следующие атрибуты: * <code>:isa</code> — атрибут устанавливает отношение между классами типа ''родитель-потомок''. В атрибуте вписывается имя класса родителя и опционально минимальная необходимая версия этого класса (если фактическая версия родителя меньше запрашиваемого, исполнение прерывается). Так как у полей всегда лексическая видимость, эта система умеет реализовывать только приватное наследование полей в терминах языка C++. Если класс ещё не был загружен в пространство текущего пакета, неявно вызывается процедура <code>require</code>.<source lang="perl"> 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) { # ... } </source> ==== Атрибуты полей ==== У полей на момент 5.42 поддерживаются следующие атрибуты: * <code>:param</code> — указывает на то, что начальное значение для этого поля берется из именованного параметра конструктора. По умолчанию, именованный параметр конструктора и имя поля совпадают, но в параметрах атрибута можно указать другое имя, если так удобно или того требует ситуация. Вы можете оставить выражение, которое присваивает значение по умолчанию, но если его нет, значение всегда должно присваиваться через конструктор.<source lang="perl"> 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 </source> * <code>:reader</code> — генерирует для поля геттер. По умолчанию имя геттера совпадает с именем поля, но в параметре атрибута можно указать другое имя.<source lang="perl"> 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"; </source> * <code>:writer</code> — генерирует для поля сеттер. На момент версии 5.42 сеттер можно сгенерировать только для скалярного поля, иначе будет сгенерирована ошибка времени компиляции. По умолчанию имя сеттера генерируется по шаблону <code>set_<имя-поля></code>, но в параметре атрибута можно указать другое имя. Все генерируемые автоматически сеттеры возвращают ссылку на объект, поэтому сеттеры можно вызывать по цепочке.<source lang="perl"> class ModernPerson { field $name :writer; field $surname :writer(surname); field $born :writer = "unknown"; method printAsString { print __CLASS__ . ":" . " Name: " . $name . ", Surname: " . $surname . ", Born: " . $born . "\n" ; } } my $o = ModernPerson->new; $o->set_name("Larry"); # Вызов по цепочке. $o->surname("Wall")->set_born("27.09.1954"); $o->printAsString; </source> === Жизненный цикл объекта класса === Так как <code>class</code> это по сути замаскированный <code>package</code>, то всё что было сказано ранее в классическом подходе Perl к ООП справедливо и здесь в отношении жизненного цикла. Правда есть одно отличие: для <code>class</code> был добавлен специальный именованный блок <code>ADJUST</code>, который семантически очень похож на <code>BEGIN</code>, но из него вам доступна ссылка на инстанцированный экземпляр класса, т.е. этот блок выполняется сразу за конструктором при конструировании каждого нового объекта. Вы можете указать сколько угодно таких блоков и они будут выполняться в порядке появления. Ниже показаны этапы жизненного цикла на конкретном примере. <source lang="perl"> 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; } </source> <pre> 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 </pre> Мы можем видеть, что при наследовании конструкторы и блоки <code>ADJUST</code> вызываются автоматически в порядке от родителя к потомку. Как и раньше, для деструкторов мы должны закладывать вызов деструктора родителя в деструкторе потомка . == Перегрузка операций классов == В этом разделе мы разберем одну из центральных функций ООП в Perl — ''перегрузка операций''. Многие программисты ругают Perl за очень сложный синтаксис ООП, но на самом деле Perl по большому счёту не нужна ООП парадигма в той форме, в которой она есть, например, в языке Java. Perl в первую очередь всегда решал задачи системного администрирования, где скорее важны минимализм и практичность, так как у системных администраторов время на решение входящих запросов очень ограничено. В Perl существует по меньшей мере два подхода перегружать операции: * '''Перегрузка связыванием'''. Данный тип перегрузки опирается на функцию <code>tie()</code>, которая привязывает объект-делегат к переменной определенного типа данных и переопределяет операции для этой переменной (привязывается к ней). Данный тип перегрузки концентрируется на этапах жизненного цикла объекта и перегружает через ''конструктор'', ''деструктор'', операции ''присваивания'' и ''копирования''. * '''Перегрузка операций класса'''. Реализуется через модуль <code>overload</code> и позволяет перегружать знаки операций для выражений, в которых используется объект некоторого класса. === Перегрузка связыванием === Идея этого подхода кроется в желании обобщить работу с хранилищами данных по отношению к типам данных языка Perl. В языке Perl можно любую структуру представить комбинацией стандартных типов языка (скаляр, массив и хеш-массив). С другой стороны, сценарии Perl обычно конечной целью ставят перед собой прочитать данные из некоторого источника и записать данные в некоторый источник. Обычно протокол работы с определенным типом хранилища данных всегда строго определен. Отсюда возникает желание одни и те же данные записывать в разные типы хранилищ одинаковым, с точки зрения интерфейса, способом. Здесь и появляется функция <code>tie()</code>, которая привязывает реализацию-делегат к экземпляру стандартного типа данных. При этом делегат внутри себя полностью управляет протоколом работы с хранилищем, а наружу для клиентского кода перегружает операции ''присваивание'' и ''извлечение'' через знак операции <code>=</code>. Данный подход впервые появился в Perl 5 и поддерживает привязывание для: * скаляров (<code>Tie::Scalar</code>), * массивов (<code>Tie::Array</code>), * хеш-массивов (<code>Tie::Hash</code>), * файловых дескрипторов (<code>Tie::Handle</code>). Основу интерфейса <code>tie()</code> составляют следующие функции: <source lang="perl"> # Строит экземпляр делегата и привязывает его к переменной. tie <переменная-к-которой-привязывается-делегат>, <класс-делегата>, <список-аргументов-для-конструктора-делегата> # Отвязывает делегата от переменной и удаляет его. untie <переменная-к-которой-привязывается-делегат> # Возвращает ссылку на экземпляр делегата. tied <переменная-к-которой-привязывается-делегат> </source> Состав интерфейсных методов для каждого типа данных отличается, так как каждый тип в чём-то специфичен, но в общем каждый тип представляет следующие методы: * <code>TIEHASH</code>, <code>TIEARRAY</code>, <code>TIEHANDLE</code> и <code>TIESCALAR</code> — конструктор делегата соответственно для хеш-массива, массива, дескриптора и скаляра. Сигнатура конструктора для всех типов одинаковая: в первом аргументе передается имя пакета делегата, а в последующих список аргументов для него. * <code>FETCH</code> — определен для всех типов, кроме дескриптора. Вызывается каждый раз, когда связанная переменная участвует в выражении как правосторонний операнд, т.е. значение из источника извлекается. * <code>STORE</code> — определен для всех типов, кроме дескриптора. Вызывается каждый раз, когда связанная переменная участвует в выражении как левосторонний операнд, т.е. значение в источник записывается. * <code>DESTROY</code> — деструктор делегата. Вам не обязательно переопределять все методы, предоставляемые интерфейсом, так как тривиальные реализации всегда есть в соответствующем пакете <code>Tie::</code>. ==== Связывание скаляров ==== Основы работы с tie-интерфейсом проще всего показать на скаляре, так как для скаляра определено самое малое количество методов: * <code>TIESCALAR</code> — конструктор делегата. * <code>FETCH</code> — метод, извлекающий данные из привязанного скаляра. * <code>STORE</code> — метод, записывающий данные в привязанный скаляр. * <code>DESTROY</code> — деструктор делегата. Ниже показан небольшой пример делегирующего класса. <source lang="perl"> 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 </source> <pre> Tie TieScalarExample: 1, 2, 3 To fetch a record Storing a value: 15 Before untie() </pre> В комментариях к примеру показано, в какие моменты вызываются интерфейсные методы. В этом примере мы привязываем делегата <code>TieScalarExample</code> к скаляру <code>$aScalar</code>, после чего любая операция <code>=</code> будет переводиться на методы привязанного делегата до момента вызова <code>untie()</code> в зависимости от того, в левом или правом операнде операции участвует связанный скаляр. Перед отвязыванием делегата вызывается деструктор делегата. В предыдущем примере делегат по сути ничего не делает, но на практике часто за делегатом скаляра стоит реальное хранилище данных, а сам делегат выступает его драйвером. Ниже представлен конкретный пример, в котором делегат логирует все значения, которые проходят через скаляр в любом направлении. <source lang="perl"> #!/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; </source> Если вы откроете файл лога, то увидите следующие строки: <pre> 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 </pre> а на консоли <source lang="bash"> $ ./tiescalar.pl Printing: Apple Printing: Pear Printing: Grapes Printing: Banana </source> Вы можете увидеть странную запись в логах <pre> package main, ./tiescalar.pl line 54 FETCHED none </pre> Она говорит о том, что списковая операция <code>print</code> внутренне тоже обращается к скаляру. ==== Связывание массивов ==== Интерфейс для массивов уже заметно богаче: * <code>TIEARRAY</code> и <code>DESTROY</code> — конструктор и деструктор делегата. * <code>STORE</code> — вызывается, когда по конкретному индексу записывается значение в массив. * <code>FETCH</code> — вызывается, когда по конкретному индексу извлекается значение из массива. * <code>DELETE</code> — вызывается, когда удаляется элемент по индексу. * <code>CLEAR</code> — вызывается для операции <code>delete</code> для всего массива. * <code>PUSH</code>, <code>POP</code>, <code>SHIFT</code>, <code>UNSHIFT</code>, <code>SPLICE</code> — переопределяет стандартные одноименные операции над массивом. * <code>EXISTS</code> — вызывается, когда проверяется существование значение по индексу. * <code>EXTEND</code> — предполагается, что метод расширяет занимаемую память под массив на указанное число позиций. * <code>FETCHSIZE</code> — предполагается, что возвращает реальное число элементов в массиве. * <code>STORESIZE</code> — предполагается, что подравнивает размер массива под указанное значение. Если часть элементов выходит за пределы, они должны быть удалены. Если новый размер больше текущего, то новые значения должны быть проинициализированы <code>undef</code>. Ниже показано, в какие моменты вызываются методы интерфейса. <source lang="perl"> 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 </source> ==== Связывание хеш-массивов ==== Для хеш-массивов определены следующие методы: * <code>TIEHASH</code> и <code>DESTOROY</code> — конструктор и деструктор делегата. * <code>STORE</code> — сохраняет значение в хеш-массив по ключу. * <code>FETCH</code> — извлекает значение из хеш-массива по ключу. * <code>FIRSTKEY</code> — возвращает самый первый ключ в массиве. * <code>NEXTKEY</code> — возвращает следующий ключ. Используется для перебора элементов хеш-массивов через <code>each()</code>. * <code>EXISTS</code> — проверяет существование ключа. * <code>DELETE</code> — удаляет значение из хеш-массива по ключу. * <code>CLEAR</code> — удаляет хеш-массив целиком. * <code>SCALAR</code> — вызывается, когда к хеш-массиву происходит обращение в скалярном контексте. Ниже показано, в какие моменты вызываются методы интерфейса. <source lang="perl"> 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 </source> Следует дать пояснения по методам <code>FIRSTKEY</code> и <code>NEXTKEY</code>. Эти методы реализуют подобие итератора. Метод <code>FIRSTKEY</code> вызывается всегда, когда хеш-массив передается функции <code>keys()</code> или <code>each()</code>. Этот метод должен сбросить состояние итератора, если оно не начальное, и вернуть начало хеш-массива. Метод <code>NEXTKEY</code> возвращает последующий элемент, вычисленный от последнего, переданного аргументом <code>$lastkey</code>. Если возвращать нечего, нужно вернуть значение <code>undef</code>, которое говорит, что элементы закончились. ==== Связывание дескрипторов ==== Связывание для файловых дескрипторов в Perl очень полезный функционал в *nix системах, так как в них через файловые дескрипторы можно получить доступ к любой части системы. Например, можно подключаться к блочным или символьным устройствам через специальные файлы и работать с ними через операции файловых дескрипторов из кода Perl. Так как через дескрипторы ходят символьные потоки, в них нет методов <code>STORE</code> и <code>FETCH</code>, а используются методы <code>WRITE</code> и <code>READ</code>. Интерфейс поддерживает следующие методы: * <code>TIEHANDLE</code> и <code>DESTROY</code> — конструктор и деструктор делегата. * <code>WRITE</code> — записывает указанное число байтов с некоторого начального адреса и некоторого смещения от его начала. * <code>READ</code> — читает указанное число байтов с некоторого начального адреса и некоторого смещения от его начала. * <code>READLINE</code> — читает несколько байтов до некоторого разделителя. * <code>GETC</code> — читает очередной символ в символьном потоке. * <code>PRINT</code> — печатает значения в переданном списке. * <code>PRINTF</code> — печатает значения в списке с использованием форматной строки. * <code>OPEN</code> — открывает или переоткрывает файловый дескриптор. * <code>CLOSE</code> — закрывает файловый дескриптор. * <code>BINMODE</code> — указывает на то, что читаемый поток представляет собой поток байтов, а не отдельных символов (другими словами, включает бинарный режим чтения). * <code>EOF</code> — возвращает истину, если поток закончился. * <code>TELL</code> — возвращает текущую позицию в файле. * <code>SEEK</code> — передвигает позицию в файле относительно некоторой опорной точки. Ниже показано, в какие моменты вызываются методы интерфейса. <source lang="perl"> use strict; package TieHandleExample; sub TIEHANDLE { my ($class, @argv) = @_; return bless {}, $class; } sub WRITE { my ($self, $address, $length, $offset) = @_; } sub READ { my ($self, $address, $length, $offset) = @_; } 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, $offset, $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 $offset, 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 </source> Для этого типа связывания мы приведем два конкретных примера использования. Наверное вы знаете Unix утилиту [[w:tee|tee]]. Основной задачей этой утилиты является копирование и перенаправление основного потока. Например, этим пользуются, когда вывод программы нужно видеть на консоли и одновременно с этим логировать его в файл (возможно в несколько файлов). В Perl можно реализовать возможности <code>tee</code> следующим образом. <source lang="perl"> #!/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; </source> В примере выше мы открываем 5 дескрипторов: 4 связывается с файлами (<code>tmp1</code>, <code>tmp2</code>, <code>tmp3</code>, <code>tmp4</code>), причем <code>tmp3</code> открывается на дозапись, и один связывается со стандартным потоком вывода (<code>-</code>). Все эти дескрипторы представляет один общий, который мы назвали <code>BROADCAST</code> и к которому мы привязали свою реализацию метода <code>PRINT</code>. Она не очень сложная и занимается тем, что для каждого открытого ранее дескриптора вызывает функцию <code>print</code> и передает список для печати. После запуска программы, вы можете видеть, как создаются 4 файла, и один и тот же вывод транслируется в каждый из них и на консоль. Следующий пример показывает, как приложение может переключать источник ввода. Если приложению не передано ни одного аргумента командной оболочки, то приложение читает стандартный поток ввода. <source lang="perl"> 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; </source> <source lang="bash"> # Аргументы переданы явно $ perl ./selecthandle.pl 1 2 3 1 2 3 # А теперь данные поставляются через STDIN. $ seq 1 3 | perl ./selecthandle.pl 1 2 3 </source> === Перегрузка операций через модуль overload === Второй подход перегрузки операций заключается в использовании директивного модуля <code>overload</code>. Данный модуль позволяет перегрузить часть стандартных операций в отношении произвольного класса. Данный модуль разрешает перегружать только те операции, которые перечислены в хеш-массиве <code>%overload::ops</code>. На момент версии 5.40 состав перегружаемых операций таков: <source lang="bash"> $ 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' }; </source> Обратите внимание, что операции в этом массиве отсортированы по категориям. Большинство операций в этом списке однозначно соответствуют их знакам, но есть и исключения. * Операции <code>not</code> нет в списке перегружаемых операций, однако, если вы перегружаете <code>!</code>, то при вызове <code>not</code> будет использоваться реализация для <code>!</code>. * Точно так же операция унарного минуса <code>-</code> будет использовать реализацию для <code>neg</code>. * При перегрузке инкремента <code>++</code> и декремента <code>--</code>, Perl не будет делать отдельные реализации для префиксной и постфиксной формы (как, например, это делается в языке C++), однако точка вызова их в выражении будет поставлена так, чтобы отрабатывала префиксная или постфиксная форма. Эти операции находятся в категории <code>mutators</code>, что говорит о том, что они работают не с копией значения, а ссылкой на него. * Операцию присваивания <code>=</code> нельзя перегрузить с помощью этого модуля, так как она зарезервирована для конструктора копирования класса. Единственный способ её перегрузить — это использовать интерфейс <code>tie()</code>. Тем не менее, вы можете перегружать прочие разновидности присваивания (категория <code>assign</code>), так как они работают с ссылкой. * Операции<pre>+ - * / % ** << >> x . & | ^ &. |. ^.</pre>не должны изменять свои операнды, так как они передаются по ссылке и это было бы некорректным поведением. Другими словами, они должны конструировать новое значение в качестве результата. * Все операции тестирования файла (<code>-f</code>, <code>-x</code> и др.) перегружаются одной и той же операцией <code>-X</code>, и перегрузить их по-отдельности невозможно. Тем не менее, вы можете распознать какой тест передаётся через второй аргумент, несмотря на то, что операция унарная. Обычно, если вам требуется перегрузить операции для вашего класса, минимально рекомендуется перегружать следующие: <pre> + - * / % ** << >> x <=> cmp & | ^ ~ &. |. ^. ~. atan2 cos sin exp log sqrt int "" 0+ bool ~~ </pre> ==== Основы перегрузки ==== * Перегрузка операции происходит в момент вызова модуля <code>overload</code>. Вы должны указать знак операции из таблицы <code>%overload::ops</code> в качестве ключа, а затем присвоить ссылку на процедуру любым доступным способом<source lang="perl"> use overload "-" => "minus", # Перегрузка с помощью символической ссылки. "*=" => \&muas, # Перегрузка с помощью жесткой ссылки. '""' => sub { ...; }; # Объявление анонимной процедуры на месте. </source> * Объявленные процедуры должны быть реализованы в ближайшем к директиве пакете. Обычно это пакет класса, которому требуется перегрузка операций. Допустимо указывать реализацию из другого пакета. Кроме того, если реализация наследуется, то к ней справедливы все правила наследования, описанные выше. Например, если есть классы <code>A -> B -> C</code>, где стрелка указывает на родителя, и классы <code>B</code> и <code>С</code> перегружают одну и ту же операцию, <code>A</code> будет искать по списку <code>@ISA</code> ближайшую в цепочке наследования реализацию. * Все перегружающие процедуры объявляются одинаково<source lang="perl"> sub overloadImpl { my ($self, $other, $swap) = @_; ... return $result; } </source>Однако, интерпретация входящих аргументов и тип возвращаемого значения зависят от смысла операции (см. ниже). * Для некоторых операций, которые связаны по смыслу разными знаками, Perl может генерировать реализацию автоматически для той части, которая не была перегружена явно. Например, операции <code>0+</code><ref>Операция <code>0+</code> называется «Венерой» из-за внешней схожести с [[w:Зеркало Венеры|зеркалом Венеры]]. Данная операция пытается преобразовать строку в число в скалярном контексте.</ref>, <code>""</code>, и <code>bool</code> могут предоставить свою реализацию операции <code>!</code>, если та не была перегружена, а хотя бы одна из них была перегружена. * Ключ <code>nomethod</code> может использоваться для объявления универсальной перегрузки, которая будет вызываться для любой не перегруженной индивидуально операции. * Установка флага <code>fallback</code> даёт модулю подсказку, как он должен поступать с вызовом, если не удаётся найти для операции перегруженную реализацию. ==== Реализующая процедура ==== Перегрузка бинарных и унарных операций происходит по одному прототипу входящих параметров<source lang="perl">my ($self, $other, $swap, $nomethod, $binary) = @_;</source>Здесь * <code>$self</code> — ссылка на объект класса, для которого была перегружена операция; * <code>$other</code> — второй операнд или параметр унарной операции; * <code>$swap</code> — флаг, который говорит о том, находится ли ссылка на объект слева (ЛОЖЬ) от знака операции или справа (ИСТИНА). Реализующая процедура обычно возвращает ссылку на результат. Здесь многое зависит от того, какой смысл закладывается в перегрузку. Флаг <code>$swap</code> многогранный. Он используется и в бинарных, и унарных операциях, но ЛОЖЬ в них представляется по-разному. В бинарных операциях ЛОЖЬ представляется пустой строкой <code><nowiki>''</nowiki></code>, а в унарных операциях и операциях класса <code>assign</code> используется <code>undef</code>. Существуют также 4-й и 5-й параметры, которые инициализируются в особых ситуациях. Если перегружена специальная операция <code>nomethod</code>, которая по смыслу похожа на <code>AUTOLOAD</code> (но для операций), 4-й параметр всегда инициализируется знаком операции. Для побитовых операций (<code>&</code>, <code>|</code>, <code>^</code> и <code>~</code>) инициализируется 5-й параметр, чтобы, возможно, подсказать реализации о необходимости работать с операндами как с числами. ==== Автогенерируемые операции ==== Если вызывается операция для некоторого класса и при этом для неё нет перегруженной реализации, модуль <code>overload</code> руководствуется встроенным в него флагом <code>fallback</code>, который по умолчанию имеет значение ИСТИНА. Алгоритм поиска реализации операции таков: # Если операция перегружена в объекте вызываемого класса, то использовать реализацию в этом классе, иначе идём дальше. # Если <code>fallback</code> ИСТИНА или <code>undef</code>, попытаться сгенерировать автоматическую реализацию. # Если операция не относится к категории <code>assign</code>, то повторить шаг 1 для второго операнда. # Повторить шаг 2 для второго операнда. # Если для первого операнда все сводится к <code>nomethod</code> реализации, то использовать её. # Если для второго операнда все сводится к <code>nomethod</code> реализации, то использовать её. # Если <code>fallback</code> ИСТИНА и не нашлось ни одной реализации, то попытаться обработать операнды в соответствии с типом операции. Например, если операция арифметическая, то попытаться привести операнды к числам; если строковая — строкам и т.д. # Если ничего из этого не может корректно отработать, то бросить исключение. В этом алгоритме для унарных операции опускаются шаги, связанные со вторым операндом. Хотя правила выше кажутся прозрачными, существует очень много подводных камней в ситуациях, когда не удаётся найти реализацию, поэтому стоит перегружать операции всегда с большой внимательностью. Для некоторых операций могут использоваться близкие по смыслу операции, которые могут предоставить свою реализацию, если целевая не была определена. Вы можете ознакомиться с ними в официальной документации [https://perldoc.perl.org/overload#Magic-Autogeneration Magic-Autogeneration]. ==== Пример перегрузки ==== На практике перегрузка зачастую используется, чтобы выразить идею программы более наглядно — добавить синтаксического сахара. Пример ниже демонстрирует модуль, который, используя операцию <code><<</code>, представляет поток строк, который, возможно, используется шаблонизатором<ref>Программой, которая, используя некоторый шаблон, генерирует конечный текстовый документ.</ref>. В данный поток можно встраивать условия, чтобы игнорировать некоторые части шаблона в зависимости от текущих условий. Внимательно изучите следующий код. <source lang="perl"> 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; </source> Данный модуль представляет класс <code>StringStream</code>, который имеет два атрибута: <code>stream</code> и <code>if_stack</code>. Атрибут <code>stream</code> представляет собой ссылку на строковый массив, в который набираются части результирующей строки. Чтобы в потоке строк иметь возможность игнорировать некоторые части, класс реализует собственные операции, которые могут представлять условия. Они реализуются за счет встроенных классов, которые не видны клиентскому коду, но которые может интерпретировать <code>StringStream</code>. Эти классы имитируют конструкцию <code>If...ElseIf...Else</code>, но, чтобы отмечать границу конструкции, используется терминирующая операция <code>Endl</code>. Создать экземпляры встроенных классов можно только с помощью функций-оболочек, которые имеют имена <code>If</code>, <code>ElseIf</code>, <code>Else</code> и <code>Endl</code>, причем в <code>If</code> и <code>ElseIf</code> можно передавать выражения, которые выполняют роль условных конструкций. Весь секрет этого класса кроется в том, что он и его скрытые классы перегружают знак операции <code><<</code>, который отсылает к одной единственной процедуре <code>__stream_element</code>. Данная процедура анализирует второй операнд и, используя массив <code>if_stack</code>, отключает части потока строк, в зависимости от результатов условных выражений. Данная система не проверяет некоторые некорректные ситуации и ожидает, что ни один <code>ElseIf</code> не будет встречаться раньше чем <code>If</code>; <code>Else</code> не будет стоять раньше <code>If</code> и <code>ElseIf</code>, а каждая открытое условие <code>If</code> будет терминироваться <code>Endl</code>. Кроме операции <code><<</code> класс <code>StringStream</code> также перегружает операцию <code>q{""}</code>, которая используется в скалярном контексте, чтобы сформировать из набранной строки окончательную. Ниже показан пример использования. <source lang="perl"> #!/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 ; </source> В данном примере анализируется входящий массив аргументов и, в зависимости от переданного числа аргументов, печать выводится по-разному: <source lang="perl"> # Предполагается, что файл модуля лежит в рабочем каталоге. $ 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 </source> Обратите внимание, что мы могли бы конструировать строку без использования этого «сахара», но конечная конструкция изобиловала бы множеством операций конкатенации, ветвлений и циклов. Другими словами, мы концентрируемся на задаче сформировать строку по нашим правилам простыми средствами. == Объектно-ориентированный подход в системе ввода-вывода == С появлением в Perl 5 модулей, в систему ввода-вывода также был добавлен ООП подход в виде интерфейсного класса [https://perldoc.perl.org/IO::Handle IO::Handle] и его классов-потомков, таких как <code>IO::File</code>, <code>IO::Pipe</code>, <code>IO::Socket</code> и других. Это позволяет облегчить написание программ, требующих работы с операциями [[../Ввод и вывод|ввода и вывода]], рассмотренные нами ранее. В данном разделе мы рассмотрим этот интерфейс, чтобы продемонстрировать, как ООП подход может упростить и унифицировать написание кода, связанного с вводом-выводом по файловым дескрипторам. === Интерфейс IO::Handle === Интерфейс, реализуемый модулем <code>IO::Handle</code>, содержит универсальные методы, применяемые для всех объектов, которые в своей реализации открывают файловый дескриптор. Более специализированные классы, например <code>IO::File</code> (обычный файл), предоставляют дополнительные методы, учитывающие нюансы работы с данным типом файла, но так или иначе переопределяют методы, вводимые классом <code>IO::Handle</code>. Вместе эти классы сглаживают некоторые недостатки встроенных дескрипторов файлов Perl и упрощают понимание и сопровождение программ. Объект <code>IO::Handle</code> может быть построен одним из двух конструкторов: * '''Конструктор без аргументов''' (<code>new()</code>) позволяет построить пустой объект класса <code>IO::Handle</code>. Далее необходимо сделать библиотечный вызов <code>fdopen()</code> через одноименный метод, чтобы открыть файловый дескриптор с определенным режимом. Так как этот вызов требует знания флагов и атрибутов, его вызов не очень удобен на практике. Конструкторы в классах, наследующих этот интерфейс, скрывают этот вызов в своих реализациях. * '''Конструктор с аргументами''' (<code>new_from_fd ()</code>) позволяет построить объект и привязать к нему уже открытый дескриптор. Главным образом используется, когда нет нужной реализации интерфейса, но требуется использовать методы <code>IO::Handle</code>. Методы <code>IO::Handle</code> в основном копируют одноименные функции ввода-вывода: <source lang="perl"> $io->close # Закрыть дескриптор. $io->eof # Возвращает признак конца потока EOF. $io->fcntl( FUNCTION, SCALAR ) # Управляет флагами файлового дескриптора. $io->fileno # Возвращает номер файлового дескриптора. $io->format_write( [FORMAT_NAME] ) # Аналог функции write(), т.е. запись по формату. $io->getc # Прочитать очередной символ. $io->ioctl( FUNCTION, SCALAR ) # Делает системный вызов ioctl() для управления устройством ввода-вывода. $io->read ( BUF, LEN, [OFFSET] ) # Буферизированное чтение. $io->write ( BUF, LEN [, OFFSET ] ) # Буферизированная запись. $io->print ( ARGS ) # Буферизированная запись. $io->printf ( FMT, [ARGS] ) # Буферизированная запись по форматной строке. $io->say ( ARGS ) # Буферизированная запись с переносом строки. $io->stat # Реализация функции stat(). $io->sysread ( BUF, LEN, [OFFSET] ) # Не буферизированное чтение $io->syswrite ( BUF, [LEN, [OFFSET]] ) # Не буферизированная запись. $io->truncate ( LEN ) # Смещает указатель записи в начало, что аналогично удалению данных. $io->opened # Возвращает ИСТИНУ, если дескриптор открыт. $io->getline # Возвращает строку до разделителя. $io->getlines # Возвращает строки до конца потока. $io->ungetc ( ORD ) # Возвращает из потока символ с указанным порядковым номером. $io->error # Возвращает ИСТИНУ, если возникала ошибка ввода-вывода. $io->clearerr # Сбрасывает флаг ошибки. Возвращает -1, если дескриптор находится в состоянии ошибки. $io->sync # Реализует синхронизацию данных в буфере и на носителе на уровне системы (не PerlIO). Может не поддерживаться на некоторых системах. $io->flush # Сброс буферов ввода-вывода, связанных с дескриптором. $io->printflush ( ARGS ) # Реализует сброс буферов только для текущей операции, а затем восстанавливает состояние флага сброса. $io->blocking ( [ BOOL ] ) # Если в аргументе передается ИСТИНА, делает операции ввода-вывода неблокирующими. </source> Также интерфейс позволяет управлять встроенными переменными языка Perl, управляющими вводом-выводом. Следующие методы управляют значениями для конкретного экземляра класса: <source lang="perl"> $io->autoflush ( [BOOL] ) # Управляет $| (управление буферизацией) $io->format_page_number( [NUM] ) # Управляет $% (номер страницы при выводе по формату) $io->format_lines_per_page( [NUM] ) # Управляет $= (число строк на страницу при выводе по формату) $io->format_lines_left( [NUM] ) # Управляет $- (число строк на текущей странице при выводе по формату) $io->format_name( [STR] ) # Управляет $~ (имя текущего формата) $io->format_top_name( [STR] ) # Управляет $^ (имя формата, который является верхним колонтитулом) $io->input_line_number( [NUM]) # Управляет $. (номер последней прочитанной строки последнего удачного чтения) </source> Следующие переменные управляются из этого интерфейса, но применяются ко всем открытым дескрипторам (т.е. методы являются статическими): <source lang="perl"> IO::Handle->format_line_break_characters( [STR] ) # $: (хранит символы переноса строк) IO::Handle->format_formfeed( [STR]) # $^L (управляющий символ перехода на новую страницу при выводе по формату) IO::Handle->output_field_separator( [STR] ) # $, (разделитель полей при печати функцией print) IO::Handle->output_record_separator( [STR] ) # $\ (символ, добавляемый в конец при печати функцией print) IO::Handle->input_record_separator( [STR] ) # $/ (символ разделителя записей при чтении из файлов) </source> Ниже показан небольшой пример работы с <code>IO::Handle</code>. <source lang="perl"> # Файл: handle.pl use strict; use warnings; use IO::Handle; my @strings; # Открываем дубликат дескриптора STDIN, чтобы работать с ним из экземпляра IO::Handle. my $io = IO::Handle->new_from_fd(fileno(STDIN),"r"); if ($io->opened) { push @strings, $_ while $_ = $io->getline; $io->close; print "Record number: " . @strings . "\n"; } # Следующая печать показывает, что закрылся только дубликат, а не STDIN. print "Object \$io " . ($io->opened ? "is opened" : "is closed") . "\n"; # При подключении модуля IO::Handle, все открытые дескрипторы неявно получают доступ к интерфейсным методам. print "STDIN " . (STDIN->opened ? "is opened" : "is closed") . "\n"; our $out; # Открываем дубликат дескриптора STDOUT, чтобы работать с ним из экземпляра IO::Handle. # Для примера, дубликат открывается методом fdopen(). { $out = IO::Handle->new(); if ($out->fdopen(fileno(STDOUT),"w")) { print "Printing 1:\n"; foreach my $line (@strings) { $out->write($line); } } # При обнулении ссылки, будет вызван деструктор, в котором close() вызывается неявно. undef $out; } # Мы могли не создавать дубликат STDOUT, а писать в него напрямую через интерфейс. print "Printing 2:\n"; foreach my $line (@strings) { STDOUT->write($line); } </source> <source lang="bash"> $ echo -e "aaa\nbbb\nccc" | perl handle.pl Record number: 3 Object $io is closed STDIN is opened Printing 1: aaa bbb ccc Printing 2: aaa bbb ccc </source> Приведенный выше пример плохо показывает, чем ООП парадигма в данном случае лучше процедурной, однако, мы всё же перечислим некоторые преимущества такого подхода: * Вы можете заметить, что вы не работаете с дескрипторами напрямую. По сути вы работаете с ссылками на объекты, которые инкапсулируют дескриптор внутри себя. Если бы программа была больше и в ней бы требовалось передавать дескриптор различным её частям, поддерживать код с передачей ссылки на объект намного проще, чем передачу дескриптора. * Жизненный цикл объекта отчасти перекладывается на систему очистки ссылок Perl: вам легче освобождать ресурсы системы, так как их освобождают автоматически вызываемые деструкторы. * В начале исходного файла вы всегда подключаете нужный вам модуль пространства <code>IO::</code>, что может давать подсказку читающему программу, что данный код работает с определенным типом файла. При работе с дескрипторами напрямую, невозможно дать такую подсказку без длинного комментария. В большой программе (в несколько тысяч строк), чтобы уловить намерения работы с дескриптором, вам придется внимательно изучить все вызовы, в которых участвует дескриптор. * При любых фатальных ошибках конкретная реализация интерфейса, как правило, выбрасывает исключение, которое перехватывать проще, чем проверять коды возврата. === Примеры === Ниже приведено несколько примеров применения потомков <code>IO::Handle</code>. Следующая программа открывает простой файл, переданный аргументом, и считает сколько в нём строк. В этом примере используется класс <code>IO::File</code> для работы с файлом в ООП стиле. <source lang="perl"> # Файл: line_counter.pl use strict; use warnings; use IO::File; my $file = shift; my $counter = 0; my $io = IO::File->new($file) or die "Cannot open $file: $!\n"; $counter++ while defined $io->getline; STDOUT->print("File '$file' contains $counter lines\n"); </source> <source lang="bash"> $ cat > file.txt <<EOF 1 2 3 4 5 6 EOF $ perl line_counter.pl file.txt File 'file.txt' contains 6 lines </source> Вернемся к примеру, рассмотренному в разделе [[../Ввод и вывод#Открытие канала через pipe()|Открытие канала через pipe()]]. При работе с каналом в процедурном стиле код получается довольно громоздким. Теперь посмотрите на то, как код будет выглядеть, если управлять каналом через объект класса <code>IO::Pipe</code>. <source lang="perl"> # Файл: pipe.pl use strict; use warnings; use IO::Pipe; # Строим объект одностороннего канала. my $pipe = IO::Pipe->new(); # Создаем со-процесс. my $pid = fork(); if (defined $pid) { if ($pid == 0) { # Пересоздаем объект так, чтобы на этом конце можно было только писать в канал. # Также отключаем буферизацию. $pipe->writer()->autoflush(); $pipe->print("Hello from child process\n"); $pipe->close(); exit 0; } else { # Пересоздаем объект так, чтобы на этом конце можно было только читать канал. $pipe->reader(); while (defined (my $line = $pipe->getline)) { STDOUT->print("Parent received: $line"); } $pipe->close(); waitpid $pid, 0; } } else { die "Could not fork: $!"; } </source> <source lang="bash"> $ perl pipe.pl Parent received: Hello from child process </source> Обратите внимание, что код стал намного чище. Наконец, продемонстрируем простейший Web-клиент, использующий модуль <code>IO::Socket</code>. Использование ООП подхода в этой задаче избавляет вас от изнурительного труда по настройке сетевого сокета через библиотеку <code>Socket</code>. <source lang="perl"> # Файл: pcurl.pl use strict; use warnings; # Импортируем IO::Socket и подключаем некоторые константы. use IO::Socket qw ( :DEFAULT :crlf ); # Изменяем стандартный разделитель строк на разделитель CRLFCRLF, так как им # заканчивается список заголовков. IO::Handle->input_record_separator( CRLF . CRLF ); # Пользователь передает URL для подключения. my $url = shift or die "pcurl.pl <URL>\n"; my $data; # Регулярными выражениями выделяем в URL хост и путь до ресурса. Этот клиент работает # только по протоколу HTTP. my ($host, $path) = $url =~ m!^http://([^/]+)(/[^\#]*)! or die "Invalid URL.\n"; # Открываем сетевой сокет и пытаемся подключиться к сетевой службе по порту 80. my $socket = IO::Socket::INET->new(PeerAddr => $host, PeerPort => 'http(80)') or die "Cannot connect: $!"; # Посылаем запрос на сервер по переданному пути. $socket->print("GET $path HTTP/1.0", CRLF, CRLF); # Отделяем заголовки от полезной нагрузки. my $header = <$socket>; $header =~ s/$CRLF/\n/g; # Печатаем заголовки. STDOUT->print($header); # Печатаем сообщение ответа. STDOUT->print($data) while ($socket->read($data, 1024) > 0); </source> Для примера, обратимся к ресурсу [http://httpbin.org/ip httpbin.org/ip], который является эхо-сервером, возвращающим ваш IP адрес, по которому вы к нему подключаетесь. <source lang="perl"> $ perl pcurl.pl 'http://httpbin.org/ip' HTTP/1.1 200 OK Date: Sat, 27 Sep 2025 08:43:20 GMT Content-Type: application/json Content-Length: 29 Connection: close Server: gunicorn/19.9.0 Access-Control-Allow-Origin: * Access-Control-Allow-Credentials: true { "origin": "5.206.96.5" } </source> Надеемся, что эти простейшие примеры дадут вам представления о некоторых преимуществах ООП подхода. == Примечания == {{примечания}} nux9j4u5foshhqhedwavelo0xbggz4y