Learning Perl

my @fruits  = ("apple", "banana", "cherry");
my @words   = qw(foo bar baz);   # quote-words shorthand
my @numbers = (1..10);           # range operator
my @empty   = ();               # empty array

$fruits[0]      # "apple" — zero-indexed
$fruits[-1]     # "cherry" — last element
$fruits[-2]     # "banana" — second to last
$#fruits        # 2 — index of last element
scalar @fruits  # 3 — element count (also: $n = @fruits)

# Slices
my @first_two = @fruits[0,1];     # explicit indices
my @slice     = @fruits[0..1];     # range slice

sort @arr                        # alphabetical (default)
sort { $a <=> $b } @arr          # numeric ascending
sort { $b <=> $a } @arr          # numeric descending
sort { lc($a) cmp lc($b) } @arr  # case-insensitive string
reverse sort @arr               # reverse alphabetical

# Schwartzian Transform: sort by expensive-to-compute key
my @sorted = map  { $_->[0] }          # 3. strip key
             sort { $a->[1] <=> $b->[1] }  # 2. sort by key
             map  { [$_, compute_key($_)] }  # 1. attach key
             @arr;

my %person = (
    name  => "Alice",    # => is "fat comma" — auto-quotes left side
    age   => 30,
    city  => "Austin",
);

$person{name}         # "Alice" — curly braces for hash access
$person{"my key"}     # quoted key for non-bareword keys
$person{missing}      # undef (no warning by default)

# Hash slice
my @vals = @person{qw(name age)};  # sigil = @ for slice

# Hash in list context = flattened k/v pairs
my @pairs = %person;   # ("name","Alice","age",30,...) — arbitrary order

# Counting occurrences
my %count;
$count{$_}++ for @words;

# Lookup set (membership test)
my %is_valid = map { $_ => 1 } qw(red green blue);
say "valid" if $is_valid{$color};

# Invert a hash (swap keys and values)
my %reverse = reverse %original;

# Merge two hashes (right-side wins on collision)
my %merged = (%defaults, %overrides);

# Iterate in sorted key order
for my $key (sort keys %h) {
    printf "%-12s => %s\n", $key, $h{$key};
}

# \ operator: reference to an existing variable
my $sref = \$scalar;    # scalar ref
my $aref = \@array;     # array ref
my $href = \%hash;      # hash ref
my $cref = \&mysub;    # code ref

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

# Arrow notation — preferred for readability
$aref->[0]           # array element via ref
$href->{name}         # hash value via ref
$cref->(@args)        # call a code ref
$$sref                # dereference scalar ref

# Block dereference — dereference to full structure
@{$aref}             # whole array
%{$href}             # whole hash
@{$aref}[1,3]        # slice from arrayref
@{$href}{qw(a b)}    # slice from hashref

# Adjacent brackets: arrow is optional between brackets
$aref->[0]{key}        # same as $aref->[0]->{key}

# ref() — identify the type of a reference
ref($aref)    # "ARRAY"
ref($href)    # "HASH"
ref($cref)    # "CODE"
ref($obj)     # "ClassName" for blessed objects
ref($plain)  # "" (empty string) — not a reference

# Hash of code refs — replaces long if/elsif chains
my %actions = (
    add  => sub { $_[0] + $_[1] },
    sub  => sub { $_[0] - $_[1] },
    mul  => sub { $_[0] * $_[1] },
);
my $result = $actions{$op}->($a, $b);

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

# Hash of Arrayrefs (HoA)
my %scores = (
    alice => [92, 88, 95],
    bob   => [74, 80, 65],
);
$scores{alice}[0]  # 92
push @{$scores{bob}}, 91;

# Hash of Hashrefs (HoH)
my %registry = (
    alice => { email => 'a@b.com', role => 'admin' },
    bob   => { email => 'b@b.com', role => 'user'  },
);
$registry{alice}{email}   # 'a@b.com'

# Array of Arrayrefs — 2D matrix
my @matrix = ([1,2,3], [4,5,6], [7,8,9]);
$matrix[1][2]       # 6 (row 1, col 2)

# Deeply nested: array of hashrefs with nested arrays
my @classes = (
    { name    => "Math",
      students => [ {name => "Alice", grade => 'A'},
                    {name => "Bob",   grade => 'B'} ], },
);
$classes[0]{students}[0]{name}   # "Alice"

# while: test first, run while true
while ($i < 10)  { $i++ }

# until: test first, run while FALSE
until ($done)    { work() }

# do/while: always runs body at least once
do {
    $input = <STDIN>; chomp $input;
} while ($input ne 'quit');

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

# foreach (for and foreach are identical keywords)
for my $item (@list)    { say $item   }
foreach my $i (1..10)  { say $i     }

# $_ as implicit variable (no 'my $item' needed)
for (@list)             { say       }  # say prints $_

# Postfix for — compact one-liners
say "  $_" for @list;
say $_*2  for 1..5;

# Loop control
last;       # break — exit loop immediately
next;       # continue — skip to next iteration
redo;       # restart current iteration without re-evaluating condition

# Labels: control outer loop from inner loop
OUTER: for my $i (1..5) {
    for my $j (1..5) {
        last OUTER if $i + $j > 7;
    }
}

# Basic subroutine — arguments arrive in @_
sub greet {
    my ($name, $greeting) = @_;   # always unpack @_ first
    $greeting //= "Hello";        # default value with defined-or
    return "$greeting, $name!";
}

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

# Named parameters (hash style — very common)
sub make_user {
    my (%args) = @_;
    my $name  = $args{name}  // die "name required";
    my $role  = $args{role}  // "user";
    return { name => $name, role => $role };
}
make_user(name => "Alice", role => "admin");

# Multiple return values — just return a list
sub minmax {
    my (@nums) = @_;
    return (min(@nums), max(@nums));
}
my ($lo, $hi) = minmax(3,1,4,1,5);

# Context-sensitive return with wantarray()
sub context_aware {
    return wantarray ? (1,2,3) : "summary";
}

my $x = "outer";
{
    my $x = "inner";  # shadows outer — separate variable
    say $x;           # "inner"
}
say $x;               # "outer"

# local: temporarily replaces a package variable
our $sep = ",";
sub with_pipe_sep {
    local $sep = "|";  # $sep is "|" here AND in all functions called from here
    print_items();
}                     # $sep restored to "," here

# Factory function: creates specialised closures
sub make_counter {
    my ($start) = @_;
    my $count   = $start // 0;
    return sub {
        return $count++;   # $count is captured — persists
    };
}

my $c1 = make_counter(0);
my $c2 = make_counter(10);
$c1->();  # 0   — each counter has its own $count
$c1->();  # 1
$c2->();  # 10

# state: per-call persistent variable (no factory needed)
use feature 'state';
sub auto_id {
    state $n = 0;   # initialized once; kept across calls
    return ++$n;
}

$str =~  /pattern/          # match — true if $str contains pattern
$str !~  /pattern/          # negated match
if (/pattern/)             # implicit $_ =~ /pattern/

$str =~ s/old/new/          # substitution (first match)
$str =~ s/old/new/g         # global: replace all
my $copy = $str =~ s/a/b/gr # /r: return modified copy
$str =~ s/(\d+)/$1*2/ge     # /e: evaluate replacement as code

$str =~ tr/a-z/A-Z/         # transliterate (char mapping)
my $n = ($str =~ tr/aeiou//) # count vowels (no replacement)
$str =~ tr/aeiou//d          # delete vowels
$str =~ tr/a-z//s            # /s: squeeze repeated translated chars

# Compiled regex (use in multiple places)
my $re = qr/\d{4}-\d{2}-\d{2}/;
$str =~ $re;

# Positional captures: $1, $2, ...
if ($date =~ /(\d{4})-(\d{2})-(\d{2})/) {
    my ($year, $mon, $day) = ($1, $2, $3);
}

# Named captures: (?<name>...) → $+{name}
$date =~ /(?<y>\d{4})-(?<m>\d{2})-(?<d>\d{2})/;
say $+{y}, $+{m}, $+{d};

# List context /g: capture all matches at once
my @words  = ($text =~ /\b\w+\b/g);
my @pairs  = ($text =~ /(\w+)=(\w+)/g);  # k,v,k,v,...

# Non-capturing group: (?:...) — group without $1
/(?:foo|bar)(\d+)/

# Regex match variables
$&  # the entire matched string
$`  # everything BEFORE the match
$'  # everything AFTER the match
$+  # text matched by the last bracket

# map: transform each element ($_ = current element)
my @doubled  = map  { $_ * 2      } @numbers;
my @names    = map  { $_->{name} } @people;
my %lookup   = map  { $_ => 1     } @keys;   # build lookup hash

# grep: filter (keep elements where block is true)
my @evens    = grep { $_ % 2 == 0    } @numbers;
my @admins   = grep { $_->{role} eq 'admin' } @users;
my @nocomment = grep { !/^#/           } @lines;

# sort: with a comparator block
my @by_name  = sort { $a->{name} cmp $b->{name} } @people;
my @by_score = sort { $b->{score} <=> $a->{score} } @people;

# Chaining — reads as a pipeline
my @result =
    sort { $a <=> $b }
    grep { $_ > 5 }
    map  { $_ ** 2 }
    @numbers;

# Always use three-argument open!
open(my $fh, '<',   'file.txt')  or die $!;   # read
open(my $fh, '>',   'out.txt')   or die $!;   # write (truncate)
open(my $fh, '>>',  'log.txt')   or die $!;   # append
open(my $fh, '+<',  'rw.txt')   or die $!;   # read-write

# With encoding layer
open(my $fh, '<:utf8', $path)  or die $!;
# In-memory file (open against a variable)
open(my $fh, '>', \my $buf)  or die $!;

# Line by line — most memory-efficient
while (my $line = <$fh>) {
    chomp $line;    # remove trailing \n
    # process $line
}

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

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

# Diamond <>: reads ARGV files or STDIN
while (<>) { chomp; process($_) }

opendir(my $dh, ".") or die $!;
my @files = grep { !/^\./ } readdir($dh);  # exclude dotfiles
closedir($dh);

use File::Find;     # recursive directory walk
use File::Glob;     # glob patterns
use File::Path qw(make_path remove_tree);  # mkdir -p / rm -rf
use File::Basename  qw(dirname basename);   # path components
use File::Spec;     # portable path manipulation

# die: throw exception (exits program if not caught)
die "Something failed\n";        # \n suppresses "at line N"
die "Error: $!\n";              # $! = system error message
die { type=>"NotFound", msg=>"..." };  # structured exception object

# warn: print warning to STDERR, continue execution
warn "Something looks wrong\n";

# eval { }: catch exceptions (Perl's try block)
my $result = eval {
    risky_operation();
    "success";           # return value if no exception
};

if (my $e = $@) {         # $@ holds the caught exception
    if (ref($e) eq 'HASH') {
        say "Caught: $e{type}: $e{msg}";
    } else {
        die $e;             # re-throw unknown exceptions
    }
}

# Carp module: better caller-perspective error messages
use Carp qw(carp croak confess cluck);
croak    "bad input";     # like die, but blame the caller
carp     "suspicious";  # like warn, blame the caller
confess  "deep error";  # die + full stack trace
cluck    "soft error";  # warn + full stack trace

use Exception::Class (
    'MyApp::Error'             => { description => 'Base error' },
    'MyApp::Error::IO'         => { isa => 'MyApp::Error',
                                    fields => ['filename'] },
);

eval {
    MyApp::Error::IO->throw(
        message  => "Cannot open file",
        filename => $path,
    );
};
if (my $e = $@) {
    if ($e->isa('MyApp::Error::IO')) {
        say "IO error on " . $e->filename;
    }
}

package Animal;
use strict; use warnings;

# Constructor — 'new' is conventional, any name works
sub new {
    my ($class, %args) = @_;   # $class = "Animal" (the package name)
    my $self = {
        name  => $args{name}  // "Unknown",
        sound => $args{sound} // "...",
    };
    return bless $self, $class;   # bless ties $self to class
}

# Accessor method (get/set)
sub name {
    my ($self, $new) = @_;
    $self->{name} = $new if defined $new;
    return $self->{name};
}

# Regular method
sub speak {
    my ($self) = @_;
    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
}

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

package Person;
use Moo;

has 'name'  => (is => 'rw', required => 1);
has 'email' => (is => 'rw');
has 'age'   => (is => 'ro', default => 0);

sub greet {
    my ($self) = @_;
    say "Hi, I'm " . $self->name;
}
# Moo automatically generates constructor, accessors, type checking

use List::Util qw(sum max min first);   # import specific subs
use Scalar::Util ();                     # load but don't import
Scalar::Util::blessed($obj);             # call fully-qualified
use POSIX qw(floor ceil strftime);

package MyUtil;
use strict; use warnings;
our $VERSION = '1.00';

use Exporter 'import';
our @EXPORT_OK   = qw(util_one util_two);  # opt-in
our @EXPORT      = qw();                    # auto-export (avoid unless simple)
our %EXPORT_TAGS = (all => [@EXPORT_OK]);

sub util_one { ... }
sub util_two { ... }

1;    # MODULE MUST RETURN TRUE — never forget this!

cpanm Module::Name           # cpanminus — recommended installer
cpan  Module::Name           # built-in CPAN shell
apt install libfoo-perl      # system package manager (Debian/Ubuntu)
brew install cpanminus       # macOS via Homebrew

# Print lines matching a pattern
perl -ne 'print if /ERROR/'  server.log

# Replace text in-place across multiple files
perl -pi.bak -e 's/\bfoo\b/bar/g'  *.txt

# Print only lines 15-17
perl -ne 'print if $. >= 15; last if $. >= 17'  file.txt

# Sum a column of numbers (2nd field)
perl -ane '$sum += $F[1]; END { say $sum }'  data.txt

# Remove duplicate lines (preserving order)
perl -ne 'print unless $seen{$_}++'  file.txt

# Count occurrences of each word
perl -ne 'for (split){ $c{$_}++ } END{ say "$_ $c{$_}" for sort keys %c }'  file.txt

# Reverse each line
perl -lpe '$_ = reverse'  file.txt

# Rename files: strip .txt from all *.txt.bak files
perl -e 'rename $_, s/\.txt//r for glob "*.txt.bak"'

# Pretty-print JSON (requires JSON::PP)
perl -MJSON::PP -e 'print JSON::PP->new->pretty->encode(decode_json(do{local $/;<STDIN>}))'

# Find and print palindromes in a word list
perl -lne 'print if lc eq reverse lc'  /usr/share/dict/words

package Vector;
use overload
    '+'  => \&add,
    '""' => \&stringify;   # overload stringification

sub new       { bless { x => $_[1], y => $_[2] }, $_[0] }
sub add       { Vector->new($_[0]{x}+$_[1]{x}, $_[0]{y}+$_[1]{y}) }
sub stringify { "($_[0]{x}, $_[0]{y})" }

my $v = Vector->new(1,2) + Vector->new(3,4);
say $v;    # "(4, 6)"

# Modern preamble (Perl 5.36+)
use v5.36;       # enables strict, warnings, say, state, and more
use utf8;
use feature 'signatures';   # named params in subs
no warnings 'experimental::signatures';

# Named sub parameters (Perl 5.20+ with signatures)
sub greet ($name, $greeting = "Hello") {
    say "$greeting, $name!";
}

# Try::Tiny for clean exception handling
use Try::Tiny;
try {
    risky_op();
} catch {
    warn "Error: $_";
} finally {
    cleanup();
};