Perl

#!/usr/bin/env perl
use strict;       # require variable declarations, ban barewords
use warnings;    # warn about suspicious constructs
use feature 'say';  # enable say(), given/when, etc.

say "Hello, world!";

perl script.pl              # run a script file
perl -e 'say "hi"'          # execute a one-liner
perl -c script.pl           # syntax-check only, don't run
perl -w script.pl           # enable warnings (prefer 'use warnings')
./script.pl                 # execute directly (needs chmod +x and shebang)
perl -d script.pl           # interactive debugger

my $scalar  = "one value";   # $ — a single value (string, number, ref)
my @array   = (1, 2, 3);     # @ — an ordered list of scalars
my %hash    = (a => 1);       # % — key/value pairs (dictionary/map)
my $ref     = \@array;        # $ — a reference is always a scalar

$array[0]         # one element → scalar → $
@array[1,3]       # slice (multiple elements) → list → @
$hash{key}        # one hash value → scalar → $
@hash{qw(a b)}   # hash slice → list → @

my $x         # declare a lexical (block-scoped) variable
my ($a, $b)   # declare multiple at once
my @list      # declare an array
my %map       # declare a hash

# 'our' for package globals, 'local' for dynamic scope override
our $VERSION = "1.0";
local $/     = undef;    # temp override, restored on block exit

'single quotes'         # literal — no interpolation, no escapes (except \' \\)
"double quotes"         # interpolates $vars and @arrays, processes \n \t etc.
q(same as single)       # q() = ''. Any delimiter works: q|..| q{..} q/..
qq(same as double)      # qq() = "". Any delimiter: qq|..| qq{..}
qw(word1 word2 word3)   # quote-words → ('word1','word2','word3') — great for lists

"hello" . " world"      # concatenation (. not +)
"ha" x 3               # repetition → "hahaha"
("x","y") x 2          # list repetition → ("x","y","x","y")

length($s)              # character count
substr($s, 2, 4)       # substr(string, offset, length)
index($s, "foo")        # first occurrence position (-1 if not found)
uc($s)  lc($s)          # uppercase / lowercase
chomp($s)               # remove trailing newline (modifies in place)
chop($s)                # remove and return last character
sprintf("%.2f", $n)    # formatted string (like printf to a variable)
split(/,/, $s)         # split string on regex → array
join(",", @a)           # join array elements into string

my $text = <<END;         # interpolates (double-quote behaviour)
  Hello, $name.
END

my $raw = <<'END';       # quoted label → no interpolation
  Literal $text here.
END

my $ind = <<~END;        # ~ strips leading whitespace (5.26+)
    Can be indented.
    END

42   3.14   6.02e23   0xFF   0b1010   0777   1_000_000
+  -  *  /  %  **         # ** is exponentiation (no ^)
++  --                    # auto-increment/decrement (works on strings too!)
abs($n)  int($n)  sqrt($n)

# Symbol forms — HIGH precedence (use inside expressions)
$a && $b    $a || $b    !$a

# Word forms — LOW precedence (use at statement level)
$a and $b   $a or $b   not $a

# Defined-or (5.10+) — preferred over || when 0 is a valid value
$val // "default"      # use right side only if left is undef
$val //= "default"     # assign default if $val is undef

# Classic idioms
open(my $fh, '<', $f) or die $!;   # or-die — open file or crash

undef   0   ""   "0"   ()   # ← "0" being false surprises people

# These are all TRUE:
"00"   "0.0"   "false"   0.0  (note: 0.0 == 0, so actually FALSE)

unless ($done) { do_work(); }   # equivalent to: if (!$done) { ... }

print "yes\n"  if     $flag;
print "no\n"   unless $flag;
return         if     !defined $input;   # guard clause
die "bad\n"    if     $error;

my $label = $n > 0 ? "positive" : "non-positive";

# Cascading ternary (format in columns for readability)
my $grade =   $s >= 90 ? 'A'
            : $s >= 80 ? 'B'
            : $s >= 70 ? 'C'
            :             'F';

# while / until
while ($i < 10)   { $i++ }
until ($done)     { work() }     # loops while condition is FALSE

# do...while (always executes body at least once)
do {
    $input = <STDIN>;
} while ($input !~ /^quit/);

# C-style for
for (my $i = 0; $i < 10; $i++) { say $i }

# foreach — iterate over a list
foreach my $item (@list) { say $item }
for my $item (@list)    { say $item }     # 'for' and 'foreach' are identical

# Default variable $_ — many operations use it implicitly
for (@list)          { print }          # $_ is each element; print prints $_
print "$_\n"          for @list;        # postfix form

last;           # break — exit the loop
next;           # continue — skip to next iteration
redo;           # restart current iteration without re-testing condition

# Labels for nested loop control
OUTER: for my $i (1..5) {
    for my $j (1..5) {
        next OUTER if $j == 3;   # skip outer iteration
        last OUTER if $i == 4;   # exit both loops
    }
}

my @a = (1, 2, 3);          # declaration
my @b = qw(foo bar baz);    # from whitespace-separated words
my @c = (1..10);            # range operator → (1,2,3,...,10)

$a[0]    $a[-1]            # first / last element
$#a                         # last index (= scalar(@a) - 1)
scalar @a                   # number of elements (in scalar context: $n = @a)

push    @a, "x";           # append to end
my $v = pop     @a;       # remove and return last
unshift @a, "x";           # prepend to front
my $v = shift   @a;       # remove and return first
splice(@a, $off, $len, @new);  # insert/remove at any position

sort             @a         # alphabetical
sort { $a <=> $b } @a     # numeric ascending ($a,$b are special sort vars)
sort { $b <=> $a } @a     # numeric descending
reverse @a                  # reversed list (returns new list)

grep { $_ > 5 } @a         # filter — returns elements where block is true
map  { $_ * 2 } @a         # transform — applies block to each, returns new list
map  { $_ => 1 } @a        # build a lookup hash from an array

my %h = (
    name  => "Alice",   # => is "fat comma" — auto-quotes left side
    age   => 30,
    lang  => "Perl",
);

$h{name}              # access a value (bare word key is fine)
$h{"any string"}      # quoted key for special characters
$h{missing}           # returns undef if key doesn't exist

keys   %h             # list of all keys (arbitrary order)
values %h             # list of all values
each   %h             # next (key, value) pair — use in while loop

exists  $h{key}       # true if key exists (even if value is undef)
defined $h{key}       # true if value is defined
delete  $h{key}       # remove key/value pair

# Iteration
for my $k (sort keys %h) {
    say "$k = $h{$k}";
}

# Create references
my $aref = \@array;           # reference to existing array
my $href = \%hash;            # reference to existing hash
my $sref = \$scalar;         # reference to scalar
my $cref = \&mysub;          # reference to subroutine

# Anonymous constructors (create inline)
my $aref = [1, 2, 3];         # [ ] = anonymous arrayref
my $href = {name => "Alice"}; # { } = anonymous hashref
my $cref = sub { $_[0] * 2 }; # sub { } = anonymous sub / lambda

# Dereference with arrow notation (preferred)
$aref->[0]            # element 0 of arrayref
$href->{name}          # value for 'name' in hashref
$cref->(@args)         # call a coderef

# Adjacent brackets don't need the arrow
$aref->[0]{key}        # same as $aref->[0]->{key}

# Dereference the whole thing
@{$aref}               # as array
%{$href}               # as hash

ref($aref)             # "ARRAY" — check the reference type
ref($href)             # "HASH"
ref($obj)              # "ClassName" for blessed objects

# Array of hashrefs — the most common pattern
my @people = (
    {name => "Alice", age => 30},
    {name => "Bob",   age => 25},
);
$people[0]{name}       # "Alice"

# Hash of arrayrefs
my %tags = (perl => ["scripting", "text"]);
$tags{perl}[0]         # "scripting"

# Push into a nested structure
push @{$tags{perl}}, "regex";

sub create_user {
    my (%args) = @_;
    my $name  = $args{name}  // "Guest";
    my $email = $args{email} or die "email required";
    return {name => $name, email => $email};
}

create_user(name => "Alice", email => "a@b.com");

sub flexible {
    return wantarray ? (1,2,3) : "one-two-three";
}
my @list  = flexible();    # list context  → (1, 2, 3)
my $str   = flexible();    # scalar context → "one-two-three"

my $x = "outer";
{
    my $x = "inner";   # shadows outer $x in this block
    say $x;             # "inner"
}
say $x;                 # "outer" — inner $x is gone

# local temporarily replaces a global, restores on block exit
our $sep = ",";
{
    local $sep = "|";   # $sep is "|" only here and in any subs called
}                        # $sep is "," again

sub make_adder {
    my $n = shift;
    return sub { $_[0] + $n };   # captures $n from enclosing scope
}
my $add5  = make_adder(5);
my $add10 = make_adder(10);
$add5->(3);   # 8
$add10->(3);  # 13

# Matching — =~ binds a string to a regex operation
$s =~  /pattern/         # true if matches
$s !~  /pattern/         # true if does NOT match
if (/pattern/)           # implicit match against $_ (very common in loops)

# Capture groups
if ($date =~ /(\d{4})-(\d{2})-(\d{2})/) {
    my ($y, $m, $d) = ($1, $2, $3);      # $1..$9 capture groups
}
# Named captures (cleaner)
$date =~ /(?<year>\d{4})-(?<month>\d{2})/;
say $+{year};               # named capture via %+

# Global match — all occurrences
my @nums = ($s =~ /\d+/g);  # list of all matches

# Substitution
$s =~ s/old/new/;          # replace first match
$s =~ s/old/new/g;         # replace all
$s =~ s/old/new/gi;        # case-insensitive + global
my $new = $s =~ s/a/b/gr;  # /r = return copy, don't modify $s

# Transliteration (character-by-character swap)
$s =~ tr/a-z/A-Z/;        # uppercase all letters
my $count = ($s =~ tr/aeiou//);   # count vowels (no replacement = count)

# Store a pattern
my $pat = qr/\d{4}-\d{2}/;  # compiled regex object
$s =~ $pat;

# Always use three-argument open
open(my $fh, '<',  'in.txt')  or die $!;  # read
open(my $fh, '>',  'out.txt') or die $!;  # write (truncates)
open(my $fh, '>>', 'log.txt') or die $!;  # append
open(my $fh, '<:utf8', $path) or die $!;  # with encoding layer

# Read line by line
while (my $line = <$fh>) {
    chomp $line;
    # process $line
}

# Slurp entire file into a string
my $content = do { local $/; <$fh> };

# Read all lines into an array
my @lines = <$fh>;
chomp @lines;

# Write
print {$fh} "line\n";    # braces around filehandle — avoid ambiguity
say   {$fh} "line";

close $fh;

# Diamond operator — reads ARGV files or STDIN (great for filters)
while (<>) { print }

# File test operators
-e $path   # exists         -f  is plain file
-d $path   # is directory    -r  readable
-s $path   # file size       -M  age in days (last modified)

package Animal;
use strict; use warnings;

# Constructor — just a sub named 'new' by convention
sub new {
    my ($class, %args) = @_;
    return bless {                    # bless ties data to class
        name  => $args{name},
        sound => $args{sound} // "...",
    }, $class;
}

# Accessor (getter/setter)
sub name {
    my $self = shift;
    $self->{name} = shift if @_;    # set if arg given
    return $self->{name};
}

sub speak {
    my $self = shift;
    printf "%s says %s\n", $self->{name}, $self->{sound};
}

# Subclass
package Dog;
use parent 'Animal';    # inherit from Animal

sub new {
    my ($class, %args) = @_;
    $args{sound} //= "Woof";
    return $class->SUPER::new(%args);   # call parent constructor
}

# Usage
package main;
my $d = Dog->new(name => "Rex");
$d->speak();                           # "Rex says Woof"
ref($d);                               # "Dog"
$d->isa('Animal');                    # 1 (true)
$d->can('speak');                    # returns coderef or undef

# Throw a string
die "something failed at line 42";

# Throw an object (structured exceptions)
die { code => 404, msg => "not found" };
die MyException->new(msg => "bad");

# Check type of exception
eval { risky() };
if (ref $@ eq 'HASH')          { say $@->{msg} }
elsif ($@)                       { die $@ }      # re-throw unknown errors

# Carp module — reports error from the caller's location
use Carp qw(carp croak confess);
croak   "bad input";       # like die but points to caller
carp    "suspicious";      # like warn but points to caller
confess "deep error";     # die + full stack trace

# Loading modules
use List::Util qw(sum max min first any all);   # import specific subs
use File::Path;                                    # import defaults
use Scalar::Util ();                              # load without importing
use strict;                                        # pragma — no symbol

# use vs require
use     Foo;   # compile-time: load + import + run BEGIN block
require Foo;   # runtime: load only, no automatic import

# Writing a module (Foo.pm)
package Foo;
use strict; use warnings;
use Exporter 'import';
our @EXPORT_OK = qw(my_func another_func);   # export on request

sub my_func { ... }

1;   # REQUIRED — module must return a true value

cpanm Module::Name              # cpanminus — recommended
perl -MCPAN -e 'install Foo'    # built-in CPAN shell
apt/brew install perl-Foo       # system package manager