perl-hacks/

Около месяца собирал разные «хаки» на языке программирования Perl. Эта подборка наглядно демонстрирует, как в Perl одна-две строчки кода могут сделать больше, чем десять строк в каком-нибудь другом языке программирования.

Дополнение: См также Основы программирования на Perl .

1. Проверить, существует ли элемент (первый аргумент функции, передается по значению) в массиве (второй аргумент функции, передается по ссылке).

sub inarr {
grep { $_ == $_ [ 0 ] } @ { $_ [ 1 ] } ; # важно: для строк использовать eq
}

2. Удалить из массива @arr элементы, которые есть в массиве @skip.

my @rslt = grep {
my $t = $_ ;
! grep { $_ == $t } @skip ; # важно: для строк использовать eq
} @arr ;

3. Скрипт замены строк в тексте.

#!/usr/bin/perl

while ( <> ) {
chomp ;
last if ( $_ eq «==end==» ) ;
/^([^=]*)=(.*)$/ and $r { $1 } = $2 ;
}

$d = join » , <>;
$d =~ s/$_/$r{$_}/g for ( keys %r ) ;
print $d ;

4. Вывести список имен файлов и каталогов в заданной директории, отсортированный по дате последнего доступа. Обычно глобы сортируют список по имени файлов и каталогов. Для сортировки по дате последнего изменения, заменить цифру 8 на 9.

print join » n » , sort { ( stat $a ) [ 8 ] <=> ( stat $b ) [ 8 ] } glob «./*» ;

5. Удалить повторяющиеся элементы в массиве.

my %cnt ; # будет содержать число повторений элементов
@links = grep { ! $cnt { $_ } ++; } @links ;

То же самое с помощью List::MoreUtils.

use List :: MoreUtils qw/uniq/ ;
# …
@links = uniq @links ;

6. Перемешать элементы массива.

for ( 0 .. $#links ) {
my $j = rand ( @links ) ;
@links [ $_ , $j ] = @links [ $j , $_ ] ;
}

Сделать то же самое с помощью List::Util.

use List :: Util qw/shuffle/ ;
# …
@links = shuffle @links ;

7. Выбрать случайный элемент в массиве можно как минимум двумя способами. Можно перемешать элементы, как в предыдущем примере, и выбрать нулевой, а можно в одну строчку:

$rand = $links [ rand ( @links ) ] ;

8. Аналог PHP функции urlencode.

$url =~ s/([^a-zA-Z0-9%&?:;/=.,#-_]{1})/sprintf(«%%%02x»,ord($1))/eg ;

Но лучше использовать URI::Escape.

use URI :: Escape ;

# uri_escape, uri_unescape

9. Получить все строки файла.

my @lines = split » n » , `cat $0` ;

10. Простой многопоточный обработчик.

#!/usr/bin/perl

use strict ;
use threads ;
use threads :: shared ;
use List :: Util qw/shuffle/ ;
use constant THREADS_NUM => 8 ;

my $cnt : shared = 0 ;
my @threads ;
my @lines ;

while ( <> ) { chomp ; push @lines , $_ ; }
@lines = shuffle @lines ;
push @threads , threads -> create ( &thread_func , $_ )
for ( 1 .. THREADS_NUM ) ;
$_ -> join for ( @threads ) ;

sub thread_func {
my ( $thid ) = @_ ;
my $my_cnt ;
while ( 1 ) {
{ lock ( $cnt ) ; $my_cnt = $cnt ++; }
last if ( $my_cnt >= @lines ) ;
parse_line ( $thid , $lines [ $my_cnt ] ) ;
}
}

sub parse_line {
my ( $thid , $line ) = @_ ;
print «thid = $thid, line = $line n » ;
sleep ( rand ( 3 ) ) ;
}

Для выполнения этого кода Perl должен быть собран с поддержкой потоков. У меня под FreeBSD этой поддержки не оказалось, а после пересборки перла потребовалось также обновить некоторые CPAN-модули. Будьте внимательны.

11. Работа с временными файлами:

#!/usr/bin/perl

# работа с временными файлами в Perl
# (c) Alexandr A Alexeev 2011 | http://remontka.com/
# подробности см в ‘man File::Temp’

use strict ;
use File :: Temp ;

# сгенерировать имя временного файла в заданном каталоге
# с указанным префиксом
my $tmp_fname = File :: Temp :: tempnam ( «./tmp» , «myprfx» ) ;
print «tmp_name = $tmp_fname n » ;

# получить имя временного файла в каталоге /tmp
my $tmp_fname2 = tmpnam ( ) ;
print «tmp_name = $tmp_fname2 n » ;

# получить хэндл временного файла в каталоге /tmp
my $fh = tmpfile ( ) ;
close $fh ;

# получить имя и хэндл временного файла
my ( $th , $tname ) = tmpnam ( ) ;
print «tname = $tname n » ;
close $th ;

12. Вырезаем HTML теги + пример работы с юникодом:

use strict ;
use utf8 ;
use HTML :: Entities ;

# …
utf8 :: decode ( $_ ) ;
s/<[^>]*>//g ;
decode_entities ( $_ ) ;
utf8 :: encode ( $_ ) ;

См также HTML::Strip .

13. Кроссплатформенное считывание файла в одну строку или в массив строк.

use File :: Slurp ;
# …
my $data = read_file ( $filename ) ;
my @lines = read_file ( $filename ) ;

# удаляем символы новой строки
@lines = map { chomp ; $_ ; } @lines ;

14, 15, 16 … Coming soon?

EnglishRussianUkrainian