Параметры по ссылке
Массивы и хэши нужно передавать по ссылке , а не по значению .
sub makeone {
my @a = ( 1 .. 10 );
return \@a;
}
for ( 1 .. 10 ) {
push @many, makeone();
}
print $many[4][5], "\n";
print "@many\n";
Вообще говоря , нет .
Хотя есть решения - например
(http://www.activestate.com/Products/Perl_Dev_Kit/) от ActiveState
компилит байт-код , в частности по винду .
Perl2Exe (http://www.indigostar.com/perl2exe.htm) - тоже под винду .
# sum first and last fields
perl -lane 'print $F[0] + $F[-1]' *
# identify text files
perl -le 'for(@ARGV) {print if -f && -T _}' *
# remove (most) comments from C program
perl -0777 -pe 's{/\*.*?\*/}{}gs' foo.c
# make file a month younger than today, defeating reaper daemons
perl -e '$X=24*60*60; utime(time(),time() + 30 * $X,@ARGV)' *
# find first unused uid
perl -le '$i++ while getpwuid($i); print $i'
# display reasonable manpath
echo $PATH | perl -nl -072 -e '
s![^/+]*$!man!&&-d&&!$s{$_}++&&push@m,$_;END{print"@m"}'
http://www.perl.org/CGI_MetaFAQ.html
printf "%.2f", 10/3;
my $number = sprintf "%.2f", 10/3;
Perl понимает 8-ричную и 16-ную системы счисления .
В первом случае число должно начинаться с "0" , во втором с "0x".
Для конвертации в 10-ную систему можно использовать oct() и hex() .
Для конвертации из 10 в 8 можно использовать "%o" или "%O" sprintf() форматы.
Типичная ошибка :
chmod(644, $file); # WRONG
chmod(0644, $file); # right
Для округления нужно использовать sprintf() или printf() .
printf("%.3f", 3.1415926535); # prints 3.142
Модуль POSIX имплементирует ceil(), floor(), и ряд других функций.
use POSIX;
$ceil = ceil(3.5); # 4
$floor = floor(3.5); # 3
Пример :
for ($i = 0; $i < 1.01; $i += 0.05) { printf "%.1f ",$i}
0.0 0.1 0.1 0.2 0.2 0.2 0.3 0.3 0.4 0.4 0.5 0.5 0.6 0.7 0.7
0.8 0.8 0.9 0.9 1.0 1.0
Вызов функции для каждого элемента в массиве :
@results = map { my_func($_) } @array;
Например:
@triple = map { 3 * $_ } @single;
То же самое , но игнорировать результат :
foreach $iterator (@array) {
some_func($iterator);
}
Вызов для диапазона чисел :
@results = map { some_func($_) } (5 .. 25);
Или так :
for my $i (5 .. 500_005) {
push(@results, some_func($i));
}
will not create a list of 500,000 integers.
my $number = 10 + int rand( 15-10+1 );
Пример : random_int_in(50,120).
sub random_int_in ($$) {
my($min, $max) = @_;
# Assumes that the two arguments are integers themselves!
return $min if $min == $max;
($min, $max) = ($max, $min) if $min > $max;
return $min + int rand(1 + $max - $min);
}
$day_of_year = (localtime)[7];
Модуль POSIX :
use POSIX qw/strftime/;
my $day_of_year = strftime "%j", localtime;
my $week_of_year = strftime "%W", localtime;
Модуль Time::Local :
use POSIX qw/strftime/;
use Time::Local;
my $week_of_year = strftime "%W",
localtime( timelocal( 0, 0, 0, 18, 11, 1987 ) );
Модуль Date::Calc :
use Date::Calc;
my $day_of_year = Day_of_Year( 1987, 12, 18 );
my $week_of_year = Week_of_Year( 1987, 12, 18 );
use DateTime;
my $yesterday = DateTime->now->subtract( days => 1 );
print "Yesterday was $yesterday\n";
Модуль Date::Calc :
use Date::Calc qw( Today_and_Now Add_Delta_DHMS );
my @date_time = Add_Delta_DHMS( Today_and_Now(), -1, 0, 0, 0 );
print "@date\n";
s/\\(.)/$1/g;
s/(.)\1/$1/g;
my $str = 'Haarlem'; # in the Netherlands
$str =~ tr///cs; # Now Harlem, like in New York
Работающий пример :
# $_ есть строка для парсинга
@( = ('(','');
@) = (')','');
($re=$_)=~s/((BEGIN)|(END)|.)/$)[!$3]\Q$1\E$([!$2]/gs;
@$ = (eval{/$re/},$@!~/unmatched/i);
print join("\n",@$[0..$#$]) if( $$[-1] );
$reversed = reverse $string;
1 while $string =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e;
Модуль Text::Tabs :
use Text::Tabs;
@expanded_lines = expand(@lines_with_tabs);
Доступ к началу строки - substr().
$string = "Just another Perl Hacker";
$first_char = substr( $string, 0, 1 ); # 'J'
Для изменения произвольного куска строки эту функцию нужно использовать с 4 параметрами :
substr( $string, 13, 4, "Perl 5.8.0" );
Или :
substr( $string, 13, 4 ) = "Perl 5.8.0";
Например , нужно поменять "whoever" или "whomever" в
"whosoever" или "whomsoever". $_ - изменяемая строка :
$count = 0;
s{((whom?)ever)}{
++$count == 5 # is it the 5th?
? "${2}soever" # yes, swap
: $1 # renege and leave it there
}ige;
В цикле :
$WANT = 3;
$count = 0;
$_ = "One fish two fish red fish blue fish";
while (/(\w+)\s+fish\b/gi) {
if (++$count == $WANT) {
print "The third fish is a $1 one.\n";
}
}
Будет напечатано : "The third fish is a red one."
Например символ (X) с использованием tr///:
$string = "ThisXlineXhasXsomeXx'sXinXit";
$count = ($string =~ tr/X//);
print "There are $count X characters in the string";
Теперь другая задача - число отрицательных чисел :
$string = "-9 55 48 -2 23 -76 4 14 -44";
while ($string =~ /-\d+/g) { $count++ }
print "There are $count negative numbers in the string";
Или :
$count = () = $string =~ /-\d+/g;
Первый символ каждого слова заглавным :
$line =~ s/\b(\w)/\U$1/g;
"don't do it" -> "Don'T Do It".
Или :
$string =~ s/ (
(^\w) #at the beginning of the line
| # or
(\s\w) #preceded by whitespace
)
/\U$1/xg;
$string =~ /([\w']+)/\u\L$1/g;
Все символы заглавные :
$line = uc($line);
Первый символ слова заглавный , остальные - прописные :
$line =~ s/(\w+)/\u\L$1/g;
Имеется строка слов - удалить из нее запятые :
SAR001,"","Cimetrix,Inc","Bob Smith","CAM",N,8,1,0,7,"Error,Core Dumped"
Решение :
@new = ();
push(@new, $+) while $text =~ m{
"([^\"\\]*(?:\\.[^\"\\]*)*)",? # groups the phrase inside the quotes
| ([^,]+),?
| ,
}gx;
push(@new, undef) if substr($text,-1,1) eq ',';
В 2 приема :
s/^\s+//;
s/\s+$//;
В 1 прием :
s/^\s+|\s+$//g;
Для мульти-строчных строк :
$string =~ s/^\s+|\s+$//gm;
Или так :
$string =~ s/^[\t\f ]+|[\t\f ]+$//mg;
# Left padding a string with blanks (no truncation):
$padded = sprintf("%${pad_len}s", $text);
$padded = sprintf("%*s", $pad_len, $text); # same thing
# Right padding a string with blanks (no truncation):
$padded = sprintf("%-${pad_len}s", $text);
$padded = sprintf("%-*s", $pad_len, $text); # same thing
# Left padding a number with 0 (no truncation):
$padded = sprintf("%0${pad_len}d", $num);
$padded = sprintf("%0*d", $pad_len, $num); # same thing
# Right padding a string with blanks using pack (will truncate):
$padded = pack("A$pad_len",$text);
$padded = $pad_char x ( $pad_len - length( $text ) ) . $text;
$padded = $text . $pad_char x ( $pad_len - length( $text ) );
substr( $text, 0, 0 ) = $pad_char x ( $pad_len - length( $text ) );
$text .= $pad_char x ( $pad_len - length( $text ) );
# determine the unpack format needed to split Linux ps output
# arguments are cut columns
my $fmt = cut2fmt(8, 14, 20, 26, 30, 34, 41, 47, 59, 63, 67, 72);
sub cut2fmt {
my(@positions) = @_;
my $template = '';
my $lastpos = 1;
for my $place (@positions) {
$template .= "A" . ($place - $lastpos) . " ";
$lastpos = $place;
}
$template .= "A*";
return $template;
}
Есть строка :
$text = 'this has a $foo in it and a $bar';
eval { $text =~ s/(\$\w+)/$1/eeg };
die if $@;
Или так :
%user_defs = (
foo => 23,
bar => 19,
);
$text =~ s/\$(\w+)/$user_defs{$1}/g;
print "$var"; # BAD
$new = "$old"; # BAD
somefunc("$var"); # BAD
Правильно :
print $var;
$new = $old;
somefunc($var);
Неверно :
func(\@array);
sub func {
my $aref = shift;
my $oref = "$aref"; # WRONG
}
Пример :
@lines = `command`;
print "@lines"; # WRONG - extra blanks
print @lines; # right
Массив - array - имеет переменную длину . Список - list - нет .
(contributed by brian d foy)
Используйте hash.
my %hash = map { $_, 1 } @array;
# or a hash slice: @hash{ @array } = ();
# or a foreach: $hash{$_} = 1 foreach ( @array );
my @unique = keys %hash;
my @unique = ();
my %seen = ();
foreach my $elem ( @array )
{
next if $seen{ $elem }++;
push @unique, $elem;
}
Используя grep :
my %seen = ();
my @unique = grep { ! $seen{ $_ }++ } @array;
С помощью хэша :
@blues = qw/azure cerulean teal turquoise lapis-lazuli/;
%is_blue = ();
for (@blues) { $is_blue{$_} = 1 }
Теперь можно проверить наличие $is_blue{$some_color}.
Для массива целых чисел :
@primes = (2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31);
@is_tiny_prime = ();
for (@primes) { $is_tiny_prime[$_] = 1 }
# or simply @istiny_prime[@primes] = (1) x @primes;
Теперь проверяем $is_tiny_prime[$some_number].
Для чисел в диапазоне :
@articles = ( 1..10, 150..2000, 2017 );
undef $read;
for (@articles) { vec($read,$_,1) = 1 }
Теперь проверяем vec($read,$n,1) для $n.
($is_there) = grep /$whatever/, @array;
Или так :
$is_there = 0;
foreach $elt (@array) {
if ($elt eq $elt_to_find) {
$is_there = 1;
last;
}
}
if ($is_there) { ... }
И опять hash.
@union = @intersection = @difference = ();
%count = ();
foreach $element (@array1, @array2) { $count{$element}++ }
foreach $element (keys %count) {
push @union, $element;
push @{ $count{$element} > 1 ? \@intersection : \@difference }, $element;
}
$are_equal = compare_arrays(\@frogs, \@toads);
sub compare_arrays {
my ($first, $second) = @_;
no warnings; # silence spurious -w undef complaints
return 0 unless @$first == @$second;
for (my $i = 0; $i < @$first; $i++) {
return 0 if $first->[$i] ne $second->[$i];
}
return 1;
}
Для сложных структур используйте модуль CPAN FreezeThaw :
use FreezeThaw qw(cmpStr);
@a = @b = ( "this", "that", [ "more", "stuff" ] );
printf "a and b contain %s arrays\n",
cmpStr(\@a, \@b) == 0
? "the same"
: "different";
Для хэша :
use FreezeThaw qw(cmpStr cmpStrHard);
%a = %b = ( "this" => "that", "extra" => [ "more", "stuff" ] );
$a{EXTRA} = \%b;
$b{EXTRA} = \%a;
printf "a and b contain %s hashes\n",
cmpStr(\%a, \%b) == 0 ? "the same" : "different";
printf "a and b contain %s hashes\n",
cmpStrHard(\%a, \%b) == 0 ? "the same" : "different";
Находится первый элемент "Perl" :
use List::Util qw(first);
my $element = first { /Perl/ } @array;
Аналогично можно использовать List::Util:
my $found;
foreach ( @array )
{
if( /Perl/ ) { $found = $_; last }
}
С помощью индекса :
my( $found, $index ) = ( undef, -1 );
for( $i = 0; $i < @array; $i++ )
{
if( $array[$i] =~ /Perl/ )
{
$found = $array[$i];
$index = $i;
last;
}
}
Вообще говоря , такие списки в перле не особо инужны , поскольку мы и сами с помощью pop , shift ,unshift
можем делать с массивом все что нужно .
Но если уж сильно надо :
$node = {
VALUE => 42,
LINK => undef,
};
Теперь пробежимся :
print "List: ";
for ($node = $head; $node; $node = $node->{LINK}) {
print $node->{VALUE}, " ";
}
print "\n";
Добавление :
my ($head, $tail);
$tail = append($head, 1); # grow a new head
for $value ( 2 .. 10 ) {
$tail = append($tail, $value);
}
sub append {
my($list, $value) = @_;
my $node = { VALUE => $value };
if ($list) {
$node->{LINK} = $list->{LINK};
$list->{LINK} = $node;
} else {
$_[0] = $node; # replace caller's version
}
return $node;
}
Но опять же , это все от лукавого .
Используем for/foreach:
for (@lines) {
s/foo/bar/; # change that word
tr/XZ/ZX/; # swap those letters
}
Или:
for (@volumes = @radii) { # @volumes has changed parts
$_ **= 3;
$_ *= (4/3) * 3.14159; # this will be constant folded
}
или :
@volumes = map {$_ ** 3 * (4/3) * 3.14159} @radii;
Для хэша есть функция values :
for $orbit ( values %orbits ) {
($orbit **= 3) *= (4/3) * 3.14159;
}
Используйте pack() , unpack(), vec() .
Например:
$vec = '';
foreach(@ints) { vec($vec,$_,1) = 1 }
Дан вектор $vec, получаем массив @ints :
sub bitvec_to_list {
my $vec = shift;
my @ints;
# Find null-byte density then select best algorithm
if ($vec =~ tr/\0// / length $vec > 0.95) {
use integer;
my $i;
# This method is faster with mostly null-bytes
while($vec =~ /[^\0]/g ) {
$i = -9 + 8 * pos $vec;
push @ints, $i if vec($vec, ++$i, 1);
push @ints, $i if vec($vec, ++$i, 1);
push @ints, $i if vec($vec, ++$i, 1);
push @ints, $i if vec($vec, ++$i, 1);
push @ints, $i if vec($vec, ++$i, 1);
push @ints, $i if vec($vec, ++$i, 1);
push @ints, $i if vec($vec, ++$i, 1);
push @ints, $i if vec($vec, ++$i, 1);
}
} else {
# This method is a fast general algorithm
use integer;
my $bits = unpack "b*", $vec;
push @ints, 0 if $bits =~ s/^(\d)// && $1;
push @ints, pos $bits while($bits =~ /1/g);
}
return \@ints;
}
В цикле :
while($vec =~ /[^\0]+/g ) {
push @ints, grep vec($vec, $_, 1), $-[0] * 8 .. $+[0] * 8;
}
Используя модуль CPAN Bit::Vector:
$vector = Bit::Vector->new($num_of_bits);
$vector->Index_List_Store(@ints);
@ints = $vector->Index_List_Read();
Примеры с использованием vec():
# vec demo
$vector = "\xff\x0f\xef\xfe";
print "Ilya's string \\xff\\x0f\\xef\\xfe represents the number ",
unpack("N", $vector), "\n";
$is_set = vec($vector, 23, 1);
print "Its 23rd bit is ", $is_set ? "set" : "clear", ".\n";
pvec($vector);
set_vec(1,1,1);
set_vec(3,1,1);
set_vec(23,1,1);
set_vec(3,1,3);
set_vec(3,2,3);
set_vec(3,4,3);
set_vec(3,4,7);
set_vec(3,8,3);
set_vec(3,8,7);
set_vec(0,32,17);
set_vec(1,32,17);
sub set_vec {
my ($offset, $width, $value) = @_;
my $vector = '';
vec($vector, $offset, $width) = $value;
print "offset=$offset width=$width value=$value\n";
pvec($vector);
}
sub pvec {
my $vector = shift;
my $bits = unpack("b*", $vector);
my $i = 0;
my $BASE = 8;
print "vector length in bytes: ", length($vector), "\n";
@bytes = unpack("A8" x length($vector), $bits);
print "bits are: @bytes\n\n";
}
Используем each() :
while ( ($key, $value) = each %hash) {
print "$key = $value\n";
}
Для сортировки подходит foreach().
Создаем reverse hash:
%by_value = reverse %by_key;
$key = $by_value{$value};
Более эффективно :
while (($key, $value) = each %by_key) {
$by_value{$value} = $key;
}
Используем keys() :
$num_keys = keys %hash;
@keys = sort keys %hash; # sorted by key
@keys = sort {
$hash{$a} cmp $hash{$b}
} keys %hash; # and by value
Или так :
@keys = sort {
$hash{$b} <=> $hash{$a}
||
length($b) <=> length($a)
||
$a cmp $b
} keys %hash;
Если ключ $key присутствует в %hash, exists($hash{$key}) вернет true.
Значение для этого ключа может быть undef, в этом случае $hash{$key} будет undef хотя exists $hash{$key}
вернет true.
Пример %hash :
keys values
+------+------+
| a | 3 |
| x | 7 |
| d | 0 |
| e | 2 |
+------+------+
Далее
$hash{'a'} is true
$hash{'d'} is false
defined $hash{'d'} is true
defined $hash{'a'} is true
exists $hash{'a'} is true (Perl5 only)
grep ($_ eq 'a', keys %hash) is true
Поэтому
undef $hash{'a'}
теперь:
keys values
+------+------+
| a | undef|
| x | 7 |
| d | 0 |
| e | 2 |
+------+------+
и далее :
$hash{'a'} is FALSE
$hash{'d'} is false
defined $hash{'d'} is true
defined $hash{'a'} is FALSE
exists $hash{'a'} is true (Perl5 only)
grep ($_ eq 'a', keys %hash) is true
Теперь :
delete $hash{'a'}
тогда :
keys values
+------+------+
| x | 7 |
| d | 0 |
| e | 2 |
+------+------+
и далее :
$hash{'a'} is false
$hash{'d'} is false
defined $hash{'d'} is true
defined $hash{'a'} is false
exists $hash{'a'} is FALSE (Perl5 only)
grep ($_ eq 'a', keys %hash) is FALSE
Сначала извлекаем ключи из хэшей , затем удаляем дубликаты :
%seen = ();
for $element (keys(%foo), keys(%bar)) {
$seen{$element}++;
}
@uniq = keys %seen;
Или :
@uniq = keys %{{%foo,%bar}};
Или :
%seen = ();
while (defined ($key = each %foo)) {
$seen{$key}++;
}
while (defined ($key = each %bar)) {
$seen{$key}++;
}
@uniq = keys %seen;
LINUX