The OpenNET Project / Index page

[ новости /+++ | форум | теги | ]

Perl tips (tips)


<< Предыдущая ИНДЕКС Правка src / Печать Следующая >>
Ключевые слова: tips,  (найти похожие документы)
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 "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; Использование 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 Сортировка хэша по значениям 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);

  • << Предыдущая ИНДЕКС Правка src / Печать Следующая >>

     Добавить комментарий
    Имя:
    E-Mail:
    Заголовок:
    Текст:




    Партнёры:
    PostgresPro
    Inferno Solutions
    Hosting by Hoster.ru
    Хостинг:

    Закладки на сайте
    Проследить за страницей
    Created 1996-2024 by Maxim Chirkov
    Добавить, Поддержать, Вебмастеру