Глава 3 Дата и время

3.6. Определение номера недели или дня недели/месяца/года

Проблема

Решение

$wday = Day_of_Week($year, $month, $day);
$wnum = Week_Number($year, $month, $day);
$dnum = Day_of_Year($year, $month, $day);

Комментарий

use Date::Calc qw(Day_of_Week Week_Number);
$year = 1981;
Smonth =6; # (Июнь) $day = 16;
(Mays = qw:Error Monday Tuesday Wednesday Thursday Friday Saturday. Sunday::
$wday = Day_of_Week($year, $month, $day);
print "$month/$day/$year was a $days[$wday]\n";
$wnum = Week_Number($year, $month, $day):
print "in the $wnum week.\n";

6/16/1981 was a Tuesday in the 25 week

В некоторых странах существуют специальные стандарты, касающиеся первой недели года. Например, в Норвегии первая неделя должна содержать не менее 4 дней (и начинаться с понедельника). Если 1 января выпадает на неделю из 3 и менее дней, она считается 52 или 53 неделей предыдущего года. В Америке первая рабочая неделя обычно начинается с первого понедельника года. Возможно, при таких правилах вам придется написать собственный алгоритм или по крайней мере изучить форматы %G, %L, %W и %U функции UnixDate модуля Date::Manip.

> Смотри также -------------------------------- Описание функции localtime в perlfunc(1); документация но стандартному модулю Date::Calc от CPAN.

3.7. Анализ даты и времени в строках

Проблема

Решение

use Time::Local:
# $date хранится в формате "1999-06-03" (ГГГГ-ММ-ДД). ($yyyy, $mm, $dd) = ($date =~
/(\d+)-(\d+)-(\d+)/;
# Вычислить секунды с начала эпохи для полночи указанного дня
# в текущем часовом поясе
$epoch_seconds = timelocal(0, О, О, $dd, $mm, $yyyy);

Более гибкое решение - применение функции ParseDate из модуля Date::Manip с CPAN и последующее извлечение отдельных компонентов с помощью UnixDate.
use Date::Manip qw(ParseDate UnixDate);
$date = ParseDate($STRING);
if (!$date) <
# Неверная дата
} else {
@VALUES = Unix0ate($date, @FORMATS);
}

Комментарий

use Date::Manip qw(ParseDate UnixDate);
while (<>) {
$date = ParseDate($_);
if (!$date) {
warn "Bad date string: $_\n";
next;
} else {
($year, $month, $day) = Unix0ate($date, "%Y", "%m", "%d");
print "Date was $month/$day/$year\n";
}
}

> Смотри также ------------------------------- Документация для модуля Date::Manip с CPAN; пример использования приведен в рецепте 3.11.

3.8. Вывод даты

Проблема

Решение

$STRING = localtime($EPOCH_SECONDS);
Кроме того, (рункция strftime из стандартного модуля POSIX позволяет луч ше настроить срормат вывода п работает с отдельными компонентами полного времени:

use POSIX qw(strftime);
$STRING = strftlme($FORMAT, $SECONDS, $MINUTES, $HOUR,
$DAY_OF_MONTH, $MONTH, $YEAR, $WEEKDAY,
$YEARDAY, $DST);

В модуле Date::Manip с CPAN есть функция UnixDate - нечто вроде специализированного варианта spnntf, предназначенного для работы с датами. Ей передается дата в формате Date::Manip. Применение Date::Manip вместо POSIX::strftim( имеет дополнительное преимущество, так как для этого от системы не требуется совместимость с POSIX.

use Date::Manip qw(UnixDate);
$STRING = UnixDate($DATE, $FORMAT);

Комментарий

use Time::Local;
$time = timelocal(50, 45, 3, 18, 0, 73),
print "Scalar localtime gives: ", scalar(localtimc($time)), "\n";
Scalar localtime gives: Thu Jan 18 03:45:50 1973

Разумеется, дата н время для localtime должны исчисляться в секундах с начала эпохи. Функция POSIX: :strftime получает набор компонентов полного времени н форматную строку, аналогичную orintf, н возвращает также строку. Поля в выходной строке задаются директивами %. Полный список директив приведен в документации но strftime для Bauicii системы. Функция strftime ожидает, что отдельные компоненты даты/времени принадлежат тем же интервалам, что н значения, возвращаемые localtime:

use POSIX qw(strftime);
use Time::Local;
$time = timelocal(50, 45, 3, 18, 0, 73);
print "Scalar localtime gives: ", scalar(localtime($time)), "\n";
Scalar localtime gives; Thu Jan 18 03:45:50 1973

Разумеется, дата и время для localtime должны исчисляться в секундах с нача-;i;i :)IIOXH. Функция POSIX: : strftime получает набор компонентов полного времени и форматную строку, аналогичную pr -intf, н возвращает также строку. Поля в выходнон строке задаются директивами %. Полный список директив приведен в документации по strftime для вашей системы. Функция strftime ожидает, что отдельные компоненты даты/времени принадлежат тем же интервалам, что и значения, возвращаемые localtime:

use POSIX qw(strftime);
use Time::Local;
$time = timelocal(50, 45, 3, 18, 0, 73);
print "strftime gives: ", strftime("%A %D", localtime($time)), "\n";
strftime gives: Thursday 01/18/73

При использовании POSIX: : strftime все значения выводятся в соответствии с национальными стандартами. Так, во Франции ваша программа вместо "Sunday" выведет "Dimanche". Однако учтите: интерфейс Perl к функции strftime модуля POSIX всегда преобразует дату в предположении, что она относится к текущему часовому поясу. Если функция strftime модуля POSIX недоступна, у вас всегда остается верный модуль Date::Manip, описанный в рецепте 3.6.

use Date::Manip qw(ParseDate UnixDate);
$date = ParseDate("18 Jan 1973, 3:45:50"):
$datestr = UnixDate($date, "%a %b %e %H:%M:%S %z %Y"); # скалярный контекст print
"Date::Manip gives: $datestr\n":
Date::Manip gives: Thu Jan 18 03:45:50 GMT 1973

[> Смотри также ------------------------------- Описание функции gmtime и localtime в perlfunc(1); perllocate(1); man-странице strfrime(3) вашей системы; документация по модулям POSIX и Date::Manip cCPAN.

3.9. Таймеры высокого разрешения

Проблема

Решение

use Time::HiRes qw(gettimeofday);
$t0 = gettimeorday; # Ваши операции
$t1 = gettuneofday;
$elapsed = $t1 - $t0;
# $elapsed - значение с плавающей точкой, равное числу секунд Я между $t1 и $t2

Комментарий

use Time::HiRes qw(gettimeofday);
print "Press return when ready: ";
Sbefore = gettimeofday:
$line = <>;
$elapsed = gettimeofday-$before;
print "You took $elapsed seconds.\n";
Press return when ready:
You took 0.228149 seconds.

Сравните с эквивалентным фрагментом, использующим syscall:
require 'sys/syscall. ph'; # Инициализировать структуры, возвращаемые gettimeofday $TIMEVAL_T = "LL";
$done = $start = pack($TIMEVAL_T, ());
# Вывод приглашения print "Press return when ready: ";
# Прочитать время в
$start syscall(&SYS_getti(neofday, $start, 0)) != -1 | | die "gettimeofday: $!";
# Прочитать перевод строки $
line = о;
# Прочитать время в
$done syscall(&SYS_gettimeofday, $done, 0) != -1 || die "gettimeofday: $!";
# Распаковать структуру @>start = unpack($TIMEVAL_T, $start);
@done = unpack($TIMEVAL_T, $done);
# Исправить микросекунды
for ($done[1], $start[1]) { $_ /= 1_000_000 }
# Вычислить разность $delta_time = sprintf "%.4f", ($done[0] + $done[1] )
($start[0j + $start[1] );
print "That took $delta_time seconds\n";

Press return when ready;
That took 0.3037 seconds Программа получилась более длинной, поскольку системные функции вызываются непосредственно из Pcrl, а в Time::HiRes они реализованы одной функцией С. К тому же она стала сложнее - для вызова специфических функций операционной системы необходимо хорошо разбираться в структурах С, которые передаются системе и возвращаются ей. Некоторые программы, входящие в поставку Perl, пытаются автоматически определить форматы pack и unpack no заголовочному файлу С. В нашем примере sys/syscall.ph - библиотечный 4)айл Perl, сгенерированный утилитой h2ph, которая преобразует заголовочный файл sys/ syscall.h в sys/syscall.ph. В частности, в нем определена функция &SYS_gettimeofday, возвращающая номер системного вызова для gettimeofday. Следующий пример показывает, как использовать Time::HiRes для измерения временных характеристик:
use Time::HiRes qw(gettimeofday);
# Вычислить среднее время сортировки
$size = 500;
$number_of_times = 100;
$total_time = 0;
for ($i =0; $i < number_of_times; $i++) { my (@array, $j, $begin, $time);
# Заполнить массив @>array =();
for ($j=0; $j<$size;$j++) { push(@array, rand)
# Выполнить сортировку
$begln = gettimeofday;
@array = sort { $a <=> $b } @array;
$time = gettimeofday=$t1;
$total time += $time;
}
printf "On average, sorting %d random numbers takes %5.f seconds\n", $size,
($total_time/$number_of_times):
On average, sorting 500 random numbers takes 0.02821 seconds

> Смотри также -------------------------------- Документация по модулям Time::HiRes и BenchMark с CPAN; описание функции syscall в perlfunc(1); man-страница syscall{2).

3.10. Короткие задержки

Проблема

Решение

use Time::HiRes qw(sleep);
sleep($time_to_sleep);

Комментарий

while (<>) {
select(undef, undef, undef, 0.25);
print;
}

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

use Time::HiRes qw(sleep);
while (<>) { sleep(0.25);
print:
}

> Смотри также Документация по модулям Time::HiRes и BenchMark с CPAN; описание функций sleep и select Qperlfunc(1). Функция select использована для организации короткой задержки в программе slowcat из рецепта 1.5.

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

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.3. hopdelta

#!/usr/bin/perl
# hopdelta - по заголовку почтового сообщения выдает сведения
# о задержке почты на каждом промежуточном участке. use strict; vuse Date::Manip qw (ParseDate UnixDate);
# Заголовок печати; из-за сложностей pnntf следовало
# бы использовать format/write
printf "%-20.20s %-20.20s %-20.20s %s\n",
"Sender", "Recipient", "Time", "Delta";
$/=''; # Режим абзаца
$_ = о; # Читать заголовок
s/\n\s+/ /n: # Объединить строки прплппжения
# Вычислить, когда и где начался маршру? сооищении
my($start_from) = /"From,*\@(["\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 $prevfrom = $start_from;
# Обрабатывать строки заголовка снизу вверх
for (reverse split(/\n/)) {
my ($delta, $now, $from, $by, $when);
next unless /"Received:/;
s/\bon (.*?) (id.*)/; $1/s; # Кажется, заголовок qmail unless (($when) = /;\s+(.")$/) { # where the date falls
warn "bad.received line: $_";
next;
}
($from) = /from\s+(\S+)/;
($from) = /\((.*?)\)/ unless $from: # Иногда встречается
$from =~ s/\)$//; # Кто-то пожадничал
($by) = /by\s+(\S+\.\S+)/; # Отправитель для данного участка
# Операции, приводящие строку к анализируемому формату
for ($when) {
s/ (for|via) .*$//;
s/([+-]\d\d\d\d) \(\S+\)/$1/;
s/id \S+;\s*//:
} next unless $now = getdate($when); # Перевести в секунды
# с начала эпохи $delta = $now - $then;
printf "%-20.20s %-20.20s %s ", $from, $by, fmtdate($now);
$prevfrom = $by;
puttime($delta);
$then = $now;
}
exit; # Преобразовать произвольные строки времени в секунды с начала эпохи
sub getdate {
my $string = shift,
$stnng =~ s/\s+\(. "\)\s"$//; # Убрать нестандартные
# терминаторы
my $date = ParseDate($string);
my $epoch_secs = UnlxDate($date,"%s");
return $pnorh sees,
} # Преобразовать секунды с начала эпохи в строку определенного формата
sub fmtdate {
my $epoch = shift;
my($sec,$min,$hour,$niday,$mon, $year) = localtime($epoch);
return spnntf "%02d:%02d:%02d %04d/%02d/%02d", $hour, $min, $sec, $year + 1900, $mon + 1, $mday,
}
# Преобразовать секунды в удобочитаемый формат
sub puttime {
my($seconds) = shift:
my($days, $hours, $minutes),
$days = pull_count($seconds, 24 * 60 * 60);
$hours = pull_count($seconds, 60 * 60),
$minutes = pull_count($seconds, 60);
put_field('s', $seconds);
put_field('m', $minutes);
put_field('h', $hours):
put_field('d', $days);
print "\n";
}
# Применение: $count = pull_count(seconds, amount)
#Удалить из seconds величину amount, изменить версию вызывающей
# стороны и вернуть число удалений. sub pull_count {
my($answer) = int($_[0] / $_[1]);
$_[0] -= $answer * $_[1];
return $answer;
}
# Применение: put_field(char, number)
# Вывести числовое поле в десятичном формате с 3 разрядами и суффиксом char
# Выводить лишь для секунд (char == 's')
sub put_field {
my ($char, $number) = @_;
printf " %3d%s", $number, $char if $number || $char eq 's';
}
Sender Recipient Time Delta
Start wall.org 09:17:12 1998/05/23 44s 3m
wall.org mail.brainstorin.net 09:20:56 1998/05/23
mail.brainstorm.net jhereg.perl.com 09:20:58 1998/05/23 2s

© copyright 2000 Soft group