($user, $gid, $gcos) = @pw[0,3,6]; {$real) = split /,/, $gcos; $real($user) = $real; $members{$gid) .= " $user"; {$last) = (split /\s + /, $real)[-l],-$last{$user) = "\L$last";

while (@gr = getgrent) {

($gname,$gid,$members) = @gr[0,2,3],• $members{$gid) .= " $members"; $gname{$gid) = $gname;

for $gid (sort by gname keys %gname) { %all = 0 ;

for (split(/\s+/, $members{$gid))) { $alH$ )++ if length $ ;

(members = () ;

foreach (sort by last keys %all) { push(Smembers, "$real{$ ) ($ )");

$memberlist = join(", ", @merabers); write;

sub by gname { $gname{$a) cmp $gname{$b}; )

sub by last ( ($last{a) cmp $last{$b)) I I ($a cmp $b); )

format STDOUT =

@«««<< @<«««< "««««««««««««««««««< $gname{$gid), "($gid)", $memberlist

"<<«<<<<«<<«««<<«<<<<«<<««<<<

$memberlist

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

Глава 17 Работа с пользовательскими базами данных**

I. Вот один из способов решения этой задачи:

dbmopen(%ALIAS, "/etc/aliases", undef) II

die "No aliases: $"; while ( ($key, $value) = each (%ALIAS) ) {

chop ($key, $value) ;

print "$key $value\n";

Первая строка открывает DBM псевдонимов. (В вашей системе DBM псевдонимов может находиться в каталоге /usr/lib/aliases - попробуйте этот вариант, если наш не сработает.) В цикле while осушествляется проход по DBM-массиву. Первая строка цикла служит для удаления символа NUL, которым завершались ключ и значение. Последняя строка цикла обеспечивает вывод результата.

2. Вот один из способов решения этой задачи:

# program 1:

dbmopen{%WORDS, "words", 0644) ; while (<>) {

foreach $word (split{/\W+/)) { $WORDS{ Sword)++;

dbmclose(%WORDS) ;

Первая программа (записываюшая) открывает DBM words в текущем каталоге, создавая файлы words.dir и words.pag. Цикл while получает каждую строку, используя операцию "ромб". Эта строка разбивается с помощью операции split и разделителя /\w+/, который обозначает нетекстовые символы. Затем производится подсчет всех слов, имеющихся в DBM-массиве, причем для осуществления прохода в цикле по всем словам используется оператор foreach.

# program 2:

dbmopen(%WORDS, "words",undef);

foreach $word (sort { $WORDS{$b} <=> $WORDS{$a} } keys %WORDS) { print "$word $WORDS{$word}\n";

dbmclose(%WORDS);

Вторая программа также открывает DBM words в текущем каталоге. Сложная на первый взгляд строка foreach делает почти всю "грязную" работу. При каждом выполнении цикла переменной $word в качестве значения будет присваиваться следующий элемент списка. Этот список состоит из ключей хеша % WORDS, рассортированных по их значениям (т.е. количеству повторений) в убывающем порядке. Для каждого элемента списка мы выводим слово и количество его повторений.

Глава 18 "Преобразование других программ в Perl-программы

1. Вот один из способов решения этой задачи:

for (;;) {

($user,$home) = (getpwent)[О,7]; last unless $user;

next unless open(N,"$home/.newsrc") ;

next unless -M N < 30; ## added value :-)

while (<N>) {

if (/comp\.lang\.perl\.announce:/) { print "$user is a good person, ", "and reads сотр.lang.perl.announce\n"); last;

Самый внешний цикл - это цикл for, который выполняется "вечно"; выход из этого цикла осушествляется посредством операции last, стоя-шей внугри него. При каждом выполнении цикла операция getpwent выбирает новое значение переменной $user (имя пользователя) и переменной $home (его начальный каталог).

Если значение $user пусто, осуществляется выход из цикла for. Следующие две строки ищут последний файл .newsrc в начальном каталоге пользователя. Если этот файл открыть нельзя или если он изменялся слишком давно, запускается следующая итерация цикла for.

В цикле while осуществляется чтение по одной строке из файла .newsrc. Если строка начинается с comp.lang.perl.announce:, то оператор print сообщает об этом, и осуществляется преждевременный выход из цикла

while.

Глава 19 CGI-программирование"

1. Вот один из способов рещения этой задачи:

use strict;

use CGI qw(:standard);

print header{), start html("Add Me"); print hi("Add Me"); if(param()) {

my $nl = param(fieldl) ;

my $n2 = param(field2) ;

my $n3 = $n2 + $nl;

print p("$nl + $n2 = <strong>$n3</strong>\n"); ) else {

print hr(), start form() ;

print p("First Number:", textfield("fieldl")); print p("Second Number:", textfield("field2")); print p(submit("add"), reset{"clear")); print end form(), hr();

print end html();