Perl Code
Examples

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

# Scalars hold a single value (number or string)
my $name  = "Alice";
my $age   = 30;
my $score = 98.6;

# String vs. numeric context — Perl switches automatically
my $doubled = $age * 2;         # numeric
my $greeting = "Hello, " . $name;  # string concat with dot

print "$greeting! Age doubled: $doubled\n";

# undef is Perl's "no value" — always check before use
my $maybe;
if (!defined $maybe) {
    print "maybe is undefined\n";
}

Hello, Alice! Age doubled: 60
maybe is undefined

use strict; use warnings;

my $s = "  Hello, World!  ";

# Trim whitespace (no built-in; use substitution)
$s =~ s/^\s+|\s+$//g;

# Length, uppercase, lowercase, index, substr
my $len   = length($s);
my $upper = uc($s);
my $lower = lc($s);
my $pos   = index($s, "World");   # returns 7
my $sub   = substr($s, 0, 5);     # "Hello"

# Repeat operator x
my $line = "-" x 20;

# sprintf for formatted strings
my $formatted = sprintf("Pi is %.4f", 3.14159265);

print "Trimmed:   '$s' (len=$len)\n";
print "Upper:     $upper\n";
print "Substr:    $sub  at pos $pos\n";
print "$line\n$formatted\n";

Trimmed:   'Hello, World!' (len=13)
Upper:     HELLO, WORLD!
Substr:    Hello  at pos 7
--------------------
Pi is 3.1416

use strict; use warnings;

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

# push / pop  (end),  shift / unshift (front)
push @fruits, "date";
my $last  = pop  @fruits;    # "date"
my $first = shift @fruits;   # "apple"
unshift @fruits, "avocado";

# Slice: grab multiple indices at once
my @two = @fruits[0,2];

# sort and reverse
my @sorted  = sort @fruits;
my @rev     = reverse @sorted;

# grep = filter,  map = transform
my @long    = grep { length($_) > 5 } @fruits;
my @uppers  = map  { uc($_) } @fruits;

# join turns array into string
print "Fruits:  " . join(", ", @fruits)  . "\n";
print "Long:    " . join(", ", @long)   . "\n";
print "Uppers:  " . join(", ", @uppers) . "\n";
print "Count:   " . scalar(@fruits)    . "\n";

Fruits:  avocado, banana, cherry
Long:    avocado, banana, cherry
Uppers:  AVOCADO, BANANA, CHERRY
Count:   3

use strict; use warnings;

my %person = (
    name  => "Bob",
    age   => 42,
    city  => "Austin",
);

# Add / modify a key
$person{email} = "bob@example.com";

# Check existence and delete
if (exists $person{city}) {
    delete $person{city};
}

# Iterate — keys returns list of keys (order not guaranteed)
for my $key (sort keys %person) {
    printf "  %-8s => %s\n", $key, $person{$key};
}

# each() for key-value pairs in a while loop
print "\nvia each():\n";
while (my ($k, $v) = each %person) {
    print "  $k = $v\n";
}

  age      => 42
  email    => bob@example.com
  name     => Bob

via each():
  name = Bob
  age = 42
  email = bob@example.com

use strict; use warnings;

# Standard if / elsif / else
my $x = 15;
if    ($x < 10) { print "small\n"  }
elsif ($x < 20) { print "medium\n" }  # fires
else            { print "large\n"  }

# unless = if not
print "not zero\n" unless $x == 0;

# Ternary operator
my $label = ($x % 2 == 0) ? "even" : "odd";
print "$x is $label\n";

# foreach with $_ default variable
foreach (1..5) {
    next if $_ == 3;           # skip 3
    print "  $_";
}
print "\n";

# C-style for loop
for (my $i = 0; $i < 3; $i++) {
    print "  i=$i\n";
}

# while with last to break
my $n = 0;
while (1) {
    last if $n ++ >= 2;
    print "  n=$n\n";
}

medium
not zero
15 is odd
  1  2  4  5
  i=0
  i=1
  i=2
  n=1
  n=2

use strict; use warnings;

# Basic sub — unpack @_ into named variables
sub greet {
    my ($name, $title) = @_;
    $title //= "friend";   # //= defined-or default
    return "Hello, $title $name!";
}

# Sub returning multiple values (as a list)
sub min_max {
    my @nums = @_;
    my $min = $nums[0];
    my $max = $nums[0];
    for my $n (@nums) {
        $min = $n if $n < $min;
        $max = $n if $n > $max;
    }
    return ($min, $max);
}

# Recursive sub — factorial
sub factorial {
    my ($n) = @_;
    return 1 if $n <= 1;
    return $n * factorial($n - 1);
}

print greet("Alice", "Dr."), "\n";
print greet("Bob"), "\n";

my ($lo, $hi) = min_max(3,7,1,9,2);
print "min=$lo  max=$hi\n";
print "6! = " . factorial(6) . "\n";

Hello, Dr. Alice!
Hello, friend Bob!
min=1  max=9
6! = 720

use strict; use warnings;

my $text = "The price is $42.50 and tax is $3.20";

# Match test — returns true/false
if ($text =~ /price/i) {
    print "Found 'price'\n";
}

# Capture groups — $1, $2, ...
if ($text =~ /price is \$(\d+\.\d+)/) {
    print "Price: $1\n";
}

# Global match — find ALL dollar amounts
my @amounts = ($text =~ /\$(\d+\.\d+)/g);
print "Amounts: " . join(", ", @amounts) . "\n";

# Substitution s///
(my $clean = $text) =~ s/\$\d+\.\d+/\$X.XX/g;
print "$clean\n";

# Named captures (cleaner for complex patterns)
my $date = "2024-07-04";
if ($date =~ /(?<year>\d{4})-(?<month>\d{2})-(?<day>\d{2})/) {
    print "Year=$+{year} Month=$+{month} Day=$+{day}\n";
}

# Verbose mode /x — add whitespace and comments
my $email = "user@example.com";
my $re = qr/
    ^ [\w.+-]+    # local part
    \@            # at-sign
    [\w-]+        # domain
    \.            # dot
    \w{2,6}       # TLD
    $
/x;
print "Valid email\n" if $email =~ $re;

Found 'price'
Price: 42.50
Amounts: 42.50, 3.20
The price is $X.XX and tax is $X.XX
Year=2024 Month=07 Day=04
Valid email

use strict; use warnings;

# --- Write a file ---
open(my $out, '>', '/tmp/demo.txt')
    or die "Cannot open: $!";

print $out "Line one\n";
print $out "Line two\n";
print $out "Line three\n";
close($out);

# --- Read line by line ---
open(my $in, '<', '/tmp/demo.txt')
    or die "Cannot open: $!";

while (my $line = <$in>) {
    chomp $line;   # remove trailing newline
    print "  READ: $line\n";
}
close($in);

# --- Append to file ---
open(my $app, '>>', '/tmp/demo.txt')
    or die "Cannot open: $!";
print $app "Line four (appended)\n";
close($app);

# --- Slurp entire file into array ---
open(my $fh, '<', '/tmp/demo.txt')
    or die "Cannot open: $!";
my @lines = <$fh>;
close($fh);
chomp @lines;

print "Total lines: " . scalar(@lines) . "\n";

  READ: Line one
  READ: Line two
  READ: Line three
Total lines: 4

use strict; use warnings;

# Array reference
my $aref = [10, 20, 30];
print "Second: $aref->[1]\n";         # 20

# Hash reference
my $href = { name => "Eve", age => 28 };
print "Name: $href->{name}\n";

# Array of hashes — common for records
my @people = (
    { name => "Alice", score => 95 },
    { name => "Bob",   score => 87 },
    { name => "Carol", score => 92 },
);

# Sort by score descending
my @ranked = sort { $b->{score} <=> $a->{score} } @people;

for my $p (@ranked) {
    printf "  %-8s %d\n", $p->{name}, $p->{score};
}

# Hash of arrays — grouping data
my %by_dept;
push @{$by_dept{eng}},  "Alice", "Charlie";
push @{$by_dept{hr}},   "Bob";

for my $dept (sort keys %by_dept) {
    print "$dept: " . join(", ", @{$by_dept{$dept}}) . "\n";
}

Second: 20
Name: Eve
  Alice    95
  Carol    92
  Bob      87
eng: Alice, Charlie
hr: Bob

use strict; use warnings;

### ---- Animal base class ----
package Animal;

sub new {
    my ($class, %args) = @_;
    return bless {
        name => $args{name} // "Unknown",
        legs => $args{legs} // 4,
    }, $class;
}

sub name { return $_[0]->{name} }
sub legs { return $_[0]->{legs} }
sub speak { print $_[0]->name() . " says ...\n" }

### ---- Dog subclass ----
package Dog;
use parent -norequire, 'Animal';

sub speak {
    my ($self) = @_;
    print $self->name() . " says: Woof!\n";
}

sub fetch {
    my ($self, $item) = @_;
    print $self->name() . " fetches the $item!\n";
}

### ---- Main ----
package main;

my $a = Animal->new(name => "Generic", legs => 4);
my $d = Dog->new(name => "Rex");

$a->speak();
$d->speak();
$d->fetch("ball");

# isa() — check class membership
print "Rex isa Dog?    "    . ($d->isa('Dog')    ? "yes" : "no") . "\n";
print "Rex isa Animal? "   . ($d->isa('Animal') ? "yes" : "no") . "\n";

Generic says ...
Rex says: Woof!
Rex fetches the ball!
Rex isa Dog?    yes
Rex isa Animal? yes