Programming-Idioms.org

print "Hello, world!\n";

say 'Hello World';

print "Hello\n" for 1 .. 10;

say "Hello" for 1 .. 10;

print "Hello\n" x 10;

sub some_procedure {
    print 'some side effect';
    return;
}

sub square {
    my ($i) = @_;
    return $i ** 2;
}

my $point = [ 1.5, 6.3 ];

my $point = { x => 1, y => 2 };

do_something($_) for @items;

for my $x (@items) {
     do_something($x);
     more_stuffs($x);
}

while (my ($i, $x) = each @items) {
    print "array[$i] = $x\n";
}

my %x = ( 
    name => 'Roboticus',
    'foo bar' => 'joe'
);

class Tree::Binary {
    has 'left', is => 'ro', isa => Maybe[InstanceOf['Tree::Binary']];
    has 'right', is => 'ro', isa => Maybe[InstanceOf['Tree::Binary']];
    has 'val', is => 'ro', isa => Int;
}
my $t = Tree::Binary->new(
    val => 42,
    left => Tree::Binary->new(val => 23),
    right => Tree::Binary->new(
        val => 1729,
        right => Tree::Binary->new(val => -1)
    )
);
__END__
      42
    ↙    ↘
  23     1729
 ↙  ↘   ↙    ↘
∅    ∅ ∅     -1

@shuffled = shuffle(@x);

my @x = ('a', 'list', 'of', 'random', 'items');
print $x[rand @x];

print "Found 'foo'\n" if grep {$_ eq $x} @list;

print "ok\n" if first {$_ eq $x} @list;

while (my ($k, $x) = each %mymap) {
    print "Key=$k, Value=$x\n";
}

printf "Key=%s, Value=%s\n",$_,$mymap{$_} foreach (sort keys %mymap);

my ($min, $max) = (1.5, 7.2);
my $x = $min + rand($max-$min);

my ($min, $max) = (5, 25);
my $val = $min + int(rand($max-$min));

sub dfs {
   my ($f, $bt) = @_;
   dfs($f, $bt->{left}) if exists $bt->{left};
   $f->($bt);
   dfs($f, $bt->{right}) if exists $bt->{right};
}

my $tree = {
           'Root' => {
                 'Child1' => {
                       'GrandChild1' => {},
                       'GrandChild2' => {}
                 },
                 'Child2' => {}
           }
};

sub depth_first_traversal {
   my ($f, $treenode) = @_;
   $f->($treenode);
   depth_first_traversal($f, $_) for @{$treenode->{children}};
}

my @list = ('words', 'of', 'list', 'a', 'reverse');
my @reversed = reverse @list;

sub search {
   my ($x, $m) = @_;
   while ( ($k1,$v1) = each @$m ) {
      while ( ($k2, $v2) = each @$v1 ) {
           return $k1, $k2 if $v2 == $x;
      }
   }
}

($a, $b) = ($b, $a);

my $i = $s + 0;

$s = sprintf "%.2f", $x;

my $s = 'ネコ';

my @queue :shared;

threads->create('my_task');
push @queue, 'Alan';
sleep 5;

sub my_task {
   while (1) {
      while (@queue) {
         print "Hello, ", (pop @queue), "\n";
      }
      sleep 1;
}

         
      

my @array = (
   [ 1.0, 0.0, 0.0 ],
   [ 0.0, 1.0, 0.0 ],
   [ 0.0, 0.0, 1.0 ],
   "first three slots are a 3x3 identity matrix",
   "fourth and fifth slots contain strings"
);
   

my $array3d = [
    [ [ 1, 0, 1 ],
      [ 0, 0, 0 ],
      [ 1, 0, 1 ] ],
    [ [ 0, 0, 0 ],
      [ 0, 2, 0 ],
      [ 0, 0, 0 ] ],
    [ [ 3, 0, 3, ],
      [ 0, 0, 0, ],
      [ 3, 0, 3, ] ]
];

my @x;
my ($m, $n, $p) = (4,3,2);
my $v = 0;

foreach my $mx (0..$m-1) {
    foreach my $nx (0..$n-1) {
        foreach my $px (0..$p-1) {
            $x[$mx][$nx][$px] = $v++;
        }
    }
}

@items = sort { $a->{p} cmp $b->{p} } @items;

$removed_element = splice @items, $i, 1;

for my $i (1 .. 1000) {
    threads->create('f', $i);
}

sub f {
   my $i = shift;
   return $i<2 ? 1 : $i * f($i-1);
}

sub exp {
   my ($x, $n) = @_;
   return 1 unless $n;
   return $x if $n == 1;
   return $x * exp($x*$x, ($n-1)/2) if $n%2;
   return exp($x*$x, $n/2);
}

sub exp {
   my ($x, $n) = @_;
   return undef if $x < 0 or $n < 0;
   return $x ** $n;
}

my $x :shared;
$x = 0;

sub my_task {
   my $id = shift;
   for (1 .. 5) {
      sleep 2*rand();
      { # lock scope
         lock($x);
         print "thread $id found $x\n";
         $x = $id;
         sleep 2*rand();
      }
   }
}

threads->create('my_task', $_) for 1 .. 3;
sleep 5 while threads->list(threads::running);

class T {}
class Set::Object::T extends Set::Object {
    method BUILDARGS(T @items) { return {data => \@items}; }
    method insert(T @items) { $self->next::method(@items); }
}
my $x = Set::Object::T->new(T->new, T->new, T->new);

sub compose {
   my ($f, $g) = @_;
   return sub {
      return $g->($f->(shift))
   }
}

sub double { return 2*shift }
sub triple { return 3*shift }
sub aFunc = compose(\&double, \&triple);
aFunc->(7);

sub compose {
   my ($f, $g) = @_;
   return sub {
      my $x = shift;
      return $g->($f->($x));
   }
}

sub curry {
   my ($func, $fixed_arg) = @_;
   return sub {
      $func->($fixed_arg, @_);
   }
}

my $chunk = substr("now is the time", $i, $j);

$ok = index($s,$word) >= 0;

my $G = Graph::Undirected->new(edges => [
    [1,3], [2,4], [3,4], [3,5], [4,5]
]);

my $s = 'cafe' . "\N{COMBINING ACUTE ACCENT}";
my $t = join '', reverse $s =~ /\X/g;

OUTER:
for my $v (@a) {
   for my $check (@b) {
      next OUTER if $v == $check;
   }
   print "$v not in the list\n";
}
      

OUTER: for my $row (@m) {
   INNER: for my $v (@$row) {
      if ($v < 0) {
         print "Negative value found: $v\n";
         last OUTER;
      }
   }
}

splice(@s, $i, 0, $x);

sleep 5;

my $t = substr($s,0,5);

use utf8;

my $t = substr($s, -5);

$s = "Perl normally allows
strings to contain newlines.";

$s =<<EOSTR;
One of the ways to create multiline text is called
the "here doc" (lifted from various UNIX shells).
A 'here doc' is the <<tag construct.  Perl continues to treat
all the text found as part of the string until there's a line containing
the EOSTR tag at the beginning
EOSTR

$s = q{
There are a good few ways to create multiline
text strings in perl.
};

@chunks = split /\s+/, $s;

while (1) {
   do_stuff();
}

say "" while True;

exists $m->{$k}

print "Found it!" if exists $m{$v};

$y = join(", ", @x)

$s = sum(@x);

my $s = "" . $i;

$s = "$i";

for my $i (1 .. 1000) {
    threads->create('f', $i);
}
sleep 3 while threads->list(threads::running);
print "Finished\n";

# optional: threads library wants you to explicitly join or detach
# your threads before exiting program.
$_->join() for threads->list(threads::joinable);

# You can use a subroutine as your predicate
@primes_less_than_100 = grep { is_prime($_) } 1 .. 99;

# You can also write your predicate inline
@odd_numbers = grep { $_%2 == 1 } 1 .. 99;

open my $fh, '<', $f;
my $lines = do { local $/; <$fh> };
close $fh;

print STDERR "$x is negative";

$x = $ARGV[0];

$d = time;

use Time::Piece;

$d = localtime;		# local time as a Time::Piece object
say $d->ymd;		# yyyy-mm-dd format
say $d->datetime;	# ISO 8601 format

$g = gmtime;		# GMT as a Time::Piece object

$d = time;

my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($d);

$i = index($x, $y);

my $x2 = $x =~ s/\Q$y/$z/gr;

$x = 3 ** 247;

my $s = sprintf '%.1f%%', $x * 100;

my ($x, $y) = (3 ** 200, 25);
my $z = $x ** $y;

sub binom {
   my ($n, $k) = @_;
   my $fact = sub {
      my $n = shift;
      return $n<2 ? 1 : $n * $fact->($n-1);
   };
   return $fact->($n) / ($fact->($k) * ($fact->($n-$k)));
}

sub binom {
  my ($n, $k) = @_;
  if ($k > $n - $k) { $k = $n - $k }
  my $r = 1;
  for ( my $i = $n/$n ; $i <= $k;) {
    $r *= $n-- / $i++
  }
  return $r
}

vec($x, $n, 1) = 0;

srand($s);

srand time;

print "@ARGV\n"

sub fact {
    my ($class, $str) = @_;
    return $class->new($str) if $class->$_isa('Parent');
}

sub gcd {
    my ($A, $B) = @_;
    return 0 == $B
        ? $A
        : gcd($B, $A % $B);
}

sub gcd {
	my ($x, $y) = @_;
	while ($x) { ($x, $y) = ($y % $x, $x) }
	$y
}
 
sub lcm {
	my ($x, $y) = @_;
	($x && $y) and $x / gcd($x, $y) * $y or 0
}

sub lcm {
	use integer;
	my ($x, $y) = @_;
	my ($f, $s) = @_;
	while ($f != $s) {
		($f, $s, $x, $y) = ($s, $f, $y, $x) if $f > $s;
		$f = $s / $x * $x;
		$f += $x if $f < $s;
	}
	$f
}

$s = sprintf "%b", $x;

my $x = 3*i - 2;
$x *= i;

my $x = cplx(-2, 3);
$x *= i;

do {
    doSomeStuff();
} while(c);

my $y = $x;

my $y = int($x);

my $y = int($x + 1/2);

my $t="banana bo bana bandana";

my $c =()= $t=~ m/ana/g;
print "count without overlap: $c\n";

$c =()= $t =~ m/an(?=a)/g;
print "count with overlap: $c\n";

my $r = qr/htt+p/;

# Not best, but simple:
$c=0;
while ($i) {
   $c += $i&1;
   $i /= 2;
}

$c = unpack '%b*', pack 'i', $i;

sub adding_will_overflow {
    my ($x, $y) = @_;
    return 'Inf' eq $x + $y;
}

sub multiply_will_overflow {
    my ($x, $y) = @_;
    return 'Inf' eq $x * $y;
}

exit 0;

my $buf = ' ' * 1_000_000;

die "Invalid argument $x";

class Foo {
    lexical_has 'x', isa => Int, accessor => \(my $_x), default => 0;
    method x() { return $self->$_x }
    method increment_x() { $self->$_x(1 + $self->$_x) }
}

my $str = read_file('data.json');
my $x = decode_json($str);

write_file('data.json', encode_json($x));

sub control {
    my $f = shift;
    $f->();
}

print ref($x)||"SCALAR", "\n";

my $x = -s $path;

$b = $prefix eq substr($s,0,length($prefix));

$b = $suffix eq substr($s, -length($suffix));

my $d = DateTime->from_epoch(epoch => $ts)->strftime('%F %T');

$x = strftime "%Y-%m-%d", localtime($d);

sub c {
 $a <=> $b;
}

my @result = sort c @items;

my $s = HTTP::Tiny->new->get($u)->{content};

my $response = HTTP::Tiny->new->mirror($u, 'result.txt');

my $x = XML::LibXML->load_xml(
location => 'data.xml');

$x->toFile('data.xml');

my $s = $0;

my $dir = getcwd();

my $dir = path($EXECUTABLE_NAME)->parent;

print $x;  # compile error

print $x if $main::{x}; # prints $x if it was declared


use strict 'vars';
# or
use v5.11; # or higher

print $x if $main::{x};  # unavoidable compile error

use Devel::Size qw(total_size);
my $n = total_size $t;

$blank = !$s || $s=~/^\s*$/;

system $x, 'a', 'b';

for my $k (sort keys %mymap) {
    my $x = $mymap{$k};
    say "$k => $x";
}

sub by_val_then_key {
    return ($mymap{$a} <=> $mymap{$b})
        or ($a cmp $b)
}

for my $k (sort by_val_then_key keys %mymap) {
   print "$k: $mymap{$k}\n";
}

for my $k (sort {($mymap{$a}<=>$mymap{$b}) or ($a cmp $b)}
           keys %mymap) {
   print "$k: $mymap{$k}\n";
}

my $b = Compare($x, $y);

my $b = d1 < d2;

my $s2 = $s1 =~ s/\Q$w//gr;

my $N = @x;

$n = scalar @x;

my %y = map {$_=>0} @x;

my @y = uniq @x;

@x = uniq(@x);

my $n = <> + 0;  # read a line from STDIN, add 0 to convert to int

my $p = 55555;
my $socket = IO::Socket::IP->new(
    LocalHost => 'localhost',
    LocalService => $p,
    Type => SOCK_DGRAM,
);
while () {
    $socket->read(my $B, 1024);
}

my %suit = (
    SPADES   => 1,
    HEARTS   => 2,
    DIAMONDS => 3,
    CLUBS    => 4,
);

assert { is_consistent };

sub binary_search {
    my ($x, $A, $lo, $hi) = @_;
    $lo //= 0;
    $hi //= @$A;
    my $mid = int($lo + ($hi - $lo) / 2);
    for ($x cmp $A->[$mid]) {
        use experimental 'switch';
        return $mid when 0;
        return -1 if 1 == $hi - $lo;
        return binary_search($x, $A, $lo, $mid) when -1;
        return binary_search($x, $A, $mid, $hi) when 1;
    }
}

# Some ordered arrays to search within.
@num_array =   ( 100, 200, 300, 400, 500 );
@str_array = qw( Bach Beethoven Brahms Mozart );
 
 
# Find the lowest index of a matching element.
 
$index = binsearch {$a <=> $b} 300, @num_array;
$index = binsearch {$a cmp $b} 'Mozart', @str_array;

sub foo {};
my $start = Benchmark->new;
foo;
my $t = timediff(Benchmark->new, $start)->[0] * 10**9; 

sub foo {
    return "bar", 1;
}

sub foo {
    do './foobody.txt';
}

sub bft {
    my ($f, $node) = @_;
    my @children = $node->getAllChildren;
    return unless @children;
    foreach my $child ( @children ) {
        $f->( $child->getNodeValue );
    }   
    foreach my $child ( @children ) {
        bft($f, $child);
    }
}

my $f = sub { print $_[0], "\n" };

# create a tree and populate it, then call bft()
bft($f, $tree);

my $iter = $tree->traverse($tree->LEVEL_ORDER);
while (my $v = $iter->()) {
    f($v);
}

my $iter = $tree->traverse;
while (my $v = $iter->()) {
    f($v);
}

if ($c1)    { $f1 }
elsif ($c2) { $f2 }
elsif ($c3) { $f3 }

sub f {};
my $start = Benchmark->new;
f;
print timestr timediff(Benchmark->new, $start);

my $ok = $s =~ /\Q$word/i;

my @items = ($a, $b, $c);

extract_first_by { $x eq $_ } @items;

my @filtered = grep { $x ne $_ } @items;

my $b = $s =~ /^\d*$/;

my $path = tempfile;

my $fh = tempfile();
# or
my ($fh, $filename) = tempfile();

my $path = tempdir;

delete $m{$k}; # also succeeds when $k does not exist in %m

print for @items1, @items2;

my $s = sprintf("%x", $i);

print for zip @items1, @items2;

my $b = -f $fp;

my $logline = sprintf "%s %s\n", localtime->strftime('%F %T'), $msg;

print $logline; # stdout
warn $logline; # stderr

my $f = $s;

($t = $s) =~ s/[^\x00-\x7f]+//g;

$t = decode('ascii', encode('ascii', $s, sub { return '' } ) );

@x = map {chomp; $_} <>;

$p =~ s{/$}{};

{ local $/='/'; chomp $p }

chomp $p, File::Spec->catdir('');

my $s = $c;

my $t = "$s$i";

my $t = $s . $i;

my @c1 = unpack 'xA2A2A2', $c1;
my @c2 = unpack 'xA2A2A2', $c2;
my $c = sprintf '#%02X%02X%02X', pairwise { (hex($a) + hex($b)) / 2 } @c1, @c2

unlink $filepath;

my $s = sprintf '%03d', $i;

const my $planet => 'Earth';

use constant planet => 'Earth';
use constant PI => 3.14159;
use constant { RED => 1, BLUE => 2, GREEN => 3 };

my @y = head $k, shuffle @x;

my $trie = Data::Trie->new;

if ($Config{archname} =~ '64') {
    f64;
} else {
    f32;
}

@elements = map {$_ * $c} @elements;

for (@ARGV) {
    use experimental 'switch';
    bat when 'b';
    fox when 'f';
}

foreach (pairs @list) {
   print "@$_\n";
}

my $b = open_browser $s;

my $x = $items[-1];

my $x = $items[$#items];

@ab = (@a, @b)

if (0 == index $s, $p) {
    my $t = substr $s, length $p;
}

if (length $s == rindex($s, $w) + length $w) {
    my $t = substr $s, 0, rindex $s, $w;
}

my $n = length( $s );

my $n = keys %mymap;

push @s, $x;

$m{$k} = $v;

 sub commify {
    local $_  = shift;
    1 while s/^([-+]?\d+)(\d{3})/$1,$2/;
    return $_;
}

perl -Mojo -E 'my $u = "www.example.com"; say p($u)->body;'

# Create a user agent object

my $ua = LWP::UserAgent->new;
 
# Create a request
my $req = HTTP::Request->new(POST => $u);
 
# Pass request to the user agent and get a response back
my $res = $ua->request($req);
 
# Check the outcome of the response
if ($res->is_success) {
    print $res->content;
}
else {
    print $res->status_line, "\n";
}

my $response = `curl -X POST $u`;

$s = unpack('H*', pack('c*', @a));

my @a = split '', pack 'H*', $s;

my @L;
find(sub {
  push @L, $File::Find::name
     if /(.jpg|.jpeg|.png)$/;
}, $D);

sub insideRect($x1,$y1,$x2,$y2, $px,$py) {
    return
            $x1 <= $px and $px <= $x2
        and $y1 <= $py and $py <= $y1
}

my @c = (($x1 + $x2) / 2, ($y1 + $y2) / 2);

opendir my $dh, $d or die "Could not open $d for reading: $!\n";
@x = readdir $dh;
closedir $dh;

my @x = map {basename $_} glob("$d/*");

$_=q(print"\$_=q($_);eval;");eval;

my $response = HTTP::Tiny->new->put($u, {content => $http_request_body});

my $dt = DateTime->today;
$dt->add(days => 1);
my $t = $dt->strftime('%F');

$t = DateTime->today->add(days => 1)->ymd;

local $SIG{ALRM} = sub { f(42) };
alarm 30;

my $thr = threads->create(sub { sleep(30); f(42); });
$thr->detach();

my $thr = threads->create(sub { sleep(30); f(42); });
$thr->join()

exit;

my @vert = (1..5);
my @edges = ( [1, 2], [2, 3], [4, 5] );

$uf->add( $_ )   for @vert;
$uf->union( $_ ) for @edges;

# find and consolidate partitions into a hash
my %part;
foreach my $v( @vert ) {
    my @pa = $uf->find($v);
    my $p = shift @pa;
    $part{$p} //= [];
    push @{ $part{$p} }, $v;
}

foreach my $k (sort keys %part) {
    my $vals = join ' ', @{ $part{$k} };
    say "$k : $vals";
}
# prints:
#   2 : 1 2 3
#   5 : 4 5

my ($nx, $ny, $nz) = (2, 3, 4);
my $A = sequence $ny, $nx;
my $B = sequence $nz, $ny;
my $C = matmult $A, $B;

my @y = map { T($_) } grep { P($_) } @x;

FFI::Platypus
    ->new(lib => '/tmp/mylib/libmylib.so')
    ->attach(foo => ['double[]', 'int']);
foo([1..10], 10);

f if any { $_ > $x } @a;

my $a = 12345678901234567890.1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890;

my ($m, $n) = (3, 2);
my $A = sequence $m, $n;
my $B = transpose $A;

my @a = (
    ['a' .. 'g'],
    ['h' .. 'm'],
    ['n' .. 'z']
);
my $n = 5;
my @b = map {
    my @c = @$_;
    push @c, splice @c, 0, $n;
    \@c;
} @a;
__END__
@b = (
    ['f', 'g', 'a' .. 'e'],
    ['m', 'h' .. 'l'],
    ['s' .. 'z', 'n' .. 'r']
)

sub foo {
    my ($A) = @_;
    my $i_size = @$A;
    my $j_size = max map { 0 + @$_ } @$A;
    printf "dimensions: %d %d\n", $i_size, $j_size;

    my $s;
    for my $i (1 .. $i_size) {
        for my $j (1 .. $j_size) {
            $s += $A->[$i - 1][$j - 1] * $i * $j;
        }
    }
    printf "sum: %f\n", $s;
}

$n=25;
$m=15;

$A[$n-1] = undef;         # autovivify @A to length $n

sub foo  {
    my ($aref, @i) = @_;
    @$aref[@i] = (42) x @i;
    return;
}

foo(\@A, grep { 0 == $_ % 2 } 0 .. $m);

use Data::Dumper;
print Dumper(@A);

my $n = 25;
my $m = 16;

my $a = [ 0..$n-1 ];            # create list reference

sub foo  {
    my ($aref, @idx) = @_;      # unpack sub arguments
    foreach my $i ( @idx ) {
        $aref->[$i] = 42;       # dereference element using ->
    }
}

my @subarray;                   # create list
for ( my $i=0; $i < $m; $i += 2 ) {
    push @subarray, $a->[$i];   # dereference element using ->
}

foo($a, @subarray);             # pass list reference and list

print join ', ', @{ $a };       # deref

my @lines = path($path)->lines;

exit $x;

my $F = path('F')->openrw;
# ... read some from $F to advance
# position of file handle (not shown) ...
truncate $F, tell $F;

my $h = hypot $x, $y;

my $data = [5.0, 4.0, 3.0, 2.0, 1.0];
my $n = gsl_blas_dnrm2(Math::GSL::Vector->new($data)->raw);

my $s = sum map { $_ ** 2 } @data;

my $m = mean @data;
my $s = stddev @data;

my ($mantissa, $exponent) = frexp $a;
printf "%f %d\n", $mantissa, $exponent;

my $foo = $ENV{FOO} // 'none';

my %proc = map { $_ => \&$_ } qw(foo bar baz barfl);
$proc{$str}->() if exists $proc{$str};

{
    my @a = (undef) x $n;
    # scope ends at closing brace
} 

$a[$_] = $e * ($a[$_] + $b[$_] * $c[$_] + cos $d[$_]) for 0 .. $#a;

class T {
    has 's', is => 'ro', isa => Str;
    has 'n', is => 'ro', isa => ArrayRef[Int];
}

{
    my $v = T->new(s => 'Hello, world!', n => [1,4,9,16,25]);
    # deallocation happens at closing brace, see explanation
}

my $version = $Config{version};
my $version_for_humans = $Config{version_patchlevel_string};
my %options = %Config{qw(config_args cccdlflags ccdlflags ccflags lddlflags libs)};

$version = "$]";

path($path)->mkpath;

my $b = -e -d $path;

my @strings = ('ᾲ στο διάολο', 'ὰι στο διάολο', 'Ὰͅ ΣΤΟ ΔΙΆΟΛΟ', 'ᾺΙ ΣΤΟ ΔΙΆΟΛΟ');
my @indices = (
    [0,1], [0,2], [0,3],
    [1,0], [1,2], [1,3],
    [2,0], [2,1], [2,3],
    [3,0], [3,1], [3,2]
);
for my $tuple (@indices) {
    ok $strings[$tuple->[0]] =~ qr"\Q$strings[$tuple->[1]]"i;
}
done_testing;

$s = length($s) >= $m ? $s : $s . $c x ( $m-length($s) );

$s .= $c x ($m - length $s)

$s = $c x ($m - length($s)) . $s;

my $total_padding = $m-length($s);
if( $total_padding ) {
   my $l = int($total_padding/2);
   my $r = $total_padding-$l;
   $s = join "", ($c x $l), $s, ($c x $r);
}

sub center {
    my ($s, $m, $c) = @_;
    my $slen = length $s;
    return $s if $slen > $m;
    $c //= ' ';
    my $r = $c x $m;
    my $p = int($m/2 - $slen/2);
    substr($r, $p, $slen, $s);
    return $r;    
}

print center("abcd",10,"X");

my @list = ( 'file_A.txt', 'file_B.txt' );

zip \@list => 'name.zip'
    or die "zip failed: $ZipError\n";

my %u;
$u{$_} = 1 for @a, @b;
my @c = keys %u;

my $t = $s;
$t =~ s/ +/ /g;

my $t = $s;
$t =~ s/\s+/ /g;

use constant t => (1, 'two', 3.5);

my $t = $s;
$t =~ s/\D+//g;

($t = $s) =~ tr/0-9//cd;

$i = -1;
$index = 0;
foreach (@items) {
    $i = $index, last if $x eq $items[$index];
    $index++;
}

my $found_match = 0;
foreach my $item (@items) {
    if ($item eq 4) {
        print "Found $item\n";
        $found_match = 1;
        last;
    }
}
if (!$found_match) {
    print "Didn't find what I was looking for\n";
}

unshift @items, $x

sub f {
    my $x = shift;
    if (defined $x) {
        print("Present $x\n");
    }
    else {
        print("Not Present\n");
    }
}

pop(@items);

my @y = @x; # for simple arrays

# for complex arrays with references:
my @y = @{dclone(\@x)};

cp($src, $dst) or die $!;

my $coro = async {
   # do work
};
 
$coro->cancel;  # or $coro->safe_cancel

my $p = Coro->new( sub { ... } );
$p->ready;

my $start = time;
for (1..100) {
    cede;
    if ( (time - $start) > 5 ) {
        $p->cancel;        
        last;
    }
}

$b = utf8::is_utf8($s);

#!/usr/bin/perl -s

use strict;
use warnings;
use vars qw($v);

$v ||= 0;

print 'verbose is ' . ($v ? 'true' : 'false') . "\n";

my $country = 'Canada';
GetOptions("country=s" => \$country) or die("Error in command line args\n");
print "Country is $country\n";

$encoded = encode_base64('Aladdin:open sesame');
$decoded = decode_base64($encoded);

my @s = decode_base64($data);

my $a = Math::BigRat->new(  '1_000_000_000_000_000_000' );
my $b = Math::BigRat->new( '10_000_000_000_000_000_000' );
my $q = $a / $b;

say $q;  # prints 1/10

my $c = $a ^ $b;

$c = $a ^. $b;

my ($x) = $s =~ /\b(\d{3})\b/;

@keys = qw(x y a f e n);
@vals = qw(1 2 3 4 5 6);

pairmap { push @new_keys, $a; push @new_vals, $b }
    unpairs 
        sort { $a->[0] cmp $b->[0] } 
            zip \@keys, \@vals;

sub busywork { print 'busy' };

my $n = 12;

my $th_sub = sub {
    my ($limit) = @_;
    foreach ( 1 .. $limit ) {
       print '.';
       cede;
    }
};

my $th = Coro->new( $th_sub, $n );

$th->ready;

foreach my $ii ( 1 .. $n ) {
    if ( $ii == int $n * 2/3 ) {
        $Coro::current->prio(-1);
        cede;
        busywork();
    }
    print '-';
    cede;
}

f($_) for @x;

print "@items\n";

print join(', ', @items) . "\n";

print "$_: $m{$_}\n" for keys %m;

class Point {
    has $x :param = 0;
    has $y :param = 0;
    
    use overload '""' => sub { shift->_stringify() };   

    method _stringify () { "A point at ($x, $y)"  }
}
 
my $p = Point->new(x => 5, y => 10);

print $p; # prints: A point at (5, 10)

package Point { 
    my $_data = {};
    
    sub new { 
        my $class = shift;
        $_data = { @_ };
        bless $_data, $class;
    };

    use overload '""' => sub { shift->_stringify() };

    sub _stringify {
        my $self = shift;
        return sprintf 'A point at (%d, %d)', $self->{x}, $self->{y};
    }
}
 
my $p = Point->new(x => 5, y => 10);
print $p;

my $c = scalar(uniq @items);

@x = grep { p($_) } @x;

$d = ($s?-1:1) * "${m}e${e}"; 

my ($a, $b, $c) = (1, '2', 'three');

@vals = values %m;
$x = $vals[ int rand @vals ];

$i = oct('0b' . $s);

my $x = condition() ? "a" : "b";

cluck 'print this message and a full stack track';

map { s/^foo$/bar/g } @x;

print "$_\n" for @x;

print "$_\n" for reverse (0..5);

for ($i = $#items; $i >= 0; $i--) {
    print "$i $items[$i]\n";
}

@b = map { $_ += 0 } @a

my @parts = split(/[,\-_]/, $s);

my @items;
# or
my @items = ();

$d = DateTime->now; 
$x = $d->hms;

$s = sprintf '%b', $n; 
$n = length $s; 
$t++ while !substr($s, --$n, 1) && $n >= 0; 

$t = sprintf('%b', $n) =~ /(0+)$/ ? length($1) : 0;

sub log2d { floor log2 shift };

sub log2u { ceil log2 shift };

sub foo {
    my ($a) = @_;
    return scalar @{ $a }, scalar @{ $a->[0] };
}

my $a = [[1,2,3], [4,5,6]];
printf "%d %d\n", foo($a);

$p = ($count = @ones = (sprintf '%b', $i) =~ /1/g) % 2;

my $s = $v x $n;

sub foo {
    my ($x) = @_;
    return 'Nothing' if ref $x ne '' or looks_like_number($x);   
    return $x;
}

$\ = "\n"; # print with newline
say foo( [] );
say foo( 42 );
say foo( 'Hello World' );

sub foo {
    my ($s, $x) = @_;
    return 'is undefined'   if not defined $x;
    return 'is a reference' if ref $x ne '';
    return 'is a number'    if looks_like_number $s;
    return 'is a string';
}

class Vector {
    has $x :accessor;
    has $y :accessor;
    has $z :accessor;

    BUILD { ($x, $y, $z) = @_ }

    use overload 'x' => sub { shift->xprod(shift) };

    method xprod ($v) {
        return Vector->new(
            $self->y * $v->z - $self->z * $v->y,
            $self->z * $v->x - $self->x * $v->z,
            $self->x * $v->y - $self->y * $v->x,
        );
    }
}

my $a = Vector->new(3, 4, 5);
my $b = Vector->new(5, 10, 1);
my $cross = $a x $b;

package Vector {
    sub new {
        my ($class, $x, $y, $z) = @_;
        bless [$x,$y,$z], $class;
    }
    sub x { shift->[0] };
    sub y { shift->[1] };
    sub z { shift->[2] };
    
    use overload 'x' => sub { shift->xprod(shift) };

    sub xprod {
        my ($self,$v) = @_;
        return Vector->new(
            $self->y * $v->z - $self->z * $v->y,
            $self->z * $v->x - $self->x * $v->z,
            $self->x * $v->y - $self->y * $v->x,
        );
    }
}

use enum qw(bike car horse);

my $e = horse;
print $e;

use enum     qw(bike car horse);
my @enum_T = qw(bike car horse);

my $e = horse;
my $s = $enum_T[$e];
print $s;

my @r = (nan, nan, 1.234);

setpayloadsig $r[1],'999';

foreach my $r1 ( @r ) {
    if ( isnan $r1 ) {
        printf "This is a %s NaN\n",
            issignaling($r1) ? 'signaling' : 'quiet';
    } else {
        printf "This is not a NaN: %s\n", $r1;
    }
}

# Output:
# This is a quiet NaN
# This is a signaling NaN
# This is not a NaN: 1.234

sub tst {
    my ($x) = @_;

    if ( $x->isa('Foo') ) {
        say "Same type";
    }
    elsif ( $x->isa('FooExt') ) {
        my $issubclass = grep { $_ eq 'Foo' } @FooExt::isa;
        say $issubclass ? "Extends type" : "Same type";
    }
    else {
        say "Not related"
    }
}

for my $i ( 1 .. 100 ) {
    print $i % 3 ? '' : 'Fizz';
    print $i % 5 ? '' : 'Buzz';
    print $i % 3 && $i % 5 ? $i : '';
    print "\n";
}

opendir(my $dh, $p) || die($!);
my $b = scalar(grep { !/^[\.]{1,2}$/ } readdir($dh)) ? 1 : 0;
closedir($dh);

my $t = $s;
$t =~ s/\s*//g;

my $s = '1000' . '0010' . '0101' . '1010';   # AZ

my @a;
for ( my $i = 0; $i < length $s; $i += 8) {
    my @b = pack 'b8', substr($s, $i, 8);
    push @a, @b;
}