# =======================================================
use strict;
use warnings;
use Data::Dumper;
#________________________________________________________
#String
{
local $\ = "\n";
print "\nSTRING";
my($s, $t, @s) = ("Hello world", "o", ());
print index($s, $t, 4); # 4 (eq index($s,$t);)
print index($s, $t, 5); # 7
print rindex($s, $t, 7); # 7 (eq rindex($s,$t);)
print rindex($s, $t, 6); # 4
print substr($s, 6, 5); # world (eq substr($s,6);)
print substr($s, 7, 2); # or (eq substr($s,-4,2);)
substr($s, 7, 2) = 'and'; print $s; # Hello wandld
@s = split ' ', $s;
print sprintf("%s %s", reverse @s); # wandld Hello
# $s = pack("format", $x);
}
#________________________________________________________
#List
{
local $\ = "\n";
print "\nLIST";
print( () ? 'full' : 'empty');
print (1..5);
my $a=1; my $b=5;
print ($a..$b);
print ('a'..'e');
print qw(a b c d e);
}
#________________________________________________________
#Array
{
local $\ = "\n";
print "\nARRAY";
my (@a, @b, $ra, @i);
@a = (3); # obs: list ()
$ra = [3]; # ref. anon []
unshift(@a, 0..2);
push(@a, 4,5,"6\n");
chomp(@a);
# ***splice!***
@a[2..3]= reverse @a[2..3]; # ($a[3],$a[2])=($a[2],$a[3]);
print "@a"; # 0 1 3 2 4 5 6
@a = sort @a;
print join '-', (shift(@a), "@a[0..$#a-1]", pop(@a), );
# 0-1 2 3 4 5-6
# Slice
@a = (1..9);
@i = (0..2); # or qw(0 1 2)
@b = ('y', @a[@i], 'z');
print "@b"; # y 1 2 3 z
@a[1,2] = qw(a b);
print "@a"; # 1 a b 4 5 6 7 8 9
#($uid, $gid) = (stat $file)[4,5]
# Count / Len
print scalar(@a), " $#a"; # 9 8
print "$a[-1] $a[$#a]"; # 9 9
}
#________________________________________________________
#Hash
{
local $\ = "\n";
print "\nHASH";
my (%h1, %h2, %h3, $rh, @a, @k, @v, $k, $v);
%h1 = ( k1 => 'v1' , k2 => 'v2' , ); # obs: list ()
$rh = { k5 => 'v5' , k6 => 'v6' , }; # ref. anon {}
%h2 = qw(k3 v3 k4 v4 k5 v5);
delete $h2{'k4'};
# Slice (returns a value LIST)
@a = (%h1, %h2); # unwind and
%h3 = @a; # rewind (slow...)
print "un/rewind ", map "$_:$h3{$_} ", sort keys %h3;
# un/rewind k1:v1 k2:v2 k3:v3 k5:v5
%h3 = (); %h3 = %h1;
@k = keys %h2; # $num = keys %h3;
@v = values %h2;
@h3{@k} = @v; # merge
print "key/value ", map "$_:$h3{$_} ", sort keys %h3;
# key/value k1:v1 k2:v2 k3:v3 k5:v5
print "each key"; while( ($k,$v)=each %$rh) { print "\t$k:$v"; }
%$rh = reverse %$rh;
print "each val"; while( ($k,$v)=each %$rh) { print "\t$k:$v"; }
}
=cut
#________________________________________________________
Ref (explicit or anon.)
$rA = \@A; # or $rA = ['x', 'y];
$rH = \%H; # or $rH = { k => 'v' };
$rS = \&S; # where: sub S{}; or $rS = sub { print 'S'; }
DeRef
@A = @$rA; $a1 = $rA->[1];
%H = %$rH; $Ht = $rH->{t};
&$rS; # or $rS->(args);
#________________________________________________________
Map (BLOCK LIST or EXPR,LIST)
@sqr1 = map { $_ * $_} @num;
@sqr2 = map {$_, $_*$_} @num;
%sqr3 = map {$_, $_*$_} @num;
print map "$_: $h{$_}\n", sort keys %h;
Grep (BLOCK LIST or EXPR,LIST )
@odd = grep {$_ % 2 } @int;
@foo = grep(!/^#/, @bar); # exclude comments
@foo = grep {!/^#/} @bar; # equiv.
Split, Join
my ($login, $passwd, $remainder) = split(/:/, $_, 3);
@fields = split(/[,-]/, "1-10,20", 3); # (1, 10, 20)
@fields = split(/([,-])/, "1-10,20", 3); # (1,'-',10,',',20)
@fields = split /(A)|B/, "1A2B3"; # (1,'A',2,undef,3)
print join(':', split(/ /, 'hi ho')); # hi:ho
#________________________________________________________
Foreach
foreach (@a @b) { process $_; }
foreach my $a (@a) { process $a; }
CmdLine
perl -i.bak -pe 's/x/y/g' input.txt # p:loop&print
Filter
@ARGV = ('testfile');
while (<>) { chomp; munge($_) } # munger < in > out
File
Glob
while(defined($file = <$DIR\*.ext>)) {} # glob("$DIR\*.ext")
opendir(DIR,'.'); @files = glob(/\.ext/, readdir(DIR));
unlink <*.bak>;
Unbuffer
select((select(FILE), $| = 1)[0];
# my $file = select FILE; $| = 1; select $file;
Slurp
{
local $/ = undef; # file slurp
local $/ = ''; # paragraph slurp
local $/ = \1024; # record slurp (1KB)
my $data = <FILE>; # $calar slurp
}
chomp(@data = <FILE>); # @rray slurp
while (chomp($line=<FILE>)) { }; # line loop
#________________________________________________________
RegEx
my $re2 = qr/(?:xxx)/; # non-capturing
$text =~ s/$re/'yyy'/o;
#________________________________________________________
=cut
#________________________________________________________
#Sort
print "\nSORT\n";
my (@in1, @in2, @in3, @out);
@in1 = qw(173.0.20.0 120.30.30.4 100.100.20.21);
@out = sort @in1; # sort {$a cmp $b} @in; # lexically
print "lex: @out\n"; # 100.100.20.21 120.30.30.4 173.20.0.0
# numerically; obs: map $_ aliases elements in @in1 !
@out = sort {$a <=> $b} map { (my $x=$_) =~ s/\.//g; $x } @in1;
print "num: @out\n"; # 1732000 12030304 1001002021
@in2 = @in1; @in2 = map {s/\.//g; $_} @in2; # nondestr. to @in1
@out = sort {$b <=> $a} @in2; # reverse num
print "rev.num: @out\n"; # 1001002021 12030304 1732000
@in3 = map { [split /\./] } @in1 ; # on record fields
@out = sort on_2_0 @in3;
sub on_2_0 { return $a->[2] cmp $b->[2] ||
$a->[0] cmp $b->[0] }
print "fields: @{$out[0]} - @{$out[1]} - @{$out[2]}\n";
# 100 100 20 21 - 173 0 20 0 - 120 30 30 4
# Orcish manoeuvre (cache or get)
sub get { $_[0]->[1]; } # get sort key from rec
my %cache;
sub orcish { return ($cache{$a} ||= get($a))
<=> ($cache{$b} ||= get($b)); }
@out = sort orcish @in3;
print "orcish1: @{$out[0]} - @{$out[1]} - @{$out[2]}\n";
use Memoize;
memoize 'get'; # will do the caching
sub orcish2 { get($a) <=> get($b); }
@out = sort orcish @in3;
print "orcish2: @{$out[0]} - @{$out[1]} - @{$out[2]}\n";
# 173 0 20 0 - 120 30 30 4 - 100 100 20 21
# Schwartzian transform (precalc. sort keys)
@out = map { $_->[1] }
sort { $a->[0] <=> $b->[0] }
map { [$_->[1], $_] } @in3;
print "Sch: @{$out[0]} - @{$out[1]} - @{$out[2]}\n";
# 173 0 20 0 - 120 30 30 4 - 100 100 20 21
# Guttman-Rosler transform (packed-default sort)
@out = map { substr($_, 4) }
sort
map { pack('C4', /((\d+)\.){4}/) . $_ } @in1;
print "G-R: @out\n";
# 100.100.20.21 120.30.30.4 173.0.20.0