Perl. Сборник рецептов

• Как получить файл по FTP
• Получить сумму значений на основе файла, каждая строка которого число
• Проверить email на валидность
• Использовать несколько локалей
• Разбор тегов в файле
• Работа со случайными и псевдослучайными числами
• Определение и условная передача размера файла
• Выловить ссылки из переменной
• Работа с датами в текстовой БД
• Как определить имя хоста
• Как узнать, установлен ли модуль
• Как заменить текст в файле
• Экспорт функций
• Разбить число на триплеты
• Определить есть ли соединение по хэндлеру сокета
• Определить дату начала и конца недели
• Получить имена подпрограмм модуля
• Получить постоянную последовательность чисел
• Получить случайное число
• Сгенерировать случайную строку (пароль, идентификатор)
• Поменять местами ключи и значения хэш-массива

$ftp = Net::FTP->new("е.е.е.е", Debug => 0); 
$ftp->login('anonymous','anonymous'); 
$ftp->cwd('/pub'); 
$ftp->get(test.pl,test2.pl,/pub/incoming); 
$ftp->quit; 

Получить сумму значений на основе файла, каждая строка которого число

open (F,"file") or die $!; 
map { $a += $_; } ; 
print $a; 

open (F,"file") or die $!; 
print (map { $a += $_; } )[-1]; 

Проверить email на валидность

Использование нескольких локалей

#!/usr/bin/perl -w 
use strict; 
use locale; 
my $var = "TEST"; 
print lc($var); 
--------------- 
test 

О1. by Vlad

use strict; 
use locale; 
use POSIX qw(locale_h); 

{ 
setlocale(LC_CTYPE,"ru_RU.ISO8859-5"); 
my $var = "ЛАЛА"; 
print lc($var),"\n"; 
} 

{ 
setlocale(LC_CTYPE,"en_US.ISO8859-1"); 
my $var = "TEST"; 
print lc($var),"\n"; 
} 

Разбор тегов в файле

<element>!</element> 
<element>!</element> 
<element>!</element> 
<element>!</element> 

<element>!</element> 
<element>!</element> 
<element>!</element> 

while ($data =~ s/<element>(.*?)</element>/) [ 
   $arr = $1; 
} 

@rrr = split(/<element>(.*?)</element>/,$data); 

О1. by Light_Elf

open FILE, "<$file"; 
push @data, (/<element>(.*?)</element>/)[0] while (<FILE>); 
close FILE; 

Работа со случайными и псевдослучайными числами

$a = 1; 
$b = 2; 
$c = 3; 
$d = 4; 

О1. by Arto

${qw(a b c d)[int rand(5)]} 

О2. by LeXa_NalBat

${[qw(a b c d)]}[rand(4)]

Определение и условная передача размера файла

если файл есть - получаем его размер 
если файла нет - print "Файла нет\n"; 
... # продолаем выполнять код 

О1. by Vlad

use strict; 

my $f_name = '/tmp/aaa.txt'; 

unless (-d $f_name) { 
   defined(my $f_size = (stat($f_name))[7]) or print "fila $f_name net"; 
   print $f_size; 
} else { 
   print "$f_name ne file"; 
} 

О2. by Whirlwind

use strict; 
my $f_name = 'c:\\test.pl'; 

print "$f_name ",(-f $f_name ? "file ".(-s $f_name)." bytes" :
   "not ".(-e $f_name ? "a file" : "exists" )); 

Выловить все ссылки из переменной

О1. by LeXa_NalBat

/http:\/\/\S+/g

Работа с датами в текстовой БД

01/01/2004blablalalala... 
02/01/2004blabla2lalala2... 
29/01/2004blabla3lalala3... 
30/01/2004blabla4lalala4... 

01/01/2004 lalala 
02/01/2004 lalala2 
..... 
29/01/2004 lalala3 
30/01/2004 lalala4 

О1. by Whirlwind

@a = qw( 
01/01/2004blablalalala... 
02/01/2004blabla2lalala2... 
29/01/2004blabla3lalala3... 
30/01/2004blabla4lalala4... 
); 

$beg_date = sd2nd("02/01/2004"); 
$end_date = sd2nd("29/01/2004"); 
foreach (@a){ 
     next unless /^((\d{2})\/(\d{2})\/(\d{4}))(.*)/; 
     $text = $5; 
     $date = $1; 
     next if sd2nd($date) < $beg_date; 
     last if sd2nd($date) > $end_date; 
     print "$date - $text\n"; 
} 

sub sd2nd{ 
     my $s = shift; 
     return unless $s =~ s#^(\d+)/(\d+)/(\d+)# 
           sprintf("%.04i%.02i%.02i",$3,$2,$1)#e; 
     $s; 
} 

Как определить имя хоста

О1. by biting

#!/usr/bin/perl
use Socket;
$ip="81.19.66.109";
@ip=split(/\./,$ip);
$host=gethostbyaddr(pack("C4",@ip), AF_INET);
print "$host\n";

О1. by Whirlwind

print (eval "use 'module.pm'" ? "Ok" : $@);

open(F,"+<$file") or die "Cannot open $file $!\n"; 
binmode(F) or die "Cannot binmode $file $!\n"; 
@D=<F>; 
seek(F,0,0); 
foreach(@D){ 
     s/шило/мыло/g; 
     print F; 
} 
truncate(F,tell(F)); 
close(F); 

Экспорт функций

О1. by Light_Elf

package my_package; 
use Exporter; 
@ISA     = qw(Exporter); 
@EXPORT  = qw(my_func); 

sub my_func {1}

Разбить число на триплеты

$_ = 100000000000000;
1 while s/(\d\d\d)(\d\d\d)(?!\d)/$1,$2/;
print

$_ = 4294967296;
# $i=3; $i+=4 while s#(.{$i})$#,$1#;
$i=3; $i+=4 while s#(.{$i})$#($`?",":"").$1#e;
print

Определить есть ли соединение по хэндлеру сокета

Вариант perl

use Socket;
...
if (getpeername(SOCK)){
       print "Есть соединение - работаем дальше\n";
}else{
       print "Нет соединения - удаляем сокет\n";
       ...
}
...

Определить дату начала и конца недели

Вариант perl

#!/usr/bin/perl -w
use strict;
my $dofw = (localtime)[6];
my $time = time;
my $inday = 86400;

print scalar(localtime(week_start())),"\n";
print scalar(localtime(week_end())),"\n";

sub week_start{
        return $time - $inday * $dofw;
}
sub week_end{
        return $time + $inday * (6 - $dofw);
}

Получить имена подпрограмм модуля

Вариант perl

#!C:/perl/bin/perl -w
use strict;

print join("\n",&get_sub_list);

sub go{}
sub test1{}

package sublist;
sub main::get_sub_list{
        no warnings;
        my ($code,@fn);
        foreach (keys(%main::)){
                next unless /^[\w_]/;
                push(@fn,$_) if eval("defined(*main::$_"."{CODE})");
        }
        use warnings;
        @fn
}

Получить постоянную последовательность чисел

Использование rand и srand

Самый простой вариант это использовать оператор rand на пару с srand. Встроенная функция srand выполняет инициализацию генератора случайных чисел. Передавая функции srand конкретное значение мы настраиваем генератор случайных чисел на заранее определенную последовательность. Убедится в этом нам поможет элементарный пример

Вариант perl

#!/usr/bin/perl -w
use strict;
rnd(5);
rnd(6);
rnd(1);
rnd(5);
sub rnd{
        my $v = shift;
        srand $v;
        for (my $i = 0; $i < 5; $i ++){
                print rand($v),"\n";
        }
        print "---------\n";
}

После выполнения программы мы увидем, что первая сгенерированная последовательность совпадает с последней.

Свой генератор

Для понимания принципа работы генератора можно рассмотреть следующий пример

Вариант perl

sub get_sequence{
        my ($n,$c) = @_;
        my @r;
        push(@r,int($c * $n + $n / 3.14 + $c))
                while ($c-- > 0);
        return @r;
}

Как видно из кода процедуры, работа алгоритма базируется на элементарной математике. В зависимости от специфики задачи можно изменить алгоритм рассчета числа и получать более сложную последовательность. Проверим работоспособность этой функции

Вариант perl

print join("\n",get_sequence(5,3)),"\n\n";
print join("\n",get_sequence(2,3)),"\n\n";
print join("\n",get_sequence(5,3)),"\n\n";

Получить случайное число

Примеры

Получение случайного целочисленного значения от 0 до 99

Вариант perl

$e = int(rand(100));

Выбор случайного элемента массива

Вариант perl

$e = $array[ rand @array ];

srand(time());

Для Perl версии 5.004 и выше нет необходимости вызывать функцию srand. Perl самостоятельно выполняет инициализацию генератора случайных чисел при первом вызове rand.

Сгенерировать случайную строку (пароль, идентификатор)

@cs = ("A".."Z","a".."z",0..9,qw/% ! @ $ ^ & * - _ = +/);
$pass = join("",@cs[map { rand @cs } (1..8) ]);

Ниже приведен пример функции, генерирующей строку случайных символов, пределы длины которой определяются двумя аргументами.

Вариант perl

#!C:/perl/bin/perl -w
use strict;

print gen(8,32);

sub gen{
        my ($min,$max,$len,@cs) = @_;
        $len = int(rand($max - $min + 1)) + $min;
        @cs = ("A".."Z","a".."z",0..9,qw/% ! @ $ ^ & * - _ = +/);
        join("",@cs[map { rand @cs } ($min..$len) ]);
}

Поменять местами ключи и значения хэш-массива

Используйте функцию reverse. Так как между контекстами хэша и обычного массива разница слишком абстрактна, reverse прекрасным образом проглатывает в качестве аргумента хэш-массив. С другой строны, любой массив с четным количеством элементов может быть легко преобразован в хэш массив. При этом, нечетные элементы станут ключами, а четные значениями.

%a = reverse %a;

Наверх