Perl

Perl is a high-level, general-purpose, interpreted, dynamic programming language known for text processing and system administration.

#!/usr/bin/env perl
use strict;
use warnings;

print "Hello, World!\n";

# Scalar (single value)
my $name = "John";
my $age = 30;
my $price = 19.99;

# Array (ordered list)
my @colors = ("red", "green", "blue");
my @numbers = (1, 2, 3, 4, 5);

# Hash (key-value pairs)
my %person = (
    name => "Alice",
    age => 25,
    city => "NYC"
);

# String concatenation
my $full = $first . " " . $last;

# String repetition
my $line = "-" x 40;  # 40 dashes

# Numeric comparison
$a == $b    # equal
$a != $b    # not equal
$a < $b     # less than

# String comparison
$a eq $b    # equal
$a ne $b    # not equal
$a lt $b    # less than

my $string = "Hello";
my $number = 42;
my $float = 3.14;
my $ref = \@array;  # Reference

# Access
print $string;
print "$string world";  # Interpolation

my @fruits = ("apple", "banana", "cherry");

# Access by index (0-based)
print $fruits[0];     # apple
print $fruits[-1];    # cherry (last)

# Size
my $size = scalar @fruits;
my $last_idx = $#fruits;  # Last index

# Slice
my @some = @fruits[0, 2];  # apple, cherry

my %ages = (
    Alice => 30,
    Bob => 25,
    Carol => 35
);

# Access
print $ages{Alice};   # 30

# Keys and values
my @names = keys %ages;
my @values = values %ages;

# Check existence
if (exists $ages{Alice}) { ... }

# Delete
delete $ages{Bob};

$_      # Default variable
@_      # Subroutine parameters
$!      # System error message
$?      # Child process exit status
$$      # Process ID
$0      # Program name
@ARGV   # Command line arguments
%ENV    # Environment variables

if ($age >= 18) {
    print "Adult";
} elsif ($age >= 13) {
    print "Teenager";
} else {
    print "Child";
}

# Postfix form
print "Adult" if $age >= 18;

# Unless (negated if)
unless ($error) {
    process_data();
}

print "OK" unless $error;

my $status = $age >= 18 ? "Adult" : "Minor";

# For loop
for (my $i = 0; $i < 10; $i++) {
    print "$i\n";
}

# Foreach loop
foreach my $item (@items) {
    print "$item\n";
}

# Iterate with index
for my $i (0 .. $#items) {
    print "$i: $items[$i]\n";
}

# While loop
while ($count < 10) {
    $count++;
}

# Until loop
until ($done) {
    process();
}

# Next (continue)
foreach my $num (@numbers) {
    next if $num % 2 == 0;  # Skip even
    print "$num\n";
}

# Last (break)
foreach my $item (@items) {
    last if $item eq "stop";
    print "$item\n";
}

# Redo (restart iteration)
while ($tries < 3) {
    get_input();
    redo if invalid($input);
    $tries++;
}

sub greet {
    my ($name) = @_;
    return "Hello, $name!";
}

my $msg = greet("Alice");

sub add {
    my ($a, $b) = @_;
    return $a + $b;
}

my $sum = add(5, 3);

sub sum_all {
    my $total = 0;
    foreach my $num (@_) {
        $total += $num;
    }
    return $total;
}

my $result = sum_all(1, 2, 3, 4, 5);

sub greet {
    my ($name, $greeting) = @_;
    $greeting //= "Hello";  # Default value
    return "$greeting, $name!";
}

print greet("Bob");              # Hello, Bob!
print greet("Bob", "Hi");        # Hi, Bob!

sub create_user {
    my %args = @_;
    my $name = $args{name};
    my $email = $args{email};
    my $role = $args{role} // "user";
    # ...
}

create_user(
    name => "Alice",
    email => "alice@example.com",
    role => "admin"
);

# Single value
sub square {
    my ($n) = @_;
    return $n * $n;
}

# Multiple values
sub min_max {
    my @nums = @_;
    my $min = (sort {$a <=> $b} @nums)[0];
    my $max = (sort {$a <=> $b} @nums)[-1];
    return ($min, $max);
}

my ($min, $max) = min_max(3, 7, 1, 9);

my $text = "Hello World";

# Match operator
if ($text =~ /World/) {
    print "Found!\n";
}

# Negated match
if ($text !~ /Goodbye/) {
    print "Not found!\n";
}

# Case insensitive
if ($text =~ /world/i) {
    print "Found!\n";
}

my $date = "2026-02-06";

if ($date =~ /(\d{4})-(\d{2})-(\d{2})/) {
    my $year = $1;
    my $month = $2;
    my $day = $3;
    print "Year: $year\n";
}

# Named captures (Perl 5.10+)
if ($date =~ /(?<year>\d{4})-(?<month>\d{2})-(?<day>\d{2})/) {
    print "Year: $+{year}\n";
}

my $text = "Hello World";

# Replace first occurrence
$text =~ s/World/Perl/;

# Replace all (global)
$text =~ s/o/0/g;

# Case insensitive replace
$text =~ s/hello/Hi/i;

# With backreferences
$text =~ s/(\w+) (\w+)/$2 $1/;  # Swap words

/pattern/i   # Case insensitive
/pattern/g   # Global (all matches)
/pattern/m   # Multiline (^ and $ match line boundaries)
/pattern/s   # Single line (. matches newline)
/pattern/x   # Extended (ignore whitespace, allow comments)

# Combined
$text =~ s/pattern/replacement/gi;

# Email
/\b[A-Za-z0-9._%+-]+@[A-Za-z0-9.-]+\.[A-Z|a-z]{2,}\b/

# URL
/https?:\/\/[\w\-\.]+\.\w{2,}/

# IP address
/\b\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\b/

# Phone (US)
/\d{3}-\d{3}-\d{4}/

# Whitespace
/\s+/      # One or more
/^\s+/     # Leading
/\s+$/     # Trailing

my @stack = (1, 2, 3);

# Add to end
push @stack, 4, 5;        # (1,2,3,4,5)

# Add to beginning
unshift @stack, 0;        # (0,1,2,3,4,5)

my @stack = (1, 2, 3, 4, 5);

# Remove from end
my $last = pop @stack;    # Returns 5

# Remove from beginning
my $first = shift @stack; # Returns 1

# Remove by index
splice @stack, 1, 1;      # Remove element at index 1

my @nums = (0, 1, 2, 3, 4, 5);

# Get range
my @slice = @nums[1..3];  # (1, 2, 3)

# Get specific elements
my @some = @nums[0, 2, 4]; # (0, 2, 4)

# Replace slice
@nums[1..3] = (10, 20, 30);

my @nums = (5, 2, 8, 1, 9);

# Numeric sort
my @sorted = sort {$a <=> $b} @nums;

# String sort (default)
my @words = sort @words;

# Reverse sort
my @reversed = sort {$b <=> $a} @nums;

# Reverse
my @rev = reverse @nums;

# Map (transform each element)
my @squared = map { $_ * $_ } @nums;
my @upper = map { uc $_ } @words;

# Grep (filter)
my @evens = grep { $_ % 2 == 0 } @nums;
my @long = grep { length $_ > 5 } @words;

# Join
my $str = join(", ", @items);

# Split
my @parts = split(/,/, $str);
my @words = split(/\s+/, $text);

# Three-argument open (recommended)
open(my $fh, '<', 'input.txt') or die "Cannot open: $!";

while (my $line = <$fh>) {
    chomp $line;  # Remove newline
    print "$line\n";
}

close $fh;

# Read all lines
open(my $fh, '<', 'input.txt') or die $!;
my @lines = <$fh>;
close $fh;

# Write mode (overwrites)
open(my $fh, '>', 'output.txt') or die $!;
print $fh "Hello\n";
print $fh "World\n";
close $fh;

# Append mode
open(my $fh, '>>', 'output.txt') or die $!;
print $fh "Appended line\n";
close $fh;

if (-e $file) { }     # Exists
if (-f $file) { }     # Regular file
if (-d $file) { }     # Directory
if (-r $file) { }     # Readable
if (-w $file) { }     # Writable
if (-x $file) { }     # Executable
if (-z $file) { }     # Zero size
if (-s $file) { }     # Size in bytes

my $size = -s $file;
my $age = -M $file;   # Age in days

# List directory
opendir(my $dh, '.') or die $!;
my @files = readdir($dh);
closedir $dh;

# Filter out . and ..
@files = grep { !/^\.\.?$/ } @files;

# Create directory
mkdir('newdir', 0755) or die $!;

# Remove directory
rmdir('olddir') or die $!;

# Change directory
chdir('/tmp') or die $!;

use File::Basename;
use File::Spec;

my $path = "/path/to/file.txt";

my $dir = dirname($path);      # /path/to
my $file = basename($path);    # file.txt
my ($name, $ext) = split(/\./, $file);

# Build path
my $full = File::Spec->catfile($dir, $file);

my $str = "Hello World";

# Length
my $len = length($str);

# Substring
my $sub = substr($str, 0, 5);     # "Hello"
my $sub = substr($str, 6);        # "World"
my $sub = substr($str, -5);       # "World"

# Replace substring
substr($str, 0, 5) = "Hi";        # "Hi World"

# Case conversion
my $upper = uc($str);             # HELLO WORLD
my $lower = lc($str);             # hello world
my $title = ucfirst($str);        # Hello world

my $str = "  Hello World  ";

# Remove leading whitespace
$str =~ s/^\s+//;

# Remove trailing whitespace
$str =~ s/\s+$//;

# Remove both (trim)
$str =~ s/^\s+|\s+$//g;

# Using a subroutine
sub trim {
    my $s = shift;
    $s =~ s/^\s+|\s+$//g;
    return $s;
}

my $str = "Hello World";

# Index (position of substring)
my $pos = index($str, "World");      # 6
my $pos = index($str, "Foo");        # -1 (not found)

# Reverse index
my $pos = rindex($str, "o");         # 7 (last o)

# Contains
if (index($str, "World") != -1) { }

# Starts with
if ($str =~ /^Hello/) { }

# Ends with
if ($str =~ /World$/) { }

# Split string
my $csv = "a,b,c,d";
my @parts = split(/,/, $csv);

# Limit splits
my @parts = split(/,/, $csv, 2);  # ("a", "b,c,d")

# Split on whitespace
my @words = split(/\s+/, $text);

# Join array
my $str = join(", ", @items);
my $str = join("\n", @lines);

# Load module
use strict;
use warnings;
use Data::Dumper;
use File::Basename qw(dirname basename);

# Runtime loading
require Some::Module;

# Version requirement
use Modern::Perl 5.10;

# lib/MyModule.pm
package MyModule;
use strict;
use warnings;

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

sub method {
    my ($self, $arg) = @_;
    return $self->{value};
}

1;  # Must return true

# Exporter pattern
package MyUtils;
use strict;
use warnings;
use Exporter 'import';

our @EXPORT_OK = qw(func1 func2);

sub func1 { ... }
sub func2 { ... }

1;

# Usage
use MyUtils qw(func1 func2);
func1();
func2();

my $scalar = 42;
my @array = (1, 2, 3);
my %hash = (a => 1, b => 2);

# References
my $scalar_ref = \$scalar;
my $array_ref = \@array;
my $hash_ref = \%hash;

# Anonymous structures
my $arr_ref = [1, 2, 3];
my $hash_ref = {a => 1, b => 2};

# Explicit dereferencing
my $val = ${$scalar_ref};
my @arr = @{$array_ref};
my %hsh = %{$hash_ref};

# Arrow operator
my $first = $array_ref->[0];
my $value = $hash_ref->{key};

# Method call
my $result = $object_ref->method();

# Array of arrays
my $matrix = [
    [1, 2, 3],
    [4, 5, 6],
    [7, 8, 9]
];

print $matrix->[0][0];  # 1
print $matrix->[1][2];  # 6

# Hash of hashes
my $users = {
    alice => {age => 30, city => "NYC"},
    bob => {age => 25, city => "LA"}
};

print $users->{alice}{age};  # 30

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 get_name {
    my ($self) = @_;
    return $self->{name};
}

sub set_age {
    my ($self, $age) = @_;
    $self->{age} = $age;
}

1;

use Person;

my $person = Person->new(
    name => "Alice",
    age => 30
);

my $name = $person->get_name();
$person->set_age(31);

package Employee;
use strict;
use warnings;
use parent 'Person';  # Inherits from Person

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

1;

# Default value if undef
my $name = $user_input // "Anonymous";

# In-place
$config{timeout} //= 30;

# Check existence before access
my $value = exists $hash{key} ? $hash{key} : undef;

# With defined
my $upper = defined $str ? uc($str) : undef;

OUTER: for my $i (1..10) {
    INNER: for my $j (1..10) {
        last OUTER if $i * $j > 50;
        next INNER if $i == $j;
        print "$i x $j\n";
    }
}

# Sort by complex criteria
my @sorted = map { $_->[0] }
             sort { $a->[1] <=> $b->[1] }
             map { [$_, compute($_)] }
             @items;

# Read entire file
{
    local $/;  # Undefine record separator
    open my $fh, '<', 'file.txt' or die $!;
    my $content = <$fh>;
    close $fh;
}

# Or with Path::Tiny
use Path::Tiny;
my $content = path('file.txt')->slurp_utf8;

# Die (fatal error)
die "Error: file not found" unless -e $file;
open my $fh, '<', $file or die "Cannot open $file: $!";

# Warn (non-fatal)
warn "Warning: deprecated function\n";

# Catch exceptions
eval {
    risky_operation();
};
if ($@) {
    print "Error: $@\n";
}

# With Try::Tiny (recommended)
use Try::Tiny;

try {
    risky_operation();
} catch {
    print "Error: $_\n";
};

package MyException;
use strict;
use warnings;
use overload '""' => 'as_string';

sub new {
    my ($class, $message) = @_;
    return bless {message => $message}, $class;
}

sub as_string {
    my ($self) = @_;
    return $self->{message};
}

1;

# Throw
die MyException->new("Something went wrong");

use strict;
use warnings;

Catches common errors like typos and undefined variables.

# WRONG
if ("10" == "9") { }   # False (numeric)

# RIGHT
if ("10" eq "9") { }   # True (string comparison)

Use ==, !=, <, > for numbers. Use eq, ne, lt, gt for strings.

# WRONG (security risk)
open my $fh, $filename or die $!;

# RIGHT
open my $fh, '<', $filename or die $!;

Prevents filename injection attacks.

# WRONG (global)
open FILE, '<', 'data.txt' or die $!;

# RIGHT (lexical, auto-closes)
open my $fh, '<', 'data.txt' or die $!;

Lexical filehandles close automatically when out of scope.

my @items = (1, 2, 3, 4, 5);
my $count = @items;  # 5 (size)

# Use scalar() to be explicit
my $count = scalar @items;

my %hash = (a => 1, b => 2);

# Flattens to (a, 1, b, 2)
my @list = %hash;

# Get keys or values explicitly
my @keys = keys %hash;
my @values = values %hash;

# These are readable
print "Found\n" if $found;
next unless $valid;

# These are less readable
do_complex_operation() if some_complex_condition();

Use postfix form for simple one-liners only.

# Greedy by default
"<tag>content</tag>" =~ /<.*>/;  # Matches entire string

# Use non-greedy
"<tag>content</tag>" =~ /<.*?>/; # Matches <tag>

# Use \Q..\E for literal strings
my $literal = "a.b";
$text =~ /\Q$literal\E/;  # Matches "a.b" not "a<any>b"

# Check for defined
if (defined $var) { }

# Don't compare with undef
if ($var == undef) { }    # WRONG
if (!defined $var) { }    # RIGHT

# Use defined-or operator
my $val = $config{key} // $default;