Приглашаем посетить
3.6. Определение номера недели или дня недели/месяца/года
Проблема
Имеется дата в секундах с начала эпохи или в виде отдельных компонентов - года, месяца и т. д. Требуется узнать, на какой номер недели или день недели/месяца/года она приходится.
Решение
Если дата выражена в секундах с начала эпохи, день года, день месяца или недели возвращается функцией localtime. Номер недели легко рассчитывается по дню года.
($MONTHDAY, $WEEKDAY, $YEARDAY) = (localtime $DATE) [3,6,7];
$WEEKNUM = int($YEARDAY / 7) + 1;
Отдельные компоненты полного времени можно преобразовать в число секунд с начала эпохи (см. рецепт 3.3) и воспользоваться приведенным выше решением. Возможен и другой вариант - применение функций Day_of_Week, Week_Number и Day_of_Year модуля Date::Calc с CPAN:
use Date::Calc qw(Day_of_Week Week_Number Day_of_Year);
# Исходные величины - $year, $month и $day
# По определению $day является днем месяца
$wday = Day_of_Week($year, $month, $day);
$wnum = Week_Number($year, $month, $day);
$dnum = Day_of_Year($year, $month, $day);
Комментарий
Функции Day_of_Week, Week ^..n'bo:'" и Day_of_Year получают год без вычитания 1900 и месяц в нумерации, начпиаюпк-йся с 1 (январь), а не с 0. Возвращаемое значение функции Day_of_Week находится в интервале 1-7 (с понедельника до воскресенья) или равняется 0 в случае ошибки (например, при неверно заданной дате).
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.
Проблема
Спецификация даты или времени читается в произвольном формате, однако ее требуется преобразовать в отдельные компоненты (год, месяц и т. д.).
Решение
Если дата уже представлена в виде числа или имеет жесткий, легко анализируемый формат, воспользуйтесь регулярным выражением (и, возможно, хэшем, связывающим названия месяцев с номерами) для извлечения отдельных значений дня, месяца и года. Затем преобразуйте их в секунды с начала эпохи с помощью функций timelocal и timegm стандартного модуля Time::Local.
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);
}
Комментарий
Универсальная функция ParseDate поддерживает различные форматы дат. Она даже преобразует такие строки, как "today" ("сегодня"), "2 weeks ago Friday" ("в пятницу две недели назад") и "2nd Sunday in 1996" ("2-е воскресенье 1996 года"), а также понимает форматы даты/времени в заголовках почты и новостей. Расшифрованная дата возвращается в собственном формате - строке вида "ГПТММДДЧЧ:ММ:СС". Сравнение двух строк позволяет узнать, совпадают ли представленные ими даты, однако арифметические операции выполняются иначе. Поэтому мы воспользовались функцией UnixDate для извлечения года, месяца и дня в нужном формате.
Функция UnixDate получает дату в виде строки, возвращаемой ParseDate, и список форматов. Она последовательно применяет каждый формат к строке и возвращает результат. Формат представляет собой строку с описанием одного или нескольких элементов даты/времени и способов оформления этих элементов. Например, формат %Y соответствует году, состоящему из четырех цифр. Приведем пример:
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.
Проблема
Требуется преобразовать дату и время, выраженные в секундах с начала эпохи, в более понятную для человека форму.
Решение
Вызовите localtime или gmtime в скалярном контексте - в этом случае функция получает количество секунд с начала эпохи п возвращает строку вида Tue May 26 05:15:20 1998:
$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);
Комментарий
Простеишее решение - функция localtime - относится к встроенным средствам Perl. В скалярном контексте эта функция возвращает строку, отформатированную особым образом:
Sun Sep 21 15:33:36 1999 Программа получается простои, хотя формат строки сильно ограничен:
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.
Проблема
Функция time возвращает время с точностью до секунды. Требуется измерить время с более высокой точностью.
Решение
Иногда эта проблема неразрешима. Если на вашем компьютере Perl поддерживает функцию syscall, а в системе имеется функция тина gettimeofday(2), вероятно, ими можно воспользоваться для измерения времени. Особенности вызов;! syscall зависят от конкретного компьютера. В комментарии приведен примерный вид фрагмента, однако его переносимость не гарантирована.
На некоторых компьютерах эти функциональные возможности инкапсулируются в модуле Time::HiRes (распространяется с CPAN):
use Time::HiRes qw(gettimeofday);
$t0 = gettimeorday;
# Ваши операции
$t1 = gettuneofday;
$elapsed = $t1 - $t0;
# $elapsed - значение с плавающей точкой, равное числу секунд Я между $t1 и $t2
Комментарий
В следующем фрагменте модуль Time::HiRes используется для измерения промежутка между выдачей сообщения и нажатием клавиши RETURN:
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).
Проблема
Требуется сделать в программе паузу продолжительностью менее секунды.
Решение
Воспользуйтесь функцией select, если она поддерживается вашей системой:
select(undef, undet, undef, $time_to_sleep);
где $time_to_sleep - длительность паузы.
Некоторые системы не поддерживают select с четырьмя аргументами. В модуле Time::HiRes присутствует функция sleep, которая допускает длину паузы с плавающей точкой:
use Time::HiRes qw(sleep);
sleep($time_to_sleep);
Комментарий
Следующий фрагмент демонстрирует применение функции select. Он представляет собой упрощенную версию программы из рецепта 1.5. Можете рассматривать его как эмулятор 300-бодного терминала:
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.
Вы никогда не задавались вопросом, почему какое-нибудь важное письмо так долго добиралось до вас? Обычная почта не позволит узнать, как долго ваше письмо пылилось на полках всех промежуточных почтовых отделений. Однако в электронной почте такая возможность имеется. В заголовке сообщения присутствует строка Received: с информацией о том, когда сообщение было получено каждым промежуточным транспортным агентом.
Время в заголовках воспринимается плохо. Его приходится читать в обратном направлении, снизу вверх. Оно записывается в разных форматах но прихоти каждого транспортного агента. Но хуже всего то, что каждое время регистрируется в своем часовом поясе. Взглянув на строки "Tue, 26 May 1998 23:57:38 -0400" и "Wed, 27 May 1998 05:04:03 +0100", вы вряд ли сразу поймете, что эти два момента разделяют всего 6 минут 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.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
