1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# Single line comment
=pod
Multi-line comment
or documentation block
=cut

# Print statement
print "Hello, World!\n";

# say() adds a newline automatically (requires feature)
use feature 'say';
say "Hello, World!";

# Semicolons are required to end statements
my $variable = "value";

# Blocks use curly braces, not indentation
if ($condition) {
    print "Condition is true";
}

# Enable modern Perl features in one line (Perl 5.36+)
use v5.36;   # implies strict, warnings, say, signatures, isa, etc.

1
2
3
4
5
my $integer = 42;           # Integer
my $float = 3.14;           # Floating point
my $string = "Hello";       # String
my $undef = undef;          # Undefined value

1
2
3
4
5
6
my @fruits = ("apple", "banana", "cherry");
print $fruits[0];           # Accessing first element
push @fruits, "date";       # Add to end
pop @fruits;                # Remove last element
my $count = scalar @fruits; # Number of elements

1
2
3
4
5
6
7
8
9
10
my %person = (
    name => "John",
    age  => 30,
    city => "New York",
);
print $person{name};         # Accessing hash value
$person{country} = "USA";    # Adding new key-value pair
delete $person{age};         # Remove a key
my @keys = keys %person;     # All keys

1
2
3
4
5
6
7
8
9
10
11
12
13
14
my $scalar_ref = \42;               # Scalar reference
my $array_ref = ["a", "b", "c"];    # Array reference
my $hash_ref = {key => "value"};    # Hash reference

# Dereferencing
print $$scalar_ref;
print $array_ref->[1];
print $hash_ref->{key};

# Postfix dereference (Perl 5.24+, no feature pragma required)
my @all = $array_ref->@*;
my %all = $hash_ref->%*;
my @slice = $array_ref->@[0, 2];

1
2
3
4
5
6
7
8
9
10
11
12
13
my  $local_var  = "local";   # Lexically scoped variable (preferred)
our $global_var = "global";  # Package-level variable
state $counter  = 0;         # Persistent lexical (Perl 5.10+)

use constant PI => 3.14159;  # Constant definition

# Special variables
$_;                         # Default input/pattern-searching space
@ARGV;                      # Command-line arguments
%ENV;                       # Environment variables
$0;                         # Program name
$!;                         # System error message

1
2
3
4
5
6
7
my $sum  = 5 + 3;       # Addition
my $diff = 10 - 4;      # Subtraction
my $prod = 6 * 7;       # Multiplication
my $div  = 15 / 3;      # Division
my $mod  = 10 % 3;      # Modulo
my $pow  = 2 ** 3;      # Exponentiation

1
2
3
4
5
6
7
8
9
10
11
12
13
# Numeric comparisons
if (5 == 5)  { }        # Equal
if (10 != 5) { }        # Not equal
if (10 > 5)  { }        # Greater than
if (5 <= 10) { }        # Less than or equal
my $cmp = $a <=> $b;    # Three-way numeric (-1, 0, 1)

# String comparisons
if ("abc" eq "abc") { } # String equal
if ("abc" ne "def") { } # String not equal
if ("abc" lt "def") { } # Less than (lexically)
my $scmp = $a cmp $b;   # Three-way string compare

1
2
3
4
5
if ($a && $b)      { }  # Logical AND
if ($a || $b)      { }  # Logical OR
if (!$condition)   { }  # Logical NOT
my $val = $x // $default; # Defined-or (Perl 5.10+)

1
2
3
4
5
6
7
8
9
10
if ($string =~ /pattern/) {     # Match regex
    # Do something
}
$string =~ s/old/new/g;         # Global substitution
$string =~ tr/a-z/A-Z/;         # Transliteration
my @matches = $text =~ /(\w+)/g; # Capture all matches

# Non-destructive substitution (/r returns modified copy)
my $new = $string =~ s/old/new/gr;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
if ($condition) {
    # Code block
} elsif ($another_condition) {
    # Alternative block
} else {
    # Default block
}

# unless = if not
unless ($ready) { wait_for_it(); }

# Statement modifiers
print "ok\n" if $success;

# Ternary operator
my $result = $condition ? $true_value : $false_value;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
# C-style for loop
for (my $i = 0; $i < 10; $i++) {
    print $i;
}

# Foreach loop (for and foreach are synonyms)
my @array = (1, 2, 3, 4, 5);
foreach my $item (@array) {
    print $item;
}

# Loop over a range
for my $i (1..10) { print $i }

# While / until
while ($condition) { ... }
until ($done)      { ... }

# Do-while loop
do {
    # Code block
} while ($condition);

# Loop control
last;     # break out of loop
next;     # continue with next iteration
redo;     # restart current iteration without re-evaluating condition

1
2
3
4
5
6
7
8
9
10
# given/when was demoted to a removed experimental feature and is
# no longer available in modern Perl. Prefer dispatch tables or
# explicit if/elsif chains.

my %dispatch = (
    add      => sub { $_[0] + $_[1] },
    subtract => sub { $_[0] - $_[1] },
);
my $result = $dispatch{$op}->($a, $b);

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
# Classic subroutine using @_
sub greet {
    my $name = shift;
    return "Hello, $name!";
}

# Subroutine signatures (stable since Perl 5.36)
use v5.36;

sub calculate ($a, $b, $operation = 'add') {
    return $a + $b if $operation eq 'add';
    return $a - $b if $operation eq 'subtract';
    die "Unknown operation: $operation";
}

# Anonymous subroutine (function reference)
my $multiply = sub ($a, $b) { $a * $b };
say $multiply->(3, 4);

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
use v5.38;
use feature 'class';
no warnings 'experimental::class';  # still marked experimental in 5.40

class Person {
    field $name :param;
    field $age  :param;

    method introduce { return "I'm $name, age $age"; }
}

class Employee :isa(Person) {
    field $job :param;

    method describe { return $self->introduce . " ($job)"; }
}

my $e = Employee->new(name => "Ada", age => 36, job => "Engineer");
say $e->describe;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
package Person;
use strict;
use warnings;

sub new {
    my ($class, %args) = @_;
    my $self = { name => $args{name}, age => $args{age} };
    bless $self, $class;
    return $self;
}

sub introduce {
    my ($self) = @_;
    return "I'm " . $self->{name};
}

# Inheritance via `use parent` (preferred over `use base`)
package Employee;
use parent -norequire, 'Person';

sub new {
    my ($class, %args) = @_;
    my $self = $class->SUPER::new(%args);
    $self->{job} = $args{job};
    return $self;
}

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
# Die (terminate program / throw)
die "Fatal error message\n" if $error_condition;

# Warn (print warning)
warn "Warning message\n" if $warning_condition;

# Modern exception handling with try/catch (stable since Perl 5.34)
use feature 'try';
no warnings 'experimental::try';  # required prior to 5.40 in some setups

try {
    risky_call();
}
catch ($e) {
    warn "Caught error: $e";
}
finally {
    cleanup();
}

# Legacy eval { } / $@ still works and is widely seen
eval { die "boom\n" };
if (my $err = $@) { warn "Caught: $err" }

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Reading from a file (three-argument open, lexical filehandle)
open(my $fh, '<', 'filename.txt') or die "Can't open file: $!";
while (my $line = <$fh>) {
    chomp $line;
    print $line, "\n";
}
close $fh;

# Slurping a file with Path::Tiny (recommended modern idiom)
use Path::Tiny;
my $content = path('filename.txt')->slurp_utf8;
path('out.txt')->spew_utf8($content);

# Writing / appending
open(my $out,    '>',  'output.txt') or die "Can't open: $!";
open(my $append, '>>', 'log.txt')    or die "Can't open: $!";

# Opening with an explicit encoding layer
open(my $utf, '<:encoding(UTF-8)', 'data.txt') or die $!;

1
2
3
4
5
6
7
8
9
10
11
12
use v5.36;
use Test::More;

sub add ($a, $b) { return $a + $b }

is   (add(2, 3), 5, "Addition works");
isnt (add(2, 2), 5, "Not equal test");
ok   (add(0, 0) == 0, "Zero works");

# Run with `prove -lr t/` for a whole test tree.
done_testing();