The snippets are under the CC-BY-SA license.

Creative Commons Attribution-ShareAlike 3.0


  • The snippets are under the CC-BY-SA license.
  • Please consider keeping a bookmark
  • (instead of printing)
Print a literal string on standard output
print "Hello, world!\n";
Alternative implementation:
say 'Hello World';
Loop to execute some code a constant number of times
print "Hello\n" for 1 .. 10;
Alternative implementation:
say "Hello" for 1 .. 10;
Alternative implementation:
print "Hello\n" x 10;
Like a function which doesn't return any value, thus has only side effects (e.g. Print to standard output)
sub some_procedure {
    print 'some side effect';
Create a function which returns the square of an integer
sub square {
    my ($i) = @_;
    return $i ** 2;
Declare a container type for two floating-point numbers x and y
my $point = [ 1.5, 6.3 ];
Alternative implementation:
my $point = { x => 1, y => 2 };
Do something with each item x of the list (or array) items, regardless indexes.
do_something($_) for @items;
Alternative implementation:
for my $x (@items) {
Print each index i with its value x from an array-like collection items
while (my ($i, $x) = each @items) {
    print "array[$i] = $x\n";
Create a new map object x, and provide some (key, value) pairs as initial content.
my %x = ( 
    name => 'Roboticus',
    'foo bar' => 'joe'
The structure must be recursive because left child and right child are binary trees too. A node has access to children nodes, but not to its parent.
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)
    ↙    ↘
  23     1729
 ↙  ↘   ↙    ↘
∅    ∅ ∅     -1
Generate a random permutation of the elements of list x
@shuffled = shuffle(@x);
The list x must be non-empty.
my @x = ('a', 'list', 'of', 'random', 'items');
print $x[rand @x];
Check if the list contains the value x.
list is an iterable finite container.
print "Found 'foo'\n" if grep {$_ eq $x} @list;
Alternative implementation:
print "ok\n" if first {$_ eq $x} @list;
Access each key k with its value x from an associative array mymap, and print them.
while (my ($k, $x) = each %mymap) {
    print "Key=$k, Value=$x\n";
Alternative implementation:
printf "Key=%s, Value=%s\n",$_,$mymap{$_} foreach (sort keys %mymap);

Pick a random number greater than or equals to a, strictly inferior to b. Precondition : a < b.
my ($min, $max) = (1.5, 7.2);
my $x = $min + rand($max-$min);
Pick a random integer greater than or equals to a, inferior or equals to b. Precondition : a < b.
my ($min, $max) = (5, 25);
my $val = $min + int(rand($max-$min));
Call a function f on every node of binary tree bt, in depth-first infix order
sub dfs {
   my ($f, $bt) = @_;
   dfs($f, $bt->{left}) if exists $bt->{left};
   dfs($f, $bt->{right}) if exists $bt->{right};
The structure must be recursive. A node may have zero or more children. A node has access to its children nodes, but not to its parent.
my $tree = {
           'Root' => {
                 'Child1' => {
                       'GrandChild1' => {},
                       'GrandChild2' => {}
                 'Child2' => {}
Call a function f on every node of a tree, in depth-first prefix order
sub depth_first_traversal {
   my ($f, $treenode) = @_;
   depth_first_traversal($f, $_) for @{$treenode->{children}};
Reverse the order of the elements of the list x.
This may reverse "in-place" and destroy the original ordering.
my @list = ('words', 'of', 'list', 'a', 'reverse');
my @reversed = reverse @list;
Implement a function search which looks for item x in a 2D matrix m.
Return indices i, j of the matching cell.
Think of the most idiomatic way in the language to return the two values at the same time.
sub search {
   my ($x, $m) = @_;
   while ( ($k1,$v1) = each @$m ) {
      while ( ($k2, $v2) = each @$v1 ) {
           return $k1, $k2 if $v2 == $x;
Swap the values of the variables a and b
($a, $b) = ($b, $a);
Extract the integer value i from its string representation s (in radix 10)
my $i = $s + 0;
Given a real number x, create its string representation s with 2 decimal digits following the dot.
$s = sprintf "%.2f", $x;
Declare a new string s and initialize it with the literal value "ネコ" (which means "cat" in japanese)
my $s = 'ネコ';
Share the string value "Alan" with an existing running process which will then display "Hello, Alan"
my @queue :shared;

push @queue, 'Alan';
sleep 5;

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

Declare and initialize a matrix x having m rows and n columns, containing real numbers.
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"
Declare and initialize a 3D array x, having dimensions boundaries m, n, p, and containing real numbers.
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, ] ]
Alternative implementation:
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++;
Sort the elements of the list (or array-like collection) items in ascending order of x.p, where p is a field of the type Item of the objects in items.
@items = sort { $a->{p} cmp $b->{p} } @items;
Remove i-th item from list items.
This will alter the original list or return a new list, depending on which is more idiomatic.
Note that in most languages, the smallest valid value for i is 0.
$removed_element = splice @items, $i, 1;
Launch the concurrent execution of procedure f with parameter i from 1 to 1000.
Tasks are independent and f(i) doesn't return any value.
Tasks need not run all at the same time, so you may use a pool.
for my $i (1 .. 1000) {
    threads->create('f', $i);
Create the recursive function f which returns the factorial of the non-negative integer i, calculated from f(i-1)
sub f {
   my $i = shift;
   return $i<2 ? 1 : $i * f($i-1);
Create function exp which calculates (fast) the value x power n.
x and n are non-negative integers.
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);
Alternative implementation:
sub exp {
   my ($x, $n) = @_;
   return undef if $x < 0 or $n < 0;
   return $x ** $n;
Assign to the variable x the new value f(x), making sure that no other thread may modify x between the read and the write.
my $x :shared;
$x = 0;

sub my_task {
   my $id = shift;
   for (1 .. 5) {
      sleep 2*rand();
      { # lock scope
         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);
Declare and initialize a set x containing unique objects of type T.
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);
Implement a function compose (A -> C) with parameters f (A -> B) and g (B -> C), which returns the composition function g ∘ f
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);
Implement a function compose which returns composition function g ∘ f for any functions f and g having exactly 1 parameter.
sub compose {
   my ($f, $g) = @_;
   return sub {
      my $x = shift;
      return $g->($f->($x));
Transform a function that takes multiple arguments into a function for which some of the arguments are preset.
sub curry {
   my ($func, $fixed_arg) = @_;
   return sub {
      $func->($fixed_arg, @_);
Find substring t consisting in characters i (included) to j (excluded) of string s.
Character indices start at 0 unless specified otherwise.
Make sure that multibyte characters are properly handled.
my $chunk = substr("now is the time", $i, $j);
Set the boolean ok to true if the string word is contained in string s as a substring, or to false otherwise.
$ok = index($s,$word) >= 0;
Declare a Graph data structure in which each Vertex has a collection of its neighbouring vertices.
my $G = Graph::Undirected->new(edges => [
    [1,3], [2,4], [3,4], [3,5], [4,5]
Create string t containing the same characters as string s, in reverse order.
Original string s must remain unaltered. Each character must be handled correctly regardless its number of bytes in memory.
my $s = 'cafe' . "\N{COMBINING ACUTE ACCENT}";
my $t = join '', reverse $s =~ /\X/g;
Print each item v of list a which is not contained in list b.
For this, write an outer loop to iterate on a and an inner loop to iterate on b.
for my $v (@a) {
   for my $check (@b) {
      next OUTER if $v == $check;
   print "$v not in the list\n";
Look for a negative value v in 2D integer matrix m. Print it and stop searching.
OUTER: for my $row (@m) {
   INNER: for my $v (@$row) {
      if ($v < 0) {
         print "Negative value found: $v\n";
         last OUTER;
Insert the element x at position i in the list s. Further elements must be shifted to the right.
splice(@s, $i, 0, $x);
Sleep for 5 seconds in current thread, before proceeding with the next instructions.
sleep 5;
Create the string t consisting of the 5 first characters of the string s.
Make sure that multibyte characters are properly handled.
my $t = substr($s,0,5);
Create string t consisting in the 5 last characters of string s.
Make sure that multibyte characters are properly handled.
use utf8;

my $t = substr($s, -5);
Assign to variable s a string literal consisting in several lines of text, including newlines.
$s = "Perl normally allows
strings to contain newlines.";
Alternative implementation:
$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
Alternative implementation:
$s = q{
There are a good few ways to create multiline
text strings in perl.
Build list chunks consisting in substrings of the string s, separated by one or more space characters.
@chunks = split /\s+/, $s;
Write a loop that has no end clause.
while (1) {
Alternative implementation:
say "" while True;
Determine whether the map m contains an entry for the key k
exists $m->{$k}
Determine whether the map m contains an entry with the value v, for some key.
print "Found it!" if exists $m{$v};
Concatenate elements of string list x joined by the separator ", " to create a single string y.
$y = join(", ", @x)
Calculate the sum s of the integer list or array x.
$s = sum(@x);
Create the string representation s (in radix 10) of the integer value i.
my $s = "" . $i;
Alternative implementation:
$s = "$i";
Fork-join : launch the concurrent execution of procedure f with parameter i from 1 to 1000.
Tasks are independent and f(i) doesn't return any value.
Tasks need not run all at the same time, so you may use a pool.
Wait for the completion of the 1000 tasks and then print "Finished".
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);
Create the list y containing the items from the list x that satisfy the predicate p. Respect the original ordering. Don't modify x in-place.
# 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;
Create the string lines from the content of the file with filename f.
open my $fh, '<', $f;
my $lines = do { local $/; <$fh> };
close $fh;
Print the message "x is negative" to standard error (stderr), with integer x value substitution (e.g. "-2 is negative").
print STDERR "$x is negative";
Assign to x the string value of the first command line parameter, after the program name.
$x = $ARGV[0];
Assign to the variable d the current date/time value, in the most standard type.
$d = time;
Alternative implementation:
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
Alternative implementation:
$d = time;

my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($d);
Set i to the first position of string y inside string x, if exists.

Specify if i should be regarded as a character index or as a byte index.

Explain the behavior when y is not contained in x.
$i = index($x, $y);
Assign to x2 the value of string x with all occurrences of y replaced by z.
Assume occurrences of y are not overlapping.
my $x2 = $x =~ s/\Q$y/$z/gr;
Assign to x the value 3^247
$x = 3 ** 247;
From the real value x in [0,1], create its percentage string representation s with one digit after decimal point. E.g. 0.15625 -> "15.6%"
my $s = sprintf '%.1f%%', $x * 100;
Calculate the result z of x power n, where x is a big integer and n is a positive integer.
my ($x, $y) = (3 ** 200, 25);
my $z = $x ** $y;
Calculate binom(n, k) = n! / (k! * (n-k)!). Use an integer type able to handle huge numbers.
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)));
Alternative implementation:
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
Create an object x to store n bits (n being potentially large).
vec($x, $n, 1) = 0;
Use seed s to initialize a random generator.

If s is constant, the generator output will be the same each time the program runs. If s is based on the current value of the system clock, the generator output will be different each time.
Get the current datetime and provide it as a seed to a random generator. The generator sequence will be different at each run.
srand time;
Basic implementation of the Echo program: Print all arguments except the program name, separated by space, followed by newline.
The idiom demonstrates how to skip the first argument if necessary, concatenate arguments as strings, append newline and print it to stdout.
print "@ARGV\n"
Create a factory named fact for any sub class of Parent and taking exactly one string str as constructor parameter.
sub fact {
    my ($class, $str) = @_;
    return $class->new($str) if $class->$_isa('Parent');
Compute the greatest common divisor x of big integers a and b. Use an integer type able to handle huge numbers.
sub gcd {
    my ($A, $B) = @_;
    return 0 == $B
        ? $A
        : gcd($B, $A % $B);
Compute the least common multiple x of big integers a and b. Use an integer type able to handle huge numbers.
sub gcd {
	my ($x, $y) = @_;
	while ($x) { ($x, $y) = ($y % $x, $x) }
sub lcm {
	my ($x, $y) = @_;
	($x && $y) and $x / gcd($x, $y) * $y or 0
Alternative implementation:
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;
Create the string s of integer x written in base 2.

E.g. 13 -> "1101"
$s = sprintf "%b", $x;
Declare a complex x and initialize it with value (3i - 2). Then multiply it by i.
my $x = 3*i - 2;
$x *= i;
Alternative implementation:
my $x = cplx(-2, 3);
$x *= i;
Execute a block once, then execute it again as long as boolean condition c is true.
do {
} while(c);
Declare the floating point number y and initialize it with the value of the integer x .
my $y = $x;
Declare integer y and initialize it with the value of floating point number x . Ignore non-integer digits of x .
Make sure to truncate towards zero: a negative x must yield the closest greater integer (not lesser).
my $y = int($x);
Declare the integer y and initialize it with the rounded value of the floating point number x .
Ties (when the fractional part of x is exactly .5) must be rounded up (to positive infinity).
my $y = int($x + 1/2);
Find how many times string s contains substring t.
Specify if overlapping occurrences are counted.
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";
Declare regular expression r matching strings "http", "htttp", "httttp", etc.
my $r = qr/htt+p/;
Count number c of 1s in the integer i in base 2.

E.g. i=6 → c=2
# Not best, but simple:
while ($i) {
   $c += $i&1;
   $i /= 2;
Alternative implementation:
$c = unpack '%b*', pack 'i', $i;
Write boolean function addingWillOverflow which takes two integers x, y and return true if (x+y) overflows.

An overflow may be above the max positive value, or below the min negative value.
sub adding_will_overflow {
    my ($x, $y) = @_;
    return 'Inf' eq $x + $y;
Write the boolean function multiplyWillOverflow which takes two integers x, y and returns true if (x*y) overflows.

An overflow may reach above the max positive value, or below the min negative value.
sub multiply_will_overflow {
    my ($x, $y) = @_;
    return 'Inf' eq $x * $y;
Exit immediately.
If some extra cleanup work is executed by the program runtime (not by the OS itself), describe it.
exit 0;
Create a new bytes buffer buf of size 1,000,000.
my $buf = ' ' * 1_000_000;
You've detected that the integer value of argument x passed to the current function is invalid. Write the idiomatic way to abort the function execution and signal the problem.
die "Invalid argument $x";
Expose a read-only integer x to the outside world while being writable inside a structure or a class Foo.
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) }
Read from the file data.json and write its content into the object x.
Assume the JSON data is suitable for the type of x.
my $str = read_file('data.json');
my $x = decode_json($str);
Write the contents of the object x into the file data.json.
write_file('data.json', encode_json($x));
Implement the procedure control which receives one parameter f, and runs f.
sub control {
    my $f = shift;
Print the name of the type of x. Explain if it is a static type or dynamic type.

This may not make sense in all languages.
print ref($x)||"SCALAR", "\n";
Assign to variable x the length (number of bytes) of the local file at path.
my $x = -s $path;
Set the boolean b to true if string s starts with prefix prefix, false otherwise.
$b = $prefix eq substr($s,0,length($prefix));
Set boolean b to true if string s ends with string suffix, false otherwise.
$b = $suffix eq substr($s, -length($suffix));
Convert a timestamp ts (number of seconds in epoch-time) to a date with time d. E.g. 0 -> 1970-01-01 00:00:00
my $d = DateTime->from_epoch(epoch => $ts)->strftime('%F %T');
Assign to the string x the value of the fields (year, month, day) of the date d, in format YYYY-MM-DD.
$x = strftime "%Y-%m-%d", localtime($d);
Sort elements of array-like collection items, using a comparator c.
sub c {
 $a <=> $b;

my @result = sort c @items;

Make an HTTP request with method GET to the URL u, then store the body of the response in the string s.
my $s = HTTP::Tiny->new->get($u)->{content};
Make an HTTP request with method GET to the URL u, then store the body of the response in the file result.txt. Try to save the data as it arrives if possible, without having all its content in memory at once.
my $response = HTTP::Tiny->new->mirror($u, 'result.txt');
Read from the file data.xml and write its contents into the object x.
Assume the XML data is suitable for the type of x.
my $x = XML::LibXML->load_xml(
location => 'data.xml');
Write the contents of the object x into the file data.xml.
Assign to the string s the name of the currently executing program (but not its full path).
my $s = $0;
Assign to string dir the path of the working directory.
(This is not necessarily the folder containing the executable itself)
my $dir = getcwd();
Assign to string dir the path of the folder containing the currently running executable.
(This is not necessarily the working directory, though.)
my $dir = path($EXECUTABLE_NAME)->parent;
Print the value of variable x, but only if x has been declared in this program.
This makes sense in some languages, not all of them. (Null values are not the point, rather the very existence of the variable.)
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

Set n to the number of bytes of a variable t (of type T).
use Devel::Size qw(total_size);
my $n = total_size $t;
Set the boolean blank to true if the string s is empty, or null, or contains only whitespace ; false otherwise.
$blank = !$s || $s=~/^\s*$/;
From current process, run program x with command-line parameters "a", "b".
system $x, 'a', 'b';
Print each key k with its value x from an associative array mymap, in ascending order of k.
for my $k (sort keys %mymap) {
    my $x = $mymap{$k};
    say "$k => $x";
Print each key k with its value x from an associative array mymap, in ascending order of x.
Multiple entries may exist for the same value 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";

Alternative implementation:
for my $k (sort {($mymap{$a}<=>$mymap{$b}) or ($a cmp $b)}
           keys %mymap) {
   print "$k: $mymap{$k}\n";
Set boolean b to true if objects x and y contain the same values, recursively comparing all referenced elements in x and y.
Tell if the code correctly handles recursive types.
my $b = Compare($x, $y);
Set boolean b to true if date d1 is strictly before date d2 ; false otherwise.
my $b = d1 < d2;
Remove all occurrences of string w from string s1, and store the result in s2.
my $s2 = $s1 =~ s/\Q$w//gr;
Set n to the number of elements of the list x.
my $N = @x;
Alternative implementation:
$n = scalar @x;
Create the set y from the list x.
x may contain duplicates. y is unordered and has no repeated values.
my %y = map {$_=>0} @x;
Alternative implementation:
my @y = uniq @x;
Remove duplicates from the list x.
Explain if the original order is preserved.
@x = uniq(@x);
Read an integer value from the standard input into the variable n
my $n = <> + 0;  # read a line from STDIN, add 0 to convert to int
Listen UDP traffic on port p and read 1024 bytes into buffer b.
my $p = 55555;
my $socket = IO::Socket::IP->new(
    LocalHost => 'localhost',
    LocalService => $p,
    Type => SOCK_DGRAM,
while () {
    $socket->read(my $B, 1024);
Create an enumerated type Suit with 4 possible values SPADES, HEARTS, DIAMONDS, CLUBS.
my %suit = (
    SPADES   => 1,
    HEARTS   => 2,
    DIAMONDS => 3,
    CLUBS    => 4,
Verify that predicate isConsistent returns true, otherwise report assertion violation.
Explain if the assertion is executed even in production environment or not.
assert { is_consistent };
Write the function binarySearch which returns the index of an element having the value x in the sorted array a, or -1 if no such element exists.
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;
Alternative implementation:
# 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;
measure the duration t, in nanoseconds, of a call to the function foo. Print this duration.
sub foo {};
my $start = Benchmark->new;
my $t = timediff(Benchmark->new, $start)->[0] * 10**9; 
Write a function foo that returns a string and a boolean value.
sub foo {
    return "bar", 1;
Import the source code for the function foo body from a file "foobody.txt".
sub foo {
    do './foobody.txt';
Call a function f on every node of a tree, in breadth-first prefix order
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);
Call the function f on every vertex accessible from the vertex start, in breadth-first prefix order
my $iter = $tree->traverse($tree->LEVEL_ORDER);
while (my $v = $iter->()) {
Call th function f on every vertex accessible from the vertex v, in depth-first prefix order
my $iter = $tree->traverse;
while (my $v = $iter->()) {
Execute f1 if condition c1 is true, or else f2 if condition c2 is true, or else f3 if condition c3 is true.
Don't evaluate a condition when a previous condition was true.
if ($c1)    { $f1 }
elsif ($c2) { $f2 }
elsif ($c3) { $f3 }
Run the procedure f, and return the duration of the execution of f.
sub f {};
my $start = Benchmark->new;
print timestr timediff(Benchmark->new, $start);
Set boolean ok to true if string word is contained in string s as a substring, even if the case doesn't match, or to false otherwise.
my $ok = $s =~ /\Q$word/i;
Declare and initialize a new list items, containing 3 elements a, b, c.
my @items = ($a, $b, $c);
Remove at most 1 item from list items, having the value x.
This will alter the original list or return a new list, depending on which is more idiomatic.
If there are several occurrences of x in items, remove only one of them. If x is absent, keep items unchanged.
extract_first_by { $x eq $_ } @items;
Remove all occurrences of the value x from list items.
This will alter the original list or return a new list, depending on which is more idiomatic.
my @filtered = grep { $x ne $_ } @items;
Set the boolean b to true if the string s contains only characters in the range '0'..'9', false otherwise.
my $b = $s =~ /^\d*$/;
Create a new temporary file on the filesystem.
my $path = tempfile;
Alternative implementation:
my $fh = tempfile();
# or
my ($fh, $filename) = tempfile();

Create a new temporary folder on filesystem, for writing.
my $path = tempdir;
Delete from map m the entry having key k.

Explain what happens if k is not an existing key in m.
delete $m{$k}; # also succeeds when $k does not exist in %m
Iterate in sequence over the elements of the list items1 then items2. For each iteration print the element.
print for @items1, @items2;
Assign to string s the hexadecimal representation (base 16) of integer x.

E.g. 999 -> "3e7"
my $s = sprintf("%x", $i);
Iterate alternatively over the elements of the lists items1 and items2. For each iteration, print the element.

Explain what happens if items1 and items2 have different size.
print for zip @items1, @items2;
Set boolean b to true if file at path fp exists on filesystem; false otherwise.

Beware that you should never do this and then in the next instruction assume the result is still valid, this is a race condition on any multitasking OS.
my $b = -f $fp;
Print message msg, prepended by current date and time.

Explain what behavior is idiomatic: to stdout or stderr, and what the date format is.
my $logline = sprintf "%s %s\n", localtime->strftime('%F %T'), $msg;

print $logline; # stdout
warn $logline; # stderr
Extract floating point value f from its string representation s
my $f = $s;
Create string t from string s, keeping only ASCII characters
($t = $s) =~ s/[^\x00-\x7f]+//g;
Alternative implementation:
$t = decode('ascii', encode('ascii', $s, sub { return '' } ) );
Read a list of integer numbers from the standard input, until EOF.
@x = map {chomp; $_} <>;
Remove the last character from the string p, if this character is a forward slash /
$p =~ s{/$}{};
Alternative implementation:
{ local $/='/'; chomp $p }
Remove last character from string p, if this character is the file path separator of current platform.

Note that this also transforms unix root path "/" into the empty string!
chomp $p, File::Spec->catdir('');
Create string s containing only the character c.
my $s = $c;
Create the string t as the concatenation of the string s and the integer i.
my $t = "$s$i";
Alternative implementation:
my $t = $s . $i;
Find color c, the average between colors c1, c2.

c, c1, c2 are strings of hex color codes: 7 chars, beginning with a number sign # .
Assume linear computations, ignore gamma corrections.
my @c1 = unpack 'xA2A2A2', $c1;
my @c2 = unpack 'xA2A2A2', $c2;
my $c = sprintf '#%02X%02X%02X', pairwise { (hex($a) + hex($b)) / 2 } @c1, @c2
Delete from filesystem the file having path filepath.
unlink $filepath;
Assign to the string s the value of the integer i in 3 decimal digits. Pad with zeros if i < 100. Keep all digits if i1000.
my $s = sprintf '%03d', $i;
Initialize a constant planet with string value "Earth".
const my $planet => 'Earth';
Alternative implementation:
use constant planet => 'Earth';
use constant PI => 3.14159;
use constant { RED => 1, BLUE => 2, GREEN => 3 };
Create a new list y from randomly picking exactly k elements from list x.

It is assumed that x has at least k elements.
Each element must have same probability to be picked.
Each element from x must be picked at most once.
Explain if the original ordering is preserved or not.
my @y = head $k, shuffle @x;
Define a Trie data structure, where entries have an associated value.
(Not all nodes are entries)
my $trie = Data::Trie->new;
Execute f32() if platform is 32-bit, or f64() if platform is 64-bit.
This can be either a compile-time condition (depending on target) or a runtime detection.
if ($Config{archname} =~ '64') {
} else {
Multiply all the elements of the list elements by a constant c
@elements = map {$_ * $c} @elements;
execute bat if b is a program option and fox if f is a program option.
for (@ARGV) {
    use experimental 'switch';
    bat when 'b';
    fox when 'f';
Print all the list elements, two by two, assuming list length is even.
foreach (pairs @list) {
   print "@$_\n";
Open the URL s in the default browser.
Set the boolean b to indicate whether the operation was successful.
my $b = open_browser $s;
Assign to the variable x the last element of the list items.
my $x = $items[-1];
Alternative implementation:
my $x = $items[$#items];
Create the list ab containing all the elements of the list a, followed by all the elements of the list b.
@ab = (@a, @b)
Create the string t consisting of the string s with its prefix p removed (if s starts with p).
if (0 == index $s, $p) {
    my $t = substr $s, length $p;
Create string t consisting of string s with its suffix w removed (if s ends with w).
if (length $s == rindex($s, $w) + length $w) {
    my $t = substr $s, 0, rindex $s, $w;
Assign to the integer n the number of characters of the string s.
Make sure that multibyte characters are properly handled.
n can be different from the number of bytes of s.
my $n = length( $s );
Set n to the number of elements stored in mymap.

This is not always equal to the map capacity.
my $n = keys %mymap;
Append the element x to the list s.
push @s, $x;
Insert value v for key k in map m.
$m{$k} = $v;
Number will be formatted with a comma separator between every group of thousands.
 sub commify {
    local $_  = shift;
    1 while s/^([-+]?\d+)(\d{3})/$1,$2/;
    return $_;
Make a HTTP request with method POST to the URL u
perl -Mojo -E 'my $u = ""; say p($u)->body;'
Alternative implementation:
# 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";
Alternative implementation:
my $response = `curl -X POST $u`;
From the array a of n bytes, build the equivalent hex string s of 2n digits.
Each byte (256 possible values) is encoded as two hexadecimal characters (16 possible values per digit).
$s = unpack('H*', pack('c*', @a));
From hex string s of 2n digits, build the equivalent array a of n bytes.
Each pair of hexadecimal characters (16 possible values per digit) is decoded into one byte (256 possible values).
my @a = split '', pack 'H*', $s;
Construct a list L that contains all filenames that have the extension ".jpg" , ".jpeg" or ".png" in directory D and all its subdirectories.
my @L;
find(sub {
  push @L, $File::Find::name
     if /(.jpg|.jpeg|.png)$/;
}, $D);

Set boolean b to true if if the point with coordinates (x,y) is inside the rectangle with coordinates (x1,y1,x2,y2) , or to false otherwise.
Describe if the edges are considered to be inside the rectangle.
sub insideRect($x1,$y1,$x2,$y2, $px,$py) {
            $x1 <= $px and $px <= $x2
        and $y1 <= $py and $py <= $y1
Return the center c of the rectangle with coördinates(x1,y1,x2,y2)
my @c = (($x1 + $x2) / 2, ($y1 + $y2) / 2);
Create the list x containing the contents of the directory d.

x may contain files and subfolders.
No recursive subfolder listing.
opendir my $dh, $d or die "Could not open $d for reading: $!\n";
@x = readdir $dh;
closedir $dh;
Alternative implementation:
my @x = map {basename $_} glob("$d/*");
Output the source of the program.
Make a HTTP request with method PUT to the URL u
my $response = HTTP::Tiny->new->put($u, {content => $http_request_body});
Assign to variable t a string representing the day, month and year of the day after the current date.
my $dt = DateTime->today;
$dt->add(days => 1);
my $t = $dt->strftime('%F');
Alternative implementation:
$t = DateTime->today->add(days => 1)->ymd;
Schedule the execution of f(42) in 30 seconds.
local $SIG{ALRM} = sub { f(42) };
alarm 30;
Alternative implementation:
my $thr = threads->create(sub { sleep(30); f(42); });
Alternative implementation:
my $thr = threads->create(sub { sleep(30); f(42); });
Exit a program cleanly indicating no error to OS
Disjoint Sets hold elements that are partitioned into a number of disjoint (non-overlapping) sets.
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
Perform matrix multiplication of a real matrix a with nx rows and ny columns, a real matrix b with ny rows and nz columns and assign the value to a real matrix c with nx rows and nz columns.
my ($nx, $ny, $nz) = (2, 3, 4);
my $A = sequence $ny, $nx;
my $B = sequence $nz, $ny;
my $C = matmult $A, $B;
Produce a new list y containing the result of the function T applied to all elements e of the list x that match the predicate P.
my @y = map { T($_) } grep { P($_) } @x;
Declare an external C function with the prototype

void foo(double *a, int n);

and call it, passing an array (or a list) of size 10 to a and 10 to n.

Use only standard features of your language.
    ->new(lib => '/tmp/mylib/')
    ->attach(foo => ['double[]', 'int']);
foo([1..10], 10);
Given a one-dimensional array a, check if any value is larger than x, and execute the procedure f if that is the case
f if any { $_ > $x } @a;
Declare a real variable a with at least 20 digits; if the type does not exist, issue an error at compile time.
my $a = 12345678901234567890.1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890;
Declare two two-dimensional arrays a and b of dimension n*m and m*n, respectively. Assign to b the transpose of a (i.e. the value with index interchange).
my ($m, $n) = (3, 2);
my $A = sequence $m, $n;
my $B = transpose $A;
Given an array a, set b to an array which has the values of a along its second dimension shifted by n. Elements shifted out should come back at the other end.
my @a = (
    ['a' .. 'g'],
    ['h' .. 'm'],
    ['n' .. 'z']
my $n = 5;
my @b = map {
    my @c = @$_;
    push @c, splice @c, 0, $n;
} @a;
@b = (
    ['f', 'g', 'a' .. 'e'],
    ['m', 'h' .. 'l'],
    ['s' .. 'z', 'n' .. 'r']
Pass an array a of real numbers to the procedure (resp. function) foo. Output the size of the array, and the sum of all its elements when each element is multiplied with the array indices i and j (assuming they start from one).
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;
Given an integer array a of size n, pass the first, third, fifth and seventh, ... up to the m th element to a routine foo which sets all these elements to 42.

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

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

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

use Data::Dumper;
print Dumper(@A);
Alternative implementation:
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
Retrieve the contents of file at path into a list of strings lines, in which each element is a line of the file.
my @lines = path($path)->lines;
Abort program execution with error condition x (where x is an integer value)
exit $x;
Truncate a file F at the given file position.
my $F = path('F')->openrw;
# ... read some from $F to advance
# position of file handle (not shown) ...
truncate $F, tell $F;
Compute the hypotenuse h of the triangle where the sides adjacent to the square angle have lengths x and y.
my $h = hypot $x, $y;
Calculate n, the Euclidean norm of data (an array or list of floating point values).
my $data = [5.0, 4.0, 3.0, 2.0, 1.0];
my $n = gsl_blas_dnrm2(Math::GSL::Vector->new($data)->raw);
Calculate the sum of squares s of data, an array of floating point values.
my $s = sum map { $_ ** 2 } @data;
Calculate the mean m and the standard deviation s of the list of floating point values data.
my $m = mean @data;
my $s = stddev @data;
Given a real number a, print the fractional part and the exponent of the internal representation of that number. For 3.14, this should print (approximately)

0.785 2
my ($mantissa, $exponent) = frexp $a;
printf "%f %d\n", $mantissa, $exponent;
Read an environment variable with the name "FOO" and assign it to the string variable foo. If it does not exist or if the system does not support environment variables, assign a value of "none".
my $foo = $ENV{FOO} // 'none';
Execute different procedures foo, bar, baz and barfl if the string str contains the name of the respective procedure. Do it in a way natural to the language.
my %proc = map { $_ => \&$_ } qw(foo bar baz barfl);
$proc{$str}->() if exists $proc{$str};
Allocate a list a containing n elements (n assumed to be too large for a stack) that is automatically deallocated when the program exits the scope it is declared in.
    my @a = (undef) x $n;
    # scope ends at closing brace
Given the arrays a,b,c,d of equal length and the scalar e, calculate a = e*(a+b*c+cos(d)).
Store the results in a.
$a[$_] = $e * ($a[$_] + $b[$_] * $c[$_] + cos $d[$_]) for 0 .. $#a;
Declare a type t which contains a string s and an integer array n with variable size, and allocate a variable v of type t. Allocate v.s and v.n and set them to the values "Hello, world!" for s and [1,4,9,16,25], respectively. Deallocate v, automatically deallocating v.s and v.n (no memory leaks).
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
Assign, at runtime, the compiler version and the options the program was compilerd with to variables version and options, respectively, and print them. For interpreted languages, substitute the version of the interpreter.

Example output:

GCC version 10.0.0 20190914 (experimental)
-mtune=generic -march=x86-64
my $version = $Config{version};
my $version_for_humans = $Config{version_patchlevel_string};
my %options = %Config{qw(config_args cccdlflags ccdlflags ccflags lddlflags libs)};
Alternative implementation:
$version = "$]";
Create the folder at path on the filesystem
Set the boolean b to true if path exists on the filesystem and is a directory; false otherwise.
my $b = -e -d $path;
Compare four strings in pair-wise variations. The string comparison can be implemented with an equality test or a containment test, must be case-insensitive and must apply Unicode casefolding.
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;
Append extra character c at the end of string s to make sure its length is at least m.
The length is the number of characters, not the number of bytes.
$s = length($s) >= $m ? $s : $s . $c x ( $m-length($s) );
Alternative implementation:
$s .= $c x ($m - length $s)
Prepend extra character c at the beginning of string s to make sure its length is at least m.
The length is the number of characters, not the number of bytes.
$s = $c x ($m - length($s)) . $s;
Add the extra character c at the beginning and ending of string s to make sure its length is at least m.
After the padding the original content of s should be at the center of the result.
The length is the number of characters, not the number of bytes.

E.g. with s="abcd", m=10 and c="X" the result should be "XXXabcdXXX".
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);
Alternative implementation:
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");
Create a zip-file with filename name and add the files listed in list to that zip-file.
my @list = ( 'file_A.txt', 'file_B.txt' );

zip \@list => ''
    or die "zip failed: $ZipError\n";
Create the list c containing all unique elements that are contained in both lists a and b.
c should not contain any duplicates, even if a and b do.
The order of c doesn't matter.
my %u;
$u{$_} = 1 for @a, @b;
my @c = keys %u;
Create the string t from the value of string s with each sequence of spaces replaced by a single space.

Explain if only the space characters will be replaced, or the other whitespaces as well: tabs, newlines.
my $t = $s;
$t =~ s/ +/ /g;
Alternative implementation:
my $t = $s;
$t =~ s/\s+/ /g;
Create t consisting of 3 values having different types.

Explain if the elements of t are strongly typed or not.
use constant t => (1, 'two', 3.5);
Create string t from string s, keeping only digit characters 0, 1, 2, 3, 4, 5, 6, 7, 8, 9.
my $t = $s;
$t =~ s/\D+//g;
Alternative implementation:
($t = $s) =~ tr/0-9//cd;
Set i to the first index in list items at which the element x can be found, or -1 if items does not contain x.
$i = -1;
$index = 0;
foreach (@items) {
    $i = $index, last if $x eq $items[$index];
Loop through list items checking a condition. Do something else if no matches are found.

A typical use case is looping through a series of containers looking for one that matches a condition. If found, an item is inserted; otherwise, a new container is created.

These are mostly used as an inner nested loop, and in a location where refactoring inner logic into a separate function reduces clarity.
my $found_match = 0;
foreach my $item (@items) {
    if ($item eq 4) {
        print "Found $item\n";
        $found_match = 1;
if (!$found_match) {
    print "Didn't find what I was looking for\n";
Insert the element x at the beginning of the list items.
unshift @items, $x
Declare an optional integer argument x to procedure f, printing out "Present" and its value if it is present, "Not present" otherwise
sub f {
    my $x = shift;
    if (defined $x) {
        print("Present $x\n");
    else {
        print("Not Present\n");
Remove the last element from the list items.
Create the new list y containing the same elements as the list x.

Subsequent modifications of y must not affect x (except for the contents referenced by the elements themselves if they contain pointers).
my @y = @x; # for simple arrays

# for complex arrays with references:
my @y = @{dclone(\@x)};
Copy the file at path src to dst.
cp($src, $dst) or die $!;
Interrupt an ongoing processing p.
my $coro = async {
   # do work
$coro->cancel;  # or $coro->safe_cancel
Cancel an ongoing processing p if it has not finished after 5s.
my $p = Coro->new( sub { ... } );

my $start = time;
for (1..100) {
    if ( (time - $start) > 5 ) {
Set b to true if the byte sequence s consists entirely of valid UTF-8 character code points, false otherwise.
$b = utf8::is_utf8($s);
Print "verbose is true" if the flag -v was passed to the program command line, "verbose is false" otherwise.
#!/usr/bin/perl -s

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

$v ||= 0;

print 'verbose is ' . ($v ? 'true' : 'false') . "\n";
Print the value of the flag -country passed to the program command line, or the default value "Canada" if no such flag was passed.
my $country = 'Canada';
GetOptions("country=s" => \$country) or die("Error in command line args\n");
print "Country is $country\n";
Assign to the string s the standard base64 encoding of the byte array data, as specified by RFC 4648.
$encoded = encode_base64('Aladdin:open sesame');
$decoded = decode_base64($encoded);
Assign to byte array data the bytes represented by the base64 string s, as specified by RFC 4648.
my @s = decode_base64($data);
Initialize a quotient q = a/b of arbitrary precision. a and b are large integers.
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
Assign to c the result of (a xor b)
my $c = $a ^ $b;
Write in a new byte array c the xor result of byte arrays a and b.

a and b have the same size.
$c = $a ^. $b;
Assign to string x the first word of string s consisting of exactly 3 digits, or the empty string if no such match exists.

A word containing more digits, or 3 digits as a substring fragment, must not match.
my ($x) = $s =~ /\b(\d{3})\b/;
Lists a and b have the same length. Apply the same permutation to a and b to have them sorted based on the values of a.
@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 }
        sort { $a->[0] cmp $b->[0] } 
            zip \@keys, \@vals;
Explicitly decrease the priority of the current process, so that other execution threads have a better chance to execute now. Then resume normal execution and call the function busywork.
sub busywork { print 'busy' };

my $n = 12;

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

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


foreach my $ii ( 1 .. $n ) {
    if ( $ii == int $n * 2/3 ) {
    print '-';
Call a function f on each element e of a set x.
f($_) for @x;
Print the contents of the list or array a on the standard output.
print "@items\n";
Alternative implementation:
print join(', ', @items) . "\n";
Print the contents of the map m to the standard output: keys and values.
print "$_: $m{$_}\n" for keys %m;
Print the value of object x having custom type T, for log or debug.
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)
Alternative implementation:
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;
Set c to the number of distinct elements in the list items.
my $c = scalar(uniq @items);
Remove all the elements from list x that don't satisfy the predicate p, without allocating a new list.
Keep all the elements that do satisfy p.

For languages that don't have mutable lists, refer to idiom #57 instead.
@x = grep { p($_) } @x;
Construct the "double precision" (64-bit) floating point number d from the mantissa m, the exponent e and the sign flag s (true means the sign is negative).
$d = ($s?-1:1) * "${m}e${e}"; 
Define variables a, b and c in a concise way.
Explain if they need to have the same type.
my ($a, $b, $c) = (1, '2', 'three');
Choose a value x from map m.
m must not be empty. Ignore the keys.
@vals = values %m;
$x = $vals[ int rand @vals ];
Extract integer value i from its binary string representation s (in radix 2)
E.g. "1101" -> 13
$i = oct('0b' . $s);
Assign to the variable x the string value "a" if calling the function condition returns true, or the value "b" otherwise.
my $x = condition() ? "a" : "b";
Print the stack frames of the current execution thread of the program.
cluck 'print this message and a full stack track';
Replace all exact occurrences of "foo" with "bar" in the string list x
map { s/^foo$/bar/g } @x;
Print the values of the set x to the standard output.
The order of the elements is irrelevant and is not required to remain the same next time.
print "$_\n" for @x;
Print the numbers 5, 4, ..., 0 (included), one line per number.
print "$_\n" for reverse (0..5);
Print each index i and value x from the list items, from the last down to the first.
for ($i = $#items; $i >= 0; $i--) {
    print "$i $items[$i]\n";
Convert the string values from list a into a list of integers b.
@b = map { $_ += 0 } @a
Build the list parts consisting of substrings of the input string s, separated by any of the characters ',' (comma), '-' (dash), '_' (underscore).
my @parts = split(/[,\-_]/, $s);
Declare a new list items of string elements, containing zero elements
my @items;
# or
my @items = ();
Assign to the string x the value of fields (hours, minutes, seconds) of the date d, in format HH:MM:SS.
$d = DateTime->now; 
$x = $d->hms;
Assign to t the number of trailing 0 bits in the binary representation of the integer n.

E.g. for n=112, n is 1110000 in base 2 ⇒ t=4
$s = sprintf '%b', $n; 
$n = length $s; 
$t++ while !substr($s, --$n, 1) && $n >= 0; 
Alternative implementation:
$t = sprintf('%b', $n) =~ /(0+)$/ ? length($1) : 0;
Write two functions log2d and log2u, which calculate the binary logarithm of their argument n rounded down and up, respectively. n is assumed to be positive. Print the result of these functions for numbers from 1 to 12.
sub log2d { floor log2 shift };

sub log2u { ceil log2 shift };
Pass a two-dimensional integer array a to a procedure foo and print the size of the array in each dimension. Do not pass the bounds manually. Call the procedure with a two-dimensional array.
sub foo {
    my ($a) = @_;
    return scalar @{ $a }, scalar @{ $a->[0] };

my $a = [[1,2,3], [4,5,6]];
printf "%d %d\n", foo($a);
Calculate the parity p of the integer variable i : 0 if it contains an even number of bits set, 1 if it contains an odd number of bits set.
$p = ($count = @ones = (sprintf '%b', $i) =~ /1/g) % 2;
Assign to the string s the value of the string v repeated n times, and write it out.

E.g. v="abc", n=5 ⇒ s="abcabcabcabcabc"
my $s = $v x $n;
Declare an argument x to a procedure foo that can be of any type. If the type of the argument is a string, print it, otherwise print "Nothing."

Test by passing "Hello, world!" and 42 to the procedure.
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' );
Alternative implementation:
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';
Define a type vector containing three floating point numbers x, y, and z. Write a user-defined operator x that calculates the cross product of two vectors a and b.
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;
Alternative implementation:
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,
Given the enumerated type t with 3 possible values: bike, car, horse.
Set the enum value e to one of the allowed values of t.
Set the string s to hold the string representation of e (so, not the ordinal value).
Print s.
use enum qw(bike car horse);

my $e = horse;
print $e;
Alternative implementation:
use enum     qw(bike car horse);
my @enum_T = qw(bike car horse);

my $e = horse;
my $s = $enum_T[$e];
print $s;
Given a floating point number r1 classify it as follows:
If it is a signaling NaN, print "This is a signaling NaN."
If it is a quiet NaN, print "This s a quiet NaN."
If it is not a NaN, print "This is a number."
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
If a variable x passed to procedure tst is of type foo, print "Same type." If it is of a type that extends foo, print "Extends type." If it is neither, print "Not related."
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"
Fizz buzz is a children's counting game, and a trivial programming task used to affirm that a programmer knows the basics of a language: loops, conditions and I/O.

The typical fizz buzz game is to count from 1 to 100, saying each number in turn. When the number is divisible by 3, instead say "Fizz". When the number is divisible by 5, instead say "Buzz". When the number is divisible by both 3 and 5, say "FizzBuzz"
for my $i ( 1 .. 100 ) {
    print $i % 3 ? '' : 'Fizz';
    print $i % 5 ? '' : 'Buzz';
    print $i % 3 && $i % 5 ? $i : '';
    print "\n";
Set the boolean b to true if the directory at filepath p is empty (i.e. doesn't contain any other files and directories)
opendir(my $dh, $p) || die($!);
my $b = scalar(grep { !/^[\.]{1,2}$/ } readdir($dh)) ? 1 : 0;
Create the string t from the string s, removing all the spaces, newlines, tabulations, etc.
my $t = $s;
$t =~ s/\s*//g;
From the string s consisting of 8n binary digit characters ('0' or '1'), build the equivalent array a of n bytes.
Each chunk of 8 binary digits (2 possible values per digit) is decoded into one byte (256 possible values).
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;
Insert an element e into the set x.
$x = Set::Scalar->new;
$e = 'an element';
Remove the element e from the set x.

Explains what happens if e was already absent from x.
@x = grep $e ne $_, @x;
Alternative implementation:
my %set;
my @list = ( 'a' .. 'f' );
$set{$_} = 1 for @list;

delete $set{'c'};	# delete specific key

use v5.20;
delete %set{'a','e'}	# delete hash slice
Alternative implementation:
my $set = Set::Scalar->new( 'a' .. 'f' );

print "Contents of set:\n";
print $set;


print "\nAfter removing elements b and e:\n";
print $set;
Read one line into the string line.

Explain what happens if EOF is reached.
$line = <STDIN>;
Read all the lines (until EOF) into the list of strings lines.
@lines = <STDIN>;
Remove all the elements from the map m that don't satisfy the predicate p.
Keep all the elements that do satisfy p.

Explain if the filtering happens in-place, i.e. if m is reused or if a new map is created.
$p = sub { $_[0] };

while ( ($k,$v) = each %m ) {
    $f{$k} = $v if $p->($v);

%m = %f;
Alternative implementation:
$p = sub { $_[0] };

foreach $k (keys %m) {
    delete $m{$k} if not $p->( $m{$k} );            
You have a Point with integer coordinates x and y. Create a map m with key type Point (or equivalent) and value type string. Insert "Hello" at position (42, 5).
my %m;
my $p = Point->new(x => 42, y => 5);

$m{$p} = 'Hello';
Declare a type Foo, and create a new map with Foo as key type.

Mention the conditions on Foo required to make it a possible map key type.
class Foo {
    has $x :param = 0;
my $p = Foo->new(x => 5);

my %map;

$map{$p} = 'some data';
Alternative implementation:
package Foo {    
    sub new { 
        my $class = shift; 
        return bless { @_ }, $class 
my $p = Foo->new(x => 5);

my %map;

$map{$p} = 'some data';
Build the list parts consisting of substrings of input string s, separated by the string sep.
@parts = split quotemeta($sep), $s;
Create a new list a (or array, or slice) of size n, where all elements are integers initialized with the value 0.
my @a = (0) x $n;
Given two floating point variables a and b, set a to a to a quiet NaN and b to a signalling NaN. Use standard features of the language only, without invoking undefined behavior.
# built-in support (use POSIX not needed))
my $a = 'nan';

say $a;
# prints string value: nan

say 0 + $a;
# prints numeric value: NaN

Alternative implementation:
say isnan($a) ? 'true' : 'false';;
# prints true

say $a == $a ? 'true' : 'false';
# prints false because NaN does not equal NaN

say issignaling($a) ? 'true' : 'false';
# prints false because $a is non-signaling

my $b = nan(999);  # set to signaling NaN by adding a payload

say $b;
# prints NaN

say getpayload($b);
# prints 999
Print a line "Char i is c" for each character c of the string s, where i is the character index of c in s (not the byte index).

Make sure that multi-byte characters are properly handled, and count for a single character.
binmode STDOUT, ":utf8"; 

while ($s =~ /(\X)/g) {
    say 'Char ' . pos($s) . ' is ' . $1;
Assign to n the number of bytes in the string s.

This can be different from the number of characters. If n includes more bytes than the characters per se (trailing zero, length field, etc.) then explain it. One byte is 8 bits.
say length $text;  # prints 1

my $utf8 = Encode::encode('UTF-8', $text);
say length $utf8;  # prints 2
Set the boolean b to true if the set x contains the element e, false otherwise.
$b = $x{$e};
Create the string s by concatenating the strings a and b.
my $s = $a . $b;
Sort the part of the list items from index i (included) to index j (excluded), in place, using the comparator c.

Elements before i and after j must remain unchanged.
@items[$i..$j] = sort $c @items[$i..$j];
Delete all the elements from index i (included) to index j (excluded) from the list items.
splice @items, $i, ($j - $i);
Write "Hello World and 你好" to standard output in UTF-8.
binmode STDOUT, ':utf8';

print('Hello World and 你好');
Create a new stack s, push an element x, then pop the element into the variable y.
my @s;
push @s, $x;
my $y = pop @s;
Given an array a containing the three values 1, 12, 42, print out
"1, 12, 42" with a comma and a space after each integer except the last one.
@a = qw (1 12 42);
print join(", ",@a),"\n";
Given the enumerated type T, create a function TryStrToEnum that takes a string s as input and converts it into an enum value of type T.

Explain whether the conversion is case sensitive or not.
Explain what happens if the conversion fails.
my %T = ( RED => 1, GREEN => 2, BLUE => 3 );

sub TryStrToEnum { my $s = shift; $T{uc $s} }

print GREEN;  # prints 2
print TryStrToEnum('BLUE');  prints 3

Alternative implementation:
use constant { RED => 1, GREEN => 2, BLUE => 3 };

sub TryStrToEnum { eval uc shift }

say GREEN; # prints 2
say TryStrToEnum('BLUE'); # prints 3
Assign to x2 the value of string x with the last occurrence of y replaced by z.
If y is not contained in x, then x2 has the same value as x.
$x = 'A BB CCC this DDD EEEE this FFF';
$y = 'this';
$z = 'that';

$x2 = $x;
$pos = rindex $x, $y;
substr($x2, $pos, length($y)) = $z
    unless $pos == -1;

print $x2;
Sort the string list data in a case-insensitive manner.

The sorting must not destroy the original casing of the strings.
@data = sort { lc($a) cmp lc($b) } @data;
Create the map y by cloning the map x.

y is a shallow copy, not a deep copy.
my %y = %x;
Write a line of comments.

This line will not be compiled or executed.
# This is a comment
Compute the Fibonacci sequence of n numbers using recursion.

Note that naive recursion is extremely inefficient for this task.
sub fib {
    my ($n) = @_;
    die if $n < 0;
    return 1 if $n < 2;
    return fib($n-1) + fib($n-2);
Given the integer x = 8, assign to the string s the value "Our sun has 8 planets", where the number 8 was evaluated from x.
$s = "Our sun has $x planets"
Declare an array a of integers with six elements, where the first index is 42 and consecutive elements have the indices 43, 44, 45, 46, 47.
use Array::Base +42;

my @a = ('A'..'Z');

say $a[42]; # prints A
say $a[43]; # prints B

no Array::Base;  # restore indexing to base 0
Create the array of bytes data by encoding the string s in UTF-8.
my $text = 'Café';


my @utf8 = unpack('C*', $text);
Alternative implementation:
my $text = 'Café';

my @utf8 = unpack 'C*', Encode::encode 'UTF-8', $text;

Compute and print a^b, and a^n, where a and b are floating point numbers and n is an integer.
my ($a, $b, $n) = (4.0, 0.5, 3);

say $a**$b;  # prints 2
say $a**$n;  # prints 64
Preallocate memory in the list x for a minimum total capacity of 200 elements.

This is not possible in all languages. It is only meant as a performance optimization, should not change the length of x, and should not have any effect on correctness.
my @list = (undef) x 200;
Create a function that XOR encrypts/decrypts a string
sub xor_crypt {
    my ($b, $k) = @_;
    return $b ^ $k;
Create the string representation s of the integer value n in base b.

18 in base 3 -> "200"
26 in base 5 -> "101"
121 in base 12 -> "a1"

sub int_to_base_str {
    my ($n, $b) = @_;
    my $digits = '0123456789abcdefghijklmnopqrstuvwxyz';
    my ($s, $q, $remainder) = ('');

    return '0' if $n == 0;

    use integer;

    while ($n) {
        ($n, $remainder) = ($n / $b, $n % $b), 
        $s = substr($digits, $remainder, 1) . $s;

    return $s
Create the new 2-dimensional array y containing a copy of the elements of the 2-dimensional array x.

x and y must not share memory. Subsequent modifications of y must not affect x.
$y = dclone($x);
Fill the byte array a with randomly generated bytes.
my $s = random_bytes( $number_of_bytes );
my @a = split //, $s;
Alternative implementation:
my $n = 20;

my $bytestring;
foreach my $i (0 .. $n*8 - 1) {
    vec($bytestring, $i, 1) = rand(2);

Create the new object y by cloning the all the contents of x, recursively.
my $x = [ 1, 2, [ 'a' ], { x => [3,4] } ];

my $y = dclone $x;
Set b to true if the lists p and q have the same size and the same elements, false otherwise.
$b = @array1 ~~ @array2;
Alternative implementation:
my $b = \@array1 |M| \@array2;
Alternative implementation:
sub lcomp {
    my ($a, $b) = @_;

    return 0 if ( @$a != @$b ); # lengths different

    my $matched = 1;
    for (my $i=0; $i < @$a; $i++) {
        return 0 unless $a->[$i] == $b->[$i];

    return 1;
Alternative implementation:
$b = Compare( \@p, \@q );
Set b to true if the maps m and n have the same key/value entries, false otherwise.
$b = Compare( \%hash1, \%hash2 );
Alternative implementation:
sub hcmp_numeric {
    my ($h, $g) = @_;

    my $hc = keys %$h;
    my $gc = keys %$g;

    return 0 unless $hc == $gc;
    return 0 unless $hc == grep { exists $g->{$_} } keys %$h;
    die 'non-scalar value detected' 
        if 0 < grep { ref $h->{$_} or ref $g->{$_} } keys %$h;
    return 0 unless $hc == grep { $h->{$_} == $g->{$_} } keys %$h;
    return 1;
Set all the elements in the array x to the same value v
my @x = ($v) x $n;
Alternative implementation:
my @x = (undef) x $n; 

foreach (@x) { $_ = $v }