From: madskull <madskull at mail ru>
Subject: Perl tips
Оригинал: http://madskull.narod.ru/tips/perl.html
Загрузка модулей из нестандартного места
Декодирование символов вида %2A%20
Эмуляция try..catch
Получение имени тома CD или DVD диска
Неочевидные фишки Perl'a
Getopt::Std
Text::Iconv
Кодировка ->транслит
alarm: прерывание по времени
ловим прерывания
Пародия на wget - закачка с прогрессбаром (Net::FTP::dataconn,URI)
Использование LWP
Использование Net::FTP
Встроенные переменные
Отключение буферизации
Сортировка хэша по значениям
Использование HTML::LinkExtor
Дата и время Time::localtime
Чтение файла в массив
Использование Benchmark
Использование Data::Dumper
Perlеводы
Загрузка модулей из нестандартного места
Программа находится в /path/to/bin
Модуль - в /path/to/lib
use FindBin qw($Bin);
use lib "$Bin/../lib";
use MyModule;
Декодирование символов вида %2A%20
s/%([0-9a-fA-F]{2})/chr(hex($1))/ge
Эмуляция try..catch
(Пример из "Camel book")
# объявление
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 диска
Может, есть и более "элегантные" решения, но не было времени искать.
(позже оказалось, что, например, команда file /dev/cdrom тоже покажет label)
#!/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);
Кодировка ->транслит
# Ну не нравицца мне стандартный koi7
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 "alarmn" };
alarm 10;
# ... code
};
if ( $@ eq "alarmn" ) {
print "время вышло!n";
}
ловим прерывания
eval {
$SIG{INT} = sub { die "intn" };
# ... code
};
if ( $@ eq "intn" ) {
print "^C pressedn";
}
Пародия на wget - закачка с прогрессбаром (Net::FTP::dataconn,URI)
#!/usr/bin/perl -w
use strict;
use URI;
use Net::FTP;
use FileHandle;
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 "OknGet 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 $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;
Использование 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 - пути поиска подключаемых файлов
Отключение буферизации
В частности, print без "n" выводит текст сразу.
$| = 1; # для текущего потока вывода
autoflush STDOUT 1; # только для STDOUT
$f = new FileHandle(">file");
$f->autoflush(1); # только для file
Vova
