Предположим, класс C наследует у классов A и B. Для осуществления наследования в языке Perl следует в самом начале определения класса-наследника C поместить команду

Perl
use base ('A', 'B');

(после use base указывается массив с именами базовых классов).

Конструктор new первоначально создаёт новый объект LSystem как объект Turtle, после чего наделяет его двумя новыми свойствами. Это condition (строка состояния L-системы) и rules (ссылка на ассоциативный массив правил). Свойство condition получает в качестве значения строку-аксиому, переданную как первый параметр конструктора. Остальные параметры, пары вида … => …, отправляются в ассоциативный массив, на который указывает свойство rules. Заключительный вызов bless делает такой дооснащённый объект объектом класса LSystem:

Perl
sub new($%)
{
	my $class=shift;
	my $self=Turtle->new;
	$self->{condition}=shift;
	%{$self->{rules}}=@_;
	return bless $self, $class;
}

Задача метода iterate — $n раз повторить преобразование строки состояния condition согласно правилам, размещённым в rules:

Perl
sub iterate($)
{
	my $self=shift;
	my $n=shift;
	$self->{condition}=join
		(
			'',
			map $self->{rules}{$_}//$_,
				split(//, $self->{condition})
		)
		while $n--;
}

Содержательная часть процедуры

Perl
$self->{condition}=… while $n--;

нуждается в пояснении. Выражение split(//, $self->{condition}) возвращает список символов строки состояния. Этот список передаётся процедуре map.

Встроенная процедура map позволяет для каждого элемента массива вычислить выражение и возвратить массив, заполненный вычисленными выражениями. Первый параметр процедуры — выражение. Внутри этого выражения очередной элемент списка виден как переменная $_. Второй параметр — это исходный массив. К примеру, вот как с помощью map можно получить список квадратов первых ста натуральных чисел:

Perl
@squares=map($_**2, 1..100);

В нашем случае процедура map вычисляет список замен для символов состояния. Пусть очередной символ находится в переменной $_. Тогда он заменяется на $self->{rules}{$_} (на соответствующую строку-последователь из таблицы rules). Но это лишь в том случае, если символ $_ имеется в таблице замен в качестве ключа (предшественника). В противном случае символ заменяется сам на себя. Вспомним про новый оператор //: выражение $self->{rules}{$_}//$_ объединит оба случая.

Наконец, список, выдаваемый процедурой map, направляется в процедуру join, которая соединяет строки из списка вместе. В качестве разделителя используется пустая строка.

Метод interpret получает ассоциативный массив с таблицей интерпретации символов строки состояния и первым делом сохраняет этот массив в переменной %actions. Затем в цикле для каждого символа (снова split //, $self->{condition}) вызывается процедура интерпретации (если, конечно, такая процедура определена). Вызываемой процедуре, как и было обещано, в качестве параметра передаётся сам объект ($self), через который можно управлять как L-системой, так и черепахой. Например, процедура sub { shift->rotate(60) } поворачивает черепаху на $60°$.

Perl
sub interpret(%)
{
	my $self=shift;
	%actions=@_;
	for(split //, $self->{condition})
	{
		$actions{$_}->($self) if exists $actions{$_};
	}
}

Прежде всего придумаем имя классу, реализующему L-систему на основе ленивого подхода. Учтём, что имеющийся вполне работоспособный класс LSystem уже имеет адекватное имя, отражающее его назначение, и размещён в файле LSystem.pm. Имя для нового класса точно так же должно отражать назначение класса, и при этом отличаться от существующего. Имена классов в Perl могут быть «многочленными», то есть составленными из нескольких слов, разделённых двойными двоеточиями ::. Воспользуемся этой возможностью и дадим классу имя LSystem::Lazy — вторая часть имени подчеркнёт «ленивую» сущность класса.

Выбранное имя скажется и на имени файла, в котором содержится определение класса. По соглашению, принятому в Perl, определение класса A::B::C следует помещать в файл A/B/C.pm. Команда use A::B::C ищет такой файл в одной из директорий, предназначенных для размещения библиотечных модулей Perl (список таких директорий можно задать при настройке Perl). Когда файл будет найден, определения из него будут загружены. Отсутствие файла, как мы уже писали, приведёт к ошибке компиляции.

Многочленные имена классов позволяют упорядочить соответствующие библиотечные модули, сгруппировав их тематически. Например, классы, посвящённые взаимодействию с файловой системой, получают имена вида File::*, связанные с вводом/выводом — IO::*, с математическими вычислениями — Math::*. Соответствующие библиотечные модули размещаются в директориях File/, IO/, Math/.

Таким образом, определение класса LSystem::Lazy должно быть в файле LSystem/Lazy.pm.

Ничего не мешает помещать в один библиотечный модуль определения нескольких классов. Видимо, так и следует поступать в случаях, когда определяется вспомогательный класс, не имеющей самостоятельной ценности, но необходимый для работы другого класса. Именно такая ситуация возникает и в нашем случае. Вспомогательным будет класс, реализующий фильтр. Назовём этот класс LSystem::Lazy::Filter. Можно было бы разместить его определение в отдельном файле LSystem/Lazy/Filter.pm, но мы расположим определение всё в том же файле LSystem/Lazy.pm, вместе с классом LSystem::Lazy.

Использовать класс LSystem::Lazy следует точно так же, как мы ранее использовали LSystem: в старых программах всюду заменяем имя старого класса на новое имя. Класс упоминается в двух местах: в команде use LSystem и при вызове конструктора LSystem->new.

Perl
sub new($$)
{
	my $class=shift;
	my $source=shift;
	my $rules=shift;
	my $self={
		buffer=>'',
		source=>$source,
		rules=>$rules,
	};
	return bless $self, $class;
}

Perl
return substr($self->{buffer}, 0, 1, '');

Perl
while($self->{buffer} eq '')
{
	my $char=$self->{source}->getc;
	return unless defined $char;
	$self->{buffer}=$self->{rules}{$char}//$char;
}

Perl
$self->{buffer}=$self->{rules}{$char}//$char;

Perl
sub getc()
{
	my $self=shift;
	while($self->{buffer} eq '')
	{
		my $char=$self->{source}->getc;
		return unless defined $char;
		$self->{buffer}=$self->{rules}{$char}//$char;
	}
	return substr($self->{buffer}, 0, 1, '');
}

Perl
my $source=IO::File->new(\"STRING", '<');

Perl
sub new($%)
{
	my $class=shift;
	my $self=Turtle->new();
	my $axiom=shift;
	$self->{source}=IO::File->new(\$axiom, '<');
	%{$self->{rules}}=@_;
	return bless $self, $class;
}

Perl
use IO::File;

Perl
sub iterate($)
{
	my $self=shift;
	my $n=shift;
	$self->{source}=LSystem::Lazy::Filter->new($self->{source}, $self->{rules})
		while $n--;
}

Perl
for(split //, $self->{condition})
{
	…
}

Perl
while(my $char=$self->{source}->getc)
{
	…
}