Сергей Майков aka Madskull
http://www.mdsk.ru
2005.11.12
| Установка локали в скрипте | В начало |
use locale; |
Если же нужна другая локаль, то можно сделать так
use locale; use POSIX qw(locale_h); setlocale(LC_ALL,"ru_RU.KOI8-R"); |
| Загрузка модулей из нестандартного места | В начало |
use FindBin qw($Bin); use lib "$Bin/../lib"; use MyModule; |
| Декодирование символов вида %2A%20 | В начало |
s/\%([0-9a-fA-F]{2})/chr(hex($1))/ge
|
| Эмуляция try..catch | В начало |
объявление
sub try(&$)
{
my ($try,$catch) = @_;
eval { &$try };
if ( $@ ) {
local $_ = $@;
&$catch
}
}
sub catch(&) { $_[0] }
|
использование
try {
die "error";
}
catch {
/error/ and print "Error!\n";
print "Unknown error: $_\n"
};
|
| Получение имени тома CD или DVD диска | В начало |
#!/usr/bin/perl -w
eval {
$ARGV[0] || die "Usage: cd-label <device>\n";
open F,"<$ARGV[0]" or die $!."\n";
seek(F,0x8028,0) or die $!."\n";
read(F,$t,32) or die $!."\n";
};
if ($@) {
print STDERR $@;
exit 1;
}
$t=~s/\s+$//;
print $t."\n"
|
| Неочевидные фишки Perl'a | В начало |
$a||=1 то же самое, что и $a=1 unless $a
получение размера массива: scalar(@a) или @a+0 ну или общеизвестное $#a+1
чтение списка файлов @files=<*.pl>
или, при использовании подстановок @files=glob($filter)
| Getopt::Std | В начало |
getopts('a:b:c', \%opts);
my ($opt_a,$opt_b,$opt_c) = ("def-a","def-b", 0);
$opt_a = $opts{'a'} if defined $opts{'a'};
$opt_b = $opts{'b'} if defined $opts{'b'};
$opt_c = 1 if defined $opts{'c'};
|
| Text::Iconv | В начало |
my $iconv = new Text::Iconv($fromenc, $toenc); my $text2 = $iconv->convert($text1); |
| Кодировка ->транслит | В начало |
sub translit
{
my $text = shift;
$text =~ y/абвгдеёзийклмнопрстуфхъыьэ/abvgdeezijklmnoprstufh'y'e/;
$text =~ y/АБВГДЕЁЗИЙКЛМНОПРСТУФХЪЫЬЭ/ABVGDEEZIJKLMNOPRSTUFH'Y'E/;
my %mchars = ('ж'=>'zh','ц'=>'ts','ч'=>'ch','ш'=>'sh','щ'=>'sch','ю'=>'ju','я'=>'ja',
'Ж'=>'Zh','Ц'=>'Ts','Ч'=>'Ch','Ш'=>'Sh','Щ'=>'Sch','Ю'=>'Ju','Я'=>'Ja');
for my $c (keys %mchars) {
$text =~ s/$c/$mchars{$c}/g;
}
return $text;
}
|
| alarm: прерывание по времени | В начало |
eval {
$SIG{ALRM} = sub { die "alarm\n" };
alarm 10;
# ... code
};
if ( $@ eq "alarm\n" ) {
print "время вышло!\n";
}
|
| Ловим прерывания | В начало |
eval {
$SIG{INT} = sub { die "int\n" };
# ... code
};
if ( $@ eq "int\n" ) {
print "^C pressed\n";
}
|
| Пародия на wget - закачка с прогрессбаром (Net::FTP::dataconn,URI) | В начало |
#!/usr/bin/perl -w
use strict;
use URI;
use Net::FTP;
use FileHandle;
$|=1;
my $progress_length = 50;
unless ($ARGV[0]) {
print "Usage: $0 url\n";
exit 1;
}
my $uri = new URI($ARGV[0]);
die "error in url" unless $uri->scheme && $uri->scheme eq "ftp";
my ($dir,$file) = $uri->path =~ /(.*)\/(.*)/;
die "error in url: no file part" unless $file;
print "Connect to ".$uri->host." ... ";
my $ftp = new Net::FTP( $uri->host, Port=>$uri->port, Passive=>1, Debug => 0)
or die "Cannot connect to $uri->host: $@";
$ftp->login($uri->user,$uri->password)
or die "Cannot login ", $ftp->message;
$ftp->cwd($dir) || die("Cannot change working directory ", $ftp->message) if $dir;
print "Ok\nGet file ... \n";
my $size = $ftp->size($file);
die "File not found: ", $ftp->message unless defined $size;
$ftp->binary;
my $in = $ftp->retr($file) or die "Can't download file: ",$ftp->message;
my $out = new FileHandle(">$file") or die "Can't create local file: ", $!;
binmode $out;
my ($len,$buf)=(0,'');
while( $len < $size ) {
$len += $in->read($buf,$size-$len) || last;
print $out $buf;
my $perc = int(100*$len/$size);
my $done = int($progress_length*$perc/100);
print "\r[".($done?"#"x$done:"").
($progress_length-$done?"-"x($progress_length-$done):"").
"] $perc\% $len bytes";
}
print "\n";
$out->close;
$ftp->quit;
|
| Использование LWP | В начало |
use LWP;
use HTTP::Cookies;
my $ua = LWP::UserAgent->new;
$ua->cookie_jar(HTTP::Cookies->new());
$ua->agent('Mozilla/4.0 (compatible; MSIE 6.0; X11; Linux i686; en) Opera 7.60');
my $Headers = new HTTP::Headers(
'Referer' => 'http://some.host.ru/index.html',
'Accept' => 'text/html, application/xml;q=0.9, application/xhtml+xml,
image/png, image/jpeg, image/gif, image/x-xbitmap, */*;q=0.1',
'Accept-Language' => 'ru',
'Accept-Charset' => 'koi8-r, utf-8, utf-16, iso-8859-1;q=0.6, *;q=0.1',
'Cookie' => 'sid=0; hotlog=1',
'Cookie2' => '$Version=1',
'Connection' => 'Keep-Alive, TE',
'TE' => 'deflate, gzip, chunked, identity, trailers',
); # выдергано из запросов Оперы
$ua->default_headers($Headers);
# регистрируемся
my $res = $ua->post('http://some.host.ru/log/in/',
[ 'login' => $login, 'pass' => $passwd ] );
# если используется перенаправление !
$res = $ua->get('http://some.host.ru/'.$res->header("Location"));
die "FAIL!\n" unless ( $res->is_success );
# забираем нужное нам нечто
$ua->default_header(Referer=>"http://some.host.ru/things/index.html");
$res = $ua->get("http://some.host.ru/things/warez.zip");
die "FAIL!" unless $res->is_success;
# сохраняем
open F, ">warez.zip";
binmode F;
print F $res->content;
close F;
PRE: Использование Net::FTP
use Net::FTP;
$ftp = Net::FTP->new("ftp.narod.ru", Passive => 1, Debug => 1)
or die "Cannot connect to ftp.narod.ru: $@";
$ftp->login( $login, $passwd )
or die "Cannot login ", $ftp->message;
$ftp->cwd("/warez")
or die "Cannot change working directory ", $ftp->message;
$ftp->put("index.html")
or die "Cannot send file ", $ftp->message;
$ftp->quit;
|
| Встроенные переменные | В начало |
| $` | строка, следующая за совпадением |
| $- | число строк, оставшихся на странице |
| $! | текущая ошибка |
| $` | разделитель полей массивов при интерполировании |
| $# | формат вывода чисел с плавающей точкой |
| $$ | идентификатор процесса Perl |
| $% | текущая страница вывода |
| $& | совпадение с шаблоном поиска |
| $( | реальный идентификатор группы пользователей (real GID) |
| $) | текущий идентификатор группы пользователей (effective GID) |
| $* | совпадение с шаблоном поиска |
| $, | разделитель полей вывода |
| $. | текущий номер строки ввода |
| $/ | разделитель входных записей |
| $: | маркер разбивки строки |
| $; | разделитель индексов |
| $? | статус последней системной операции |
| $@ | ошибка выполнения функции eval |
| $[ | базовый индекс массивов |
| $\ | разделитель выходных записей |
| $] | версия Perl |
| $^ | текущий формат колонтитула страницы |
| $^A | накопитель команды write |
| $^D | текущие флаги отладки |
| $^E | информация об ошибке, специфичная для операционной системы |
| $^F | максимальное количество дескрипторов файлов |
| $^H | флаги проверки синтаксиса |
| $^I | расширение файлов для редактирования `по месту` |
| $^L | символ прогона страницы |
| $^M | буфер памяти `на крайний случай` |
| $^O | имя операционной системы |
| $^P | поддержка отладки |
| $^R | результат вычисления утверждения в теле шаблона |
| $^S | состояние интерпретатора |
| $^T | время запуска сценария на выполнение |
| $^W | режим вывода предупреждающих сообщений |
| $^X | имя программы-интерпретатора |
| $_ | аргумент по умолчанию |
| $` | строка, следующая перед совпадением |
| $| | управление буфером вывода |
| $~ | имя текущего формата отчетов |
| $+ | фрагмент совпадения |
| $< | реальный идентификатор пользователя (Real User ID) |
| $= | текущий размер страницы |
| $> | текущий идентификатор пользователя (Effective User ID) |
| $O | имя программы |
| $ARGV | имя входного файла |
| $nn | nn-й фрагмент совпадения |
| %ENV | переменные окружения |
| %INC | подключаемые файлы |
| %SIG | обработчики ситуаций |
| @_ | аргументы, переданные подпрограмме |
| @ARGV | аргументы, переданные в командной строке |
| @INC | пути поиска подключаемых файлов |
| Отключение буферизации | В начало |
$| = 1; # для текущего потока вывода
autoflush STDOUT 1; # только для STDOUT
$f = new FileHandle(">file");
$f->autoflush(1); # только для file
|
| Сортировка хэша по значениям | В начало |
print "$_ = $h{$_}\n" for( sort { $h{$a} > $h{$b} } keys %h);
|
| Использование HTML::LinkExtor | В начало |
#!/usr/bin/perl -w
require HTML::LinkExtor;
my ($file) = @ARGV;
$p = HTML::LinkExtor->new(\&callback);
$p->parse_file($file);
sub callback {
my($tag,%attr) = @_;
print "$attr{href}\n" if $tag eq 'a';
}
|
| Дата и время Time::localtime | В начало |
use Time::localtime;
sprintf("%02d.%02d.%02d %02d:%02d:%02d",
localtime->mday(),
localtime->mon()+1,
localtime->year()-100,
localtime->hour(),
localtime->min(),
localtime->sec()
);
|
| Чтение файла в массив | В начало |
use FileHandle;
my @text = (new FileHandle("<file") or die "$!")->readlines();
|
| Использование Benchmark | В начало |
use Benchmark;
timethese(1000000,
{
test1 => '...code...',
test2 => '...code...',
}
);
|
| Использование Data::Dumper | В начало |
use Data::Dumper; %hash = (...); @array = (...); print Dumper(\%hash); print Dumper(\@arra); |