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/ |