while (О) {

select(undef, undef undef, О 25) print,

С помощью Time::HiRes это делается так:

use Time HiRes qw(sleep) while (О) {

sleep(0 25)

print,

> Смотри также-

Документация по модулям Time.:HiRes п ВепсЬМагк с CPAN; описаине функ-цпп sleep и select вperlfunc{{). Функция select нспользована для оргапн.ча-ции короткой задержки в программе slowcat из рецепта 1.5.

3.11. Программа: hopdelta

Вы никогда не задавались вопросом, почему какое-нибудь важное ппсь.мо так долго добиралось до вас? Обычная почта iie позволит узнать, как долго вапш письмо пылилось на полках всех промежуточных почтовых отделении. Однако в элскгропной почте такая возможность имеется. В заголовке сообщегиш присутствует строка Received: с ипформацнсй о том, когда сообще]П1е было получено каждым промежуточным транспортным агентом.

В1)емя в заголовках воспринимается плохо. Его пр]1Ходнтся читать в обратном направлении, снизу вверх. Оно записывается в разных форматах по прихоти каждого транспорт]1ого агента. Но хуже всего то, что каждое в])емя регистрируется в своем часовом поясе. Взглянув па строки "Tue, 26 May 1998 23 57.38 -0400" н "Wed, 27 May 1998 05.04.03 +0100", вы в])яд лп сразу поймете, что эти два момента разделяют всего G минут 25 секунд.

На помощь приходят функции ParseDate и DateCalc модуля Date::Manip от CPAN;

use Date Manip qw(ParseDate DateCalc)

$d1 = ParseDate( Tue, 26 May 1998 23 57 38 -0400 ),

$d2 = ParseDate( Wed, 27 May 1998 05 04 03 +0100 ),

print DateCalc($d1, $d2),

+0:0.0:0:0:6:25

Возможно, с такими данными удобно работать программе, но пользователь все же предпочтет что-нибудь более привычное. Программа hopdelta из примера 3.1 получает заголовок сообщещш и пытается проа]1£ии1зировать дельты (разности) между промежуточными остановками. Результаты выводятся для местного часового пояса.

Пример 1.3. hopdelta

ft /usr/bm/perl

# hopdelta - no заголовку почтового сообщения выдает сведения

3.11. Программа; hopdelta 111

# о задержке почты на каждом промежуточном участке use strict

use Date Manip qw (ParseDate UnixDate),

# Заголовок печати, из-за сложностей printf следовало

# бы использовать format/write

printf %-20 20s %-20 20s %-20 20s %s\n ,

Sender , Recipient , Time , Delta , $/ = , # Режим абзаца

$ = о # Читать заголовок

s/\n\s+/ /д, # Объединить строки продолжения

# Вычислить, когда и где начался маршрут сообщения my($start fгот) = /"From A@(["\s>]*)/m, my($start date) = /"Date \s+( .)/m,

my $then = getdate($start date),

printf %-20 20s %-20 20s %s\n , Start , $start from, fmtdate($then) my Sprevfrom = $start from

# Обрабатывать строки заголовка снизу вверх for (reverse split(/\n/)) {

my ($delta, $now, $from, $by, $when), next unless /"Received /

s/\bon ( .) (id *)/, $1/s, n Кажется, заголовок qmail

unless (($when) = / \s+( *)$/) { « where the date falls

warn bad received line $ ,

next

($from) = /from\s+(\S+)/,

($from) = /\(( «)\)/ unless $from # Иногда встречается

Sfrom =" s/\)$ , tt Кто-то пожадничал

($by) = /by\s+(\S+\ \S+)/ tt Отправитель для данного участка

# Операции, приводящие строку к анализируемому формату for (Swhen) {

s/ (forlvia) .$ ,

s/([+-]\d\d\d\d) \(\S+\)/$1/,

s/id \S+,\s. ,

next unless $now = getdate($when), tt Перевести в секунды

tt с начала эпохи

$delta = $now - $then,

printf %-20 20s %-20 20s %s , $from, $by, fmtdate($now), Sprevfrom = $by puttime($delta), $then = $now,

exit,

продолжение

11? Глава 3 • Дата и время Пример 1.3 (продолжение)

# Преобразовать произвольные строки времени в секунды с начала эпохи sub getdate {

my Sstring = shift,

Sstring =" s/\s+\( *\)\s$ , # Убрать нестандаргные

# терминаторы

my Sdate = ParseDate($string)

my $epoch secs = UnixDate($date %s ), return $epoch secs.

# Преобразовать секунды с начала эпохи в строку определенного формата sub fmtdate {

my Sepoch = shift,

my($sec,Smin,Shour,$mday,Sraon, Syear) = localtime($epoch), return sprintf %02d %02d %02d %04d/%02d/%02d

Shour, $min, Ssec,

Syear + 1900, Smon + 1, Smday,

# Преобразовать секунды в удобочитаемый формат sub puttime {

fny($s6conds) = shift,

my($days, Shours, Sminutes),

Sdays = pull count($seconds 24 ♦ 60 « 60),

Shours = pull count(Sseconds 60 - 60),

Sminutes = pull count($seconds 60)

put field(s Sseconds),

put field(nV , Sminutes)

put field(h , Shours),

put field(d, Sdays)

print \n ,

tt Применение Scount = pull count(seconds, amount)

tt Удалить из seconds величину amount изменить версию вызывающей

# стороны и вернуть число удалений

sub pull count {

my(Sanswer) = int{$ [0] / S [1]),

S [0] -= Sanswer - S [1],

return Sanswer,

tt Применение put field(char, number)

tt Вывести числовое поле в десятичном формате с 3 разрядами и суффиксом char « Выводить лишь для секунд (char == s ) sub put field {

my (Schar, Snumber) = @ ,