# ======================================================= 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
[download]