Приглашаем посетить
Культура (niv.ru)

11.9. Конструирование записей

Назад
Глава 11 Ссылки и записи
Вперед

11.9. Конструирование записей

Проблема

Требуется создать тип данных для хранения атрибутов (запись).

Решение

Воспользуйтесь ссылкой на анонимный хэш.

Комментарий

Предположим, вам захотелось создать тип данных, содержащий различные атрибуты - аналог структур С или записей Pascal. Проще всего сделать это с помощью анонимного хэша. Следующий пример демонстрирует процесс инициализации и применения записи, содержащей информацию о работнике фирмы:
$record = {
NAME => "Jason",
EMPNO => 132,
TITLE => "deputy peon",
AGE => 23,
SALARY => 37_000,
PALS => [ "Norbert", "Rhys", "Phineas""!
printf "I am %s, and my pals are %s.\n",
$record->{NAME}, join(", ", @{$record->{PALS}}):

Впрочем, от отдельной записи толку мало - хотелось бы построить структуры данных более высокого уровня. Например, можно создать хэш %ByName, а затем инициализировать и использовать его следующим образом:
# Сохранить запись
$byname{ $record->{NAME} } = $record;
# Позднее искать по имени
if ($rp = $byname{"aron"}) {
# false, если отсутствует missing
printf "Aron is employee %d.\n", $rp->{EMPNO};
}
# Дать Джейсону нового друга push
@{$byname{"Jason"}->{PALS}}, "Theodore";
printf "Jason now has %d pals\n", scalar @{$byname{"Jason"}->{PALS}};

В результате %byname превращается в хэш хэшей, поскольку хранящиеся в нем значения представляют собой ссылки на хэши. Поиск работника по имени с применением такой структуры оказывается простой задачей. Если значение найдено в хэше, мы сохраняем ссылку на запись во временной переменной $гр, с помощью которой далее можно получить любое нужное поле. Для операций с %byname можно использовать стандартные средства работы с хэшами. Например, итератор each организует перебор элементов в произвольном порядке:
# Перебор всех записей
while (($name, $record) = each %byname) {
printf "%s is employee number %d\n", $name, $record->{EMPNO};
}

А как насчет поиска работников по номеру? Достаточно построить друг',: структуру данных - массив хэшей employees. Если работники нумеруются нег следовательно (скажем, после 1 следует номер 159997), выбор массива окажете неудачным. Вместо этого следует воспользоваться хэшем, в котором номер }', ботника ассоциируется с записью. Для последовательной нумерации подойдет массив:
# Сохранить запись
$employees[ $record->{EMPNO} ] = $record;
# Поиск по номеру
if ($rp = $employee[132]) {
printf "employee number 132 is %s\n", $rp->{NAME};
}

При работе с подобными структурами данных обновление записи в одном месп обновляет ее везде. Например, следующая команда повышает жалование Джейсо-нана3,5%: $byname{"Jason"}->{SALARY} *= 1.035; Внесенные изменения отражаются во всех представлениях этих записей. Помните о том, что $byname{" Jason"} и $employees[132] ссылаются на одну и ту же запись, поскольку хранящиеся в них ссылки относятся к одному анонимному хэш\. Как отобрать все записи, удовлетворяющие некоторому критерию? Для этого и была создана функция дгер. Например, в следующем фрагменте отбирo .i два подмножества записей - работников, чья должность содержит слово ^ и тех, чей возраст равен 27 годам.
@peons = grер { $_->{TITLE} =~ /peon/i } @employees; @tsevens = grер { $_->{AGE} == 27 } @employees;

Каждый элемент @peons и @tsevens представляет собой ссылку на запись, поэтому они, как и @employees, являются массивами хэшей. Вывод записей в определенном порядке (например, по возрасту) выполняется так:
# Перебрать все записи foreach
$rp (sort { $a->{AGE} <=> $b->{AGE} } values %byname) {
printf "%s is age %d.\n", $rp->{NAME}, $rp->{AGE};
# или со срезом хэша через ссылку
printf "%s is employee number %d,\n", @$rp{'NAME','EMPNO'};
}

Вместо того чтобы тратить время на сортировку по возрасту, можно просто создать для этих записей другое представление, @byage. Каждый элемент м:', riii!:i (например, $byage[27]) является массивом всех записей с данным возрш ";ом, Фактически мы получаем массив массивов хэшей. Он строится так:
# Используем @byage, массив массивов записей
push @{ $byage[ $record->{AGE} ] }, $record:
Далее отбор осуществляется следующим образом:
for ($age = 0; $age <= $#byage; $age++)
{ next unless $byage[$age], print "Age Sage: ";
foreach $rp (@{$byage[$age]}) { print $rp->{NAME}, " ";
} print "\n";

Аналогичное решение заключается в применении map, что позволяет избежать цикла foreach:
for ($age = 0; $age <= $#byage; $age++) {
next unless $byage[$age];
printf "Age %d: %s\n", Sage,
join(", ", map {$_->{NAME}} @{$byage[$age]});
}


> Смотри также -Рецепты 4.13; 11.3.

11.10. Чтение и сохранение записей $ текстовых файлах

Проблема

Требуется прочитать или сохранить хэш записи в текстовом файле.

Решение

Воспользуйтесь простым форматом, при котором каждое поле занимает отдельную строку вида: ИмяПоля: Значение и разделяйте записи пустыми строками.

Kомментарий

Если у вас имеется массив записей, которые должны сохраняться в текстовом файле и читаться из него, воспользуйтесь простым форматом, основанным на заголовках почтовых сообщений. Из-за простоты формата ключи не могут быть двоеточиями и переводами строк, а значения - переводами строк. Следующий фрагмент записывает данные в файл:
foreach $record (@Array_of_Records) { for $key (sort keys %$record) {
print "$key: $record->{$key}\n";
} print "\n":
Прочитать записи из файла тоже несложно:
$/=""; # Режим чтения абзацев
while (<>) {
my @fields = { split /"([":]+):\s*/m };
shift @fields; # Удалить начальное пустое поле
push(@Array_of_Records, { (@fields });
}

Функция split работает с $_, своим вторым аргументом по умолчанию, в кч' ром находится прочитанный абзац. Шаблон ищет начало строки (не просто n;i ло записи благодаря /т), за которым следует один или более символов, не являющихся двоеточиями, затем двоеточие и необязательный пропуск. Если шаб.чон split содержит скобки, они возвращаются вместе со значениями. Возвращаемые значения заносятся в Ofileds в порядке "ключ/значение"; пустое поле в нач: убирается. Фигурные скобки в вызове push создают ссылку на новый анонимн хэш, куда копируется содержимое #fields. Поскольку в массиве сохранился по, док "ключ/значение", мы получаем правильно упорядоченное содержимое x;)i Все происходящее сводится к операциям чтения и записи простого текстовою файла, поэтому вы можете воспользоваться другими рецептами. Рецепт 7.11 поможет правильно организовать параллельный доступ. В рецепте 1.13 рассказано о сохранении в ключах и значениях двоеточий и переводов строк, а в рецепте 11.3 -о сохранении более сложных структур. Если вы готовы пожертвовать элегантностью простого текстового файла в пользу быстрой базы данных с произвольным доступом, воспользуйтесь DBM-фай-лом (см. рецепт 11.14).

> Смотри также ------------------------------
Описание функции split в perlfunc(1) рецепты 11.9, 11.13-11.14.

11.11. Вывод структур данных

Проблема

Требуется вывести содержимое структуры данных.

Решение

Если важна наглядность вывода, напишите нестандартную процедуру вывода. В отладчике Perl воспользуйтесь командой х:
DB<1> $reference = [ { "too" => "bar" }, 3,
sub { print "hello, world\n" } ]; DB<2> x Sreference
0 ARRAY(Ox1d033c)
0 HASH(Ox7b390)
'foo' = 'bar'>
1 3
2 CODE(Ox21e3e4) - & in ???>

В программе воспользуйтесь функцией Dumper модуля Data::Dumper от CPAN:
use Data::Dumper;
print Dumper($reference);

Комментарий

Иногда для вывода структур данных в определенном формате пишутся специальные функции, но это часто оказывается перебором. В отладчике Perl существуют команды х и X, обеспечивающие симпатичный вывод. Команда х полезнее, поскольку она работает с глобальными и лексическими переменными, а X - только с глобальными. Передайте х ссылку на выводимую структуру данных.
D<1> x \@INC
О ARRAY(Ox807dOa8)
О '/nome/tchrist/perllib'
1 'usr/lib/perl5/i686-linux/5.00403'
2 '/usr/lib/perl5'
3 'usr/lib/perl5/site_perl/i686-linux'
4 '/usr/lib/perl5/site_perl'
5 '.'

Эти команды используют библиотеку dumpvar.pl. Рассмотрим пример: { package main; require "dumpvar.pl" }
*dumpvar = \&main::dumpvar if _ _package_ _ ne 'main';
dumpvar("main", "INC"); # Выводит и @INC, и %INC

Библиотека dumpvar.pl не является модулем, но мы хотим использовать ее как модуль и поэтому заставляем импортировать функцию dumpvar. Первые две строки форсируют импортирование функции main: :dumpvar из пакета main в текущий пакет, предполагая, что эти функции отличаются. Выходные данные будут выглядеть так:
@INC = (
О '/home/tenrist/perllib/i686-linux'
1 '/home/tchrist/perllib'
2 'usr/lib/perl5/i686-linux/5.00404'
3 'usr/lib/perl5'
4 'usr/lib/perl5/site_perl/i686-linux"
5 'usr/lib/perl5/site_perl'
6 ' . '
}
%INC = (
'dumpvar.pl' = 'usr/lib/perl5/i686-linux/5.00404/dumpvar.pi'
'strict.pm' = 'usr/lib/perl5/i686-linux/5.00404/strict.pm'
)

Модуль Data::Dumper, доступный на СРАМ, предоставляет более гибкое решение. Входящая в него функция Dumper получает список ссылок и возвращает строку с выводимой (и пригодной для eval) формой этих ссылок.
use Data::Dumper;
print Duniper(\@INC);
$VAR1 = [
'/home/tchrist/perllib',
'/usr/lib/perl5/i686-linux/5.00403',
'/usr/lib/perl5',
'/usr/lib/perl5/site_perl/i686-linux',
'/usr/lib/perl5/site_perl',
];

Data::Dumper поддерживает разнообразные форматы вывода. За подробностями обращайтесь к документации.

> Смотри также -------------------------------
Документация по модулю Data::Dumper с CPAN; раздел "The Perl Debugger perldebug(1).

11.12. Копирование структуры данных

Проблема

Требуется скопировать сложную структуру данных.

Решение

Воспользуйтесь функцией dclone модуля Storable от CPAN:
use Storable;
$r2 = dclone($r1);

Комментарий

Существуют два типа копирования, которые иногда путают. Поверхностно ' пирование (surface copy) ограничивается копированием ссылок без создания копии данных, на которые они ссылаются:
@original = ( \@а, \@b, \@>с );
@surface = @origlnal;

Глубокое копирование (deep copy) создает абсолютно новую структуру без перскры-вающихся ссылок. Следующий фрагмент копирует ссылки на один уровень вглубь:
@deep = map { [ @$_ ] } @original;
Если переменные @а, @b и @с сами содержат ссылки, вызов-тар не решит i.a'x проблем. Написание специального кода для глубокого копирования структур -дело трудоемкое и быстро надоедающее. Модуль Storable, доступный на CPAN, содержит функцию dclone, которая обеспечивает рекурсивное копирование своего аргумента:
use Storable qw(dclone);
$r2= dclone($r1);
Функция работает только со ссылками или приписанными к конкретному пакету (blessed) объектами типа SCALAR, ARRAY и HASH; ссылки на CODE, GLOB и 10 и другие экзотические типы не поддерживаются. Функция safeFreeze модуля FreezeThaw обеспечивает такую возможность для одного адресного пространства посредством использования кэша ссылок, который при некоторых обстоятельствах вмешивается в процесс сборки мусора и работу деструкторов объектов. Поскольку dclone принимает и возвращает ссылки, при копировании хэша ссылок в нее приходится включать дополнительные символы:
%newhash = %{ dclone(\%oldhash) };


> Смотри также
Документация по модулям Storable, Data::Dumper и FreezeThaw с CPAN.

11.13. Сохранение структур данных на диске

Проблема

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

Решение

Воспользуйтесь функциями store и retrieve модуля Storable с CPAN:
use Storable;
store(\%hash, "filename");
# later on...
$href = retrieve("filename"); # По ссылке
%hash = %{ retrieve("filename") }; # Прямо в хэш

Комментарий

Модуль Storable использует функции С и двоичный формат для обхода внутренних структур данных Perl и описания данных. По сравнению со строковой реализацией сохранения записей в Perl такой вариант работает эффективнее, однако он менее надежен. Функции store и retrieve предполагают, что в передаваемых двоичных данных используется порядок байтов, стандартный для данного компьютера. Это означает, что созданные этими функциями файлы нельзя передавать между различными архитектурами. Функция nstore делает то же, что и store, но сохраняет данные в каноническом (сетевом) порядке. Быстродействие при этом несколько снижается:
use Storable qw(nstore);
nstore(\%hash, "filename");
# Позднее
$href = retrieve("filename");
Независимо от того, какая функция сохраняла данные - store или nstore, для их восстановления в памяти используется одна и та же функция ret rieve. О переносимости должен заботиться создатель данных, а не их потребитель. Если создатель изменит свое решение, ему достаточно изменить программу всего в одном месте. Тем самым обеспечивается последовательный интерфейс со стороны потребителя, который ничего не знает об этих изменениях. Функции store и nstore не блокируют файлы, с которыми они работают. Если вас беспокоят проблемы параллельного доступа, откройте файл самостоятельно, заблокируйте его (см. рецепт 7.11) и воспользуйтесь функцией store_fd или более медленной, но независимой от платформы версией, nstore_fd. Следующий фрагмент сохраняет хэш в файле с установкой блокировки. При открытии файла не используется флаг O.TRUNC, поскольку до стирания содержимого нам приходится ждать получения блокировки.
use Storable qw(nstore_fd);
use Fcnti qw(:DEFAULT :flock);
sysopen(DF, "/tmp/datafile", 0_RDWR|0_CREAT, 0666)
or die "can't open /tmp/datafile: $!";
flock(DF, LOCK_EX) or die "can't lock /tmp/datafile: $!";
nstore_fd(\%hash, *DF)
or die "can't store hash\n";
truncate(DF, tell(DF));
close(DF);

Другой фрагмент восстанавливает хэш из файла, также с применением блокировки:
use Storable;
use Fcnti qw(:DEFAULT :flock);
open(DF, "< /tmp/datafile") or die "can't open /tmp/datafile: $!";
flock(DF, LOCK_SH) or die "can't lock /tmp/datafile: $!";
$href = retrieve(*df);
close(DF);

Внимательное применение этой стратегии позволяет эффективно передавать большие объекты данных между процессами, поскольку файловый манипулятор канала или сокета представляет собой байтовый поток, похожий на обычный фжч. В отличие от связей с различными реализациями DBM, модуль Storable не ограничивается одними хэшами (или массивами, как DB_File). На диске могут сохраняться произвольные структуры данных. Вся структура должна читаться или записываться полностью.

> Смотри также -------------------------------
Рецепт 11.14.

11.14. Устойчивые структуры данных

Проблема

Существует сложная структура данных, которую требуется сделать устойчивой (persistent)'.

Решение

Воспользуйтесь модулем MLDBM и либо DB_File (предпочтительно), либо GDBM_File:
use MLDBM qw(DB_File);
use Fcnti;
tie(%hash, 'MLDBM', 'testfile.db', 0_CREAT|0_RDWR, 0666)
or die "can't open tie to testfile.db: $!";
# ... Операции с %hash untie %hash;

Комментарий

Конечно, построение хэша из 100000 элементов займет немало времени. Сохранение его на диске (вручную или с помощью Storable) также потребует немалых расходов памяти и вычислительных ресурсов. Модули DBM решают эту проблему посредством связывания хэшей с файлами баз данных на диске. Вместо того чтобы читать всю структуру сразу, они извлекают данные лишь при необходимости. Для пользователя все выглядит так, словно состояние хэша сохраняется между вызовами программы. К сожалению, значения устойчивого хэша должны представлять собой простые строки. Вам не удастся легко использовать базу данных для хранения хэша хэшей, хэша массивов и т. д. - только хэши строк. Однако модуль MLDBM с CPAN позволяет сохранять ссылки в базе данных. Преобразование ссылок в строки для внешнего хранения осуществляется с помощью Data::Dumper:
use MLDBM qw(DB_File);
use Fcnti;
tie(%hash, 'MLDBM', otestfile.db', 0_CREAT|0_RDWR, 0666)
or die "can't open tie to
testfile.db: $!";

Теперь %hash может использоваться для выборки или сохранения сложных записей на диске. Единственный недостаток заключается в том, что к ссылкам нельзя обращаться напрямую. Приходится извлекать ссылку из базы, работать с ней, а затем снова сохранять в базе.
# He будет работать!
$hash{"some key"}[4] = "fred";
Термин "устойчивость" означает сохранение состояния между запусками программы. Также встреча-'oя термин "перманентность". - Примеч. перев.
# ПРАВИЛЬНО
$aref = $hash{"some key"};
$aref->[4] = "fred";
$hash{"some key"} = $aref;


> Смотри также ------
Документация по модулю MLDBM с СРАМ; рецепты 14.1; 14.7; 14.11.

11.15. Программа: бинарные деревья

Встроенные типы данных Perl представляют собой мощные, динамические структуры. В большинстве программ этих стандартных возможностей оказывается вполне достаточно. Для выполнения простого поиска почти всегда следует использовать простые хэши. Как выразился Ларри, "Весь фокус в том, чтобы использовать сильные, а не слабые стороны Perl". Однако хэши не обладают внутренним упорядочиванием элементов. Чтобы перебрать элементы хэша в определенном порядке, необходимо сначала извлечь ключи, а затем отсортировать их. При многократном выполнении это может отразиться на быстродействии программы, что, однако, вряд ли оправдывает затраты времени на разработку хитроумного алгоритма. Древовидные структуры обеспечивают упорядоченный перебор. Как реализовать дерево на Perl? Для начала загляните в свой любимый учебник по структурам данных. Воспользуйтесь анонимным хэшем для представления каждого узла дерева и переведите алгоритмы, изложенные в книге, на Perl. Обычно это задача оказывается проще, чем кажется. Программа в примере 11.1 демонстрирует простую реализацию бинарного дерс--ва, построенную на базе анонимных хэшей. Каждый узел состоит из трех полеи: левый потомок, правый потомок и значение. Важнейшее свойство упорядоченных бинарных деревьев заключается в том, что значение левого потомка всегда меньше, чем значение текущего узла, а значение правого потомка всегда больше. Основная программа выполняет три операции. Сначала она создает дерево с 20 случайными узлами, затем выводит три варианта обхода узлов дерева и, наконец, запрашивает у пользователя ключ и сообщает, присутствует ли этот ключ в дереве. Функция insert использует механизм неявной передачи скаляров по ссылке для инициализации пустого дерева при вставке пустого узла. Присваивание $_[0] созданного узла приводит к изменению значения на вызывающей стороне. Хотя такая структура данных занимает гораздо больше памяти, чем простой хэш, и обычный перебор элементов в пей происходит медленнее, упорядоченные перемещения выполняются быстрее. Исходный текст программы приведен в примере 11.1. Пример 11.1. bintree
#!/usr/bin/perl -w
# bintree - пример работы с бинарным деревом
use strict;
my($root, $n);
# Сгенерировать 20 случайных узлов
while ($n++ < 20) { insert($root, int(rand(1000)) }
Вывести узлы дерева в трех разных порядках
print "Pre order: "; pre_order($root); print "\n";
print "In order: "; in_order($root); print "\n";
print "Post order: ": post_order($root); print "\n":
# Запрашивав до получения EOF
for (print "Search? "; <>; print "Search? ") {
chomp;
my $found = search($root, $_);
if ($found) { print "Found $_ at $found, $found->{VALUE}\n" }
else { print "No $_ in tree\n" }
}
exit;
# Функция вставляет передаваемое значение в правильную позицию
# передаваемого дерева. Если дерево не передается,
# для @_ используется механизм косвенной передачи по ссылке,
# что приводит к созданию дерева на вызывающей стороне.
sub insert {
my($tree, $value) = @_;
unless ($tree) {
$tree = {}; # Создать новый узел
$tree->{VALUE} = $value;
$tree->{LEFT} = undef;
$tree->{RIGHT} = undef;
$_[0] = $tree; # $_[0] - ссылочный параметр!
return;
}
if ($tree->{VALUE} > $value) {
insert($tree->{LEFT}, $value) }
elsif ($tree->{VALUE} < $value)
{ insert($tree->{RIGHT}, $value) } else
{ warn "dup insert of $value\n" }
# XXX: узлы не должны повторяться
}
# Рекурсия по левому потомку,
вывод текущего значения
и рекурсия по правому потомку.
sub in_order {
my($tree) = @>_;
return unless $tree;
in_order($tree->{LEFT});
print $tree->{VALUE}, " ";
in_order($tree->{RIGHT});
}
# Вывод текущего значения,
# рекурсия по левому потомку " и рекурсия по правому потомку,
sub pre_order { my($tree) = @_;
return unless $tree;
print $tree->{VALUE}, " ";
pre_order($tree->{LEFT});
pre_order($tree->{RIGHT});
}
# Рекурсия по левому потомку,
# рекурсия по правому потомку
# и вывод текущего значения,
sub post_order { my($tree) = @_;
return unless $tree;
post_order($tree->{LEFT});
post_order($tree->{RIGHT});
print $tree->{VALUE}, " ";
}
# Функция определяет, присутствует ли передаваемое значение в дереве.
# Если значение присутствует, функция возвращает соответствующий узел.
# Поиск ускоряется за счет ограничения перебора нужной ветвью.
sub search {
my($tree, $value) = @>_;
return unless $tree;
if ($tree->{VALUE} == $value) { return $tree;
}
search($tree->{ ($value < $tree->{VALUE}) '? "LEFT" : "RIGHT"}, $value)
}


Назад
Вперед