Perl_Master
Newbie | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Генератор HTTP-заголовка Set-Cookie:
Пример использования:
print cookie("affiliate", "1001", "1m", "/", 0);
Код:
# subroutine name: cookie
# Returns cookie string for output to browser
# Input:
# $name - cookie name
# $value - cookie value
# $expires - expiration date or time increment
# (understands also time offset
# "12345s" - seconds
# "1234h" - hours
# "122d" - days
# "12w" - weeks
# "14m" - months
# "1.5y" - year
# $path - cookie path
# $domain - cookie domain
# $secure - secure cookie (true/false)
subcookie {
my ($name, $value, $expires, $path, $domain, $secure) = @_;
my $expires_date;
my %time_unit = (
s => 1,
h => 3600,
d => 86400,
w => 86400*7,
m => 86400*30,
y => 86400*365,
);
if ($expires =~ m/^(-?\d*?\.?\d+)(s|h|d|w|m|y)$/i) {
$expires_date = &format_gmtdatetime(time + $1*$time_unit{lc($2)});
} else {
$expires_date = $expires;
}
($name, $value) = (&escape($name), &escape($value));
$secure=$secure?' secure':'';
return "Set-Cookie: $name=$value; expires=$expires_date".($path?"; path\=$path":"").($domain?"; domain\=$domain":"")."$secure\n";
}
# subroutine name: format_gmtdatetime
# Formats GMT date/time as required to send with cookie
sub format_gmtdatetime {
my ($atime) = @_;
$atime ||= time;
my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
my @wdays = qw(Sun Mon Tue Wed Thu Fri Sat);
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($atime);
return sprintf("%s, %02d-%s-%s %02d:%02d:%02d GMT", $wdays[$wday], $mday, $months[$mon], $year+1900, $hour, $min, $sec);
}
# subroutine name: escape
# URL-encode string
sub escape {
my($toencode) = @_;
$toencode=~s/([^a-zA-Z0-9_\-. ])/uc sprintf("%%%02x",ord($1))/eg;
$toencode =~ tr/ /+/;# spaces become pluses
return $toencode;
}
|
Добавлено
Преобразование структуры данных с неограниченной вложенностью (хеши, массивы, скаляры во всевозможных комбинациях) в Perl-исходник, результатом исполнения которого будет копия этой структуры.
Применяется для сохранения в файл разнобразных структур данных.
Пример использования:
open(DATA, ">data1");
print DATA struct2text( {"key1" => "val1", "key2" => "val2",
"empty_value_key" => "",
"arr_key" => [4,5,6,8,"abc"]},
1, "\n");
close DATA;
....
# Загрузка структуры из файла
open(DATA, "<data1");
my $content;
{
local($/) = undef;
$content = <DATA>;
}
my $struct_copy = eval($content);
close DATA;
Код:
# subroutine name: struct2text
# Input:
# $struct - reference to any perl structure (no loops allowed!!!)
# $store_empty_values - store hash pairs with empty values or not
# $separator_char - lines separator (default is "\n"), used to write
# structure in one line
# Returns: string, which represents passed data structure in Perl language
# Usage example: struct2text( {"key1" => "val1", "key2" => "val2",
# "empty_value_key" => "",
# "arr_key" => [4,5,6,8,"abc"]},
# 1, "\n");
# Result: '
# {"arr_key"=>["4",
# "5",
# "6",
# "8",
# "abc",
# ],
# "empty_value_key"=>"",
# "key1"=>"val1",
# "key2"=>"val2",
# }'
sub struct2text {
my ($struct,$store_empty_values, $separator_char) = @_;
$separator_char = $separator_char || "\n";
my $res="";
my $ref_name = ref($struct);
if (! defined $struct) {
$res="undef";
} elsif ($ref_name eq "SCALAR") {
$res=perl_quote(${$struct});
} elsif ($ref_name eq "ARRAY") {
$res="[";
foreach (@{$struct}) { $res.=struct2text($_,$store_empty_values, $separator_char).",".$separator_char; };
$res.="]";
} elsif ($ref_name eq "HASH") {
$res=$separator_char."{";
foreach (sort keys %{$struct}) { $res.=perl_quote($_)."=>".struct2text(${$struct}{$_},$store_empty_values, $separator_char).",".$separator_char if (${$struct}{$_} || ${$struct}{$_} ne "" || $store_empty_values); };
$res.="}";
} elsif ($ref_name eq "REF") {
$res="\\".struct2text(${$struct},$store_empty_values,$separator_char);
} else {
$res=perl_quote($struct);
}
return $res;
}
sub perl_quote {
my ($str) = @_;
$str=~s/(["\\\@\$])/\\$1/gs;
$str=~s/\r\n/\n/gs;
$str=~s/([\x00-\x1F])/sprintf("\\x%02x",ord($1))/egs;
"\"$str\"";
}
|
Форматирование даты/времени с использованием шаблона
Пример использования:
my $user_friendly_datetime = formatdatetime("DD.MM.YYYY hh:mm", time);
Результат: 23.07.2004 00:42
Код:
# Formats date/time with passed template
# YY - 2-digit year, YYYY - 4-digit year
# MM - 2-digit (with leading zero) month, M - 2-digit (without leading zero) month
# MMM - month short name, MMMM - month long name
# DD - 2-digit (with leading zero) month day, D - 2-digit (without leading zero) month day
# DDD - weekday short name, DDDD - weekday long name
# AM - AM/PM flag
# hh - 2-digit (with leading zero) hour, h - 2-digit (without leading zero) hour
# mm - 2-digit (with leading zero) minute, m - 2-digit (without leading zero) minute
# ss - 2-digit (with leading zero) second, s - 2-digit (without leading zero) second
sub formatdatetime {
my $format=shift @_ || "YYYY-MM-DD hh:mm:ss";
my $datetime=shift @_ || time;
my %strings=(
'500' => "AM", '501' => "PM",
'400' => "January", '401' => "February", '402' => "March", '403' => "April", '404' => "May", '405' => "June", '406' => "July", '407' => "August", '408' => "September", '409' => "October", '410' => "November", '411' => "December",
'300' => "Jan", '301' => "Feb", '302' => "Mar", '303' => "Apr", '304' => "May", '305' => "Jun", '306' => "Jul", '307' => "Aug", '308' => "Sep", '309' => "Oct", '310' => "Nov", '311' => "Dec",
'200' => "Sunday", '201' => "Monday", '202' => "Tuesday", '203' => "Wednesday", '204' => "Thursday", '205' => "Friday", '206' => "Saturday",
'100' => "Sun", '101' => "Mon", '102' => "Tue", '103' => "Wed", '104' => "Thu", '105' => "Fri", '106' => "Sat"
);
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($datetime);
$year+=1900;
if ($format=~m/AM/) {
my $ampmhour = ($hour % 12) || 12;
$format=~s/hh/sprintf("%02u",$ampmhour)/eg;
$format=~s/h/$ampmhour/eg;
$format=~s/AM/($hour>11?"^501":"^500")/eg;
} else {
$format=~s/hh/sprintf("%02u",$hour)/eg;
$format=~s/h/$hour/eg;
};
$format=~s/mm/sprintf("%02u",$min)/eg;
$format=~s/m/$min/eg;
$format=~s/ss/sprintf("%02u",$sec)/eg;
$format=~s/s/$sec/eg;
$format=~s/YYYY/$year/eg;
$format=~s/YY/sprintf("%02u",$year % 100)/eg;
$format=~s/MMMM/sprintf("^4%02u",$mon)/eg;
$format=~s/MMM/sprintf("^3%02u",$mon)/eg;
$format=~s/MM/sprintf("%02u",$mon+1)/eg;
$format=~s/M/($mon+1)/eg;
$format=~s/DDDD/sprintf("^2%02u",$wday)/eg;
$format=~s/DDD/sprintf("^1%02u",$wday)/eg;
$format=~s/DD/sprintf("%02u",$mday)/eg;
$format=~s/D/$mday/eg;
$format=~s/\^(\d\d\d)/$strings{$1}/g;
return $format;
}
|
Функции для работы с датами/временем в формате "YYYY-MM-DD hh:mm:ss"
Код:
#block str2datetime
# Input - string (date,time) YYYY-MM-DD HH:MM:SS|YYYY-MM-DD|HH:MM:SS
# Output - time in perl format (seconds since Jan 1-st 1970 00:00:00)
#
sub str2datetime {
my ($buffer)=@_;
require Time::Local;
my ($sec,$min,$hours,$mday,$mon,$year);
if ($buffer =~ /^([12]\d\d\d)-([01]\d)-([0123]\d)$/)
{
($year,$mon,$mday) = ($1-1900,$2,$3);
$mon = $mon-1;
return &Time::Local::timelocal($sec,$min,$hours,$mday,$mon,$year);
}
elsif ($buffer =~ /^([012]\d):([0-5]\d):([0-5]\d)$/)
{
($hours,$min,$sec) = ($1,$2,$3);
($year,$mon,$mday) = (70,0,1); # Jan 1-st 1970
return &Time::Local::timelocal($sec,$min,$hours,$mday,$mon,$year);
}
elsif ($buffer =~ /^([12]\d\d\d)-([01]\d)-([0123]\d) ([012]\d):([0-5]\d):([0-5]\d)$/)
{
($year,$mon,$mday,$hours,$min,$sec) = ($1-1900,$2,$3,$4,$5,$6);
$mon = $mon-1;
return &Time::Local::timelocal($sec,$min,$hours,$mday,$mon,$year);
}
else { return(); } # no match at all !
}
#endblock str2datetime
#block date2str
sub date2str {
my $datetime=shift @_ || time;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($datetime);
return sprintf("%04u-%02u-%02u",$year+1900,$mon+1,$mday);
}
#endblock date2str
#block time2str
sub time2str {
my $datetime=shift @_ || time;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($datetime);
return sprintf("%02u:%02u:%02u",$hour,$min,$sec);
}
#endblock time2str
#block datetime2str
sub datetime2str {
my $datetime=shift @_ || time;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($datetime);
return sprintf("%04u-%02u-%02u %02u:%02u:%02u",$year+1900,$mon+1,$mday,$hour,$min,$sec);
}
#endblock datetime2str
|
Добавлено
Форум режет табуляции в отступах.
Отформатированную версию, а также другие полезные функции можно брать здесь:
http://www.atomicsoft.com/freelib/ |
