Master Perl Programming — From Beginner to Expert 2026

perl -v

#!/usr/bin/perl
# This is the shebang line — tells the OS to use Perl interpreter

use strict;    # Enforces good coding practices
use warnings; # Helps catch potential errors early

print "Hello, Perl!\n"; # \n = newline character

#!/usr/bin/perl         # 1. Shebang Line — tells OS which interpreter to use

use strict;              # 2. Directives — enforces safe coding practices
use warnings;            # 2. Directives — enables helpful runtime warnings

# 3. Single-line comment (starts with #)

=pod
  4. Multi-line comment block (POD — Plain Old Documentation)
  This block is ignored by the Perl compiler.
=cut

# 5. Statements — end with semicolons
my $name = "Chandan Kumar";
print "Hello, $name!\n";  # Variable interpolation in double quotes

# 6. Block structures — grouped with curly braces
if (1 == 1) {
    print "Conditional block executed.\n";
}

use strict;
use warnings;

# String scalar
my $name  = "Chandan Kumar";

# Integer scalar
my $age   = 30;

# Floating-point scalar
my $price = 9.99;

# Boolean-like (Perl uses 1 for true, '' or 0 for false)
my $is_active = 1;

print "Name:  $name\n";
print "Age:   $age\n";
print "Price: $price\n";

use strict;
use warnings;

# Declare an array
my @colors = ("red", "green", "blue");

# Access by index (zero-based)
print $colors[0] . "\n";  # red
print $colors[2] . "\n";  # blue
print $colors[-1] . "\n"; # blue (last element)

# Common array operations
push @colors, "yellow";    # Add to end
my $removed = pop @colors; # Remove from end
unshift @colors, "white"; # Add to beginning
my $first = shift @colors; # Remove from beginning

# Array size
my $size = scalar @colors;
print "Array size: $size\n";

# Print all elements
print "All colors: @colors\n";

use strict;
use warnings;

# Declare a hash
my %person = (
    'name' => "Chandan Kumar",
    'age'  => 30,
    'city' => "Pune",
);

# Access a value by key
print "Name: $person{'name'}\n";
print "Age:  $person{'age'}\n";

# Add a new key-value pair
$person{'job'} = "Software Developer";

# Check if a key exists
if (exists $person{'job'}) {
    print "Job: $person{'job'}\n";
}

# Delete a key
delete $person{'city'};

# Iterate over all key-value pairs
while (my ($key, $val) = each %person) {
    print "$key => $val\n";
}

my $a = 10;
my $b = 3;

print $a + $b;   # Addition:       13
print $a - $b;   # Subtraction:    7
print $a * $b;   # Multiplication: 30
print $a / $b;   # Division:       3.333...
print $a % $b;   # Modulus:        1 (remainder)
print $a ** $b;  # Exponentiation: 1000 (10^3)

my $greeting = "Hello";
my $name     = "Chandan";

# Concatenation with dot (.)
print $greeting . " " . $name . "\n"; # Hello Chandan

# Repetition with (x)
print "Hi " x 3;  # Hi Hi Hi

use strict;
use warnings;

my $str = "Hello, Perl!";

# Length of string
print length($str) . "\n";       # 12

# Uppercase / Lowercase
print uc($str) . "\n";           # HELLO, PERL!
print lc($str) . "\n";           # hello, perl!
print ucfirst($str) . "\n";      # Hello, Perl! (first char uppercase)
print lcfirst($str) . "\n";      # hello, Perl! (first char lowercase)

# Substring extraction: substr(string, start, length)
print substr($str, 7, 4) . "\n";  # Perl

# Find position of substring: index(string, search)
print index($str, "Perl") . "\n"; # 7

# Replace using substitution (regex s///)  
(my $new = $str) =~ s/Perl/Python/;
print $new . "\n";                # Hello, Python!

# Split a string into an array
my @words = split(/,\s*/, $str);
print "$_\n" for @words;

# Join an array into a string
my $joined = join(" | ", "one", "two", "three");
print $joined . "\n";             # one | two | three

# Reverse a string
print scalar reverse($str) . "\n";

use strict;
use warnings;
use feature 'say'; # 'say' adds automatic newline (Perl 5.10+)

print "Enter your name: ";
my $name = <STDIN>;  # Read from standard input
chomp $name;          # Remove trailing newline from input
say "Hello, $name!";

──────────────────────────────────────────
# Simple calculator using user input:
print "Enter first number: ";
my $num1 = <STDIN>;
chomp $num1;

print "Enter second number: ";
my $num2 = <STDIN>;
chomp $num2;

my $sum = $num1 + $num2;
say "Sum: $sum";

use strict;
use warnings;

my $marks = 75;

# if / elsif / else
if ($marks >= 90) {
    print "Grade: A\n";
} elsif ($marks >= 75) {
    print "Grade: B\n";
} elsif ($marks >= 50) {
    print "Grade: C\n";
} else {
    print "Grade: F\n";
}

# unless (runs only if condition is FALSE)
my $x = 0;
unless ($x) {
    print "x is false (zero or empty)\n";
}

# Ternary operator: condition ? true_val : false_val
my $age     = 20;
my $message = ($age >= 18) ? "Adult" : "Minor";
print "$message\n"; # Adult

## 1. for loop (C-style)
for (my $i = 1; $i <= 5; $i++) {
    print "Count: $i\n";
}

## 2. foreach loop (iterate over array)
my @fruits = ("apple", "banana", "cherry");
foreach my $fruit (@fruits) {
    print "Fruit: $fruit\n";
}

## 3. Range-based for loop
for my $n (1..10) {
    print "$n ";
}
print "\n";

## 4. while loop
my $count = 1;
while ($count <= 5) {
    print "Count: $count\n";
    $count++;
}

## 5. until loop (runs while condition is FALSE)
my $val = 1;
until ($val > 5) {
    print "Val: $val\n";
    $val++;
}

## 6. do-while loop (executes at least once)
my $c = 1;
do {
    print "do-while: $c\n";
    $c++;
} while ($c <= 5);

# next — skip current iteration (like 'continue' in other languages)
for my $i (1..10) {
    next if $i % 2 == 0;  # Skip even numbers
    print "$i ";             # Prints: 1 3 5 7 9
}

# last — exit the loop immediately (like 'break' in other languages)
for my $i (1..10) {
    last if $i == 5;  # Stop loop when i reaches 5
    print "$i ";         # Prints: 1 2 3 4
}

# redo — restart current iteration without re-checking condition
# (Use carefully — can create infinite loops!)
my $attempts = 0;
for my $item ("a", "b", "c") {
    $attempts++;
    redo if $item eq "b" && $attempts < 3;
    print "Processing: $item\n";
}

use strict;
use warnings;

## Basic subroutine
sub greet {
    print "Welcome to Perl Programming!\n";
}
greet();  # Call the subroutine

## Subroutine with parameters (@_ is the default argument array)
sub greet_user {
    my ($first_name, $last_name) = @_;
    print "Hello, $first_name $last_name!\n";
}
greet_user("Chandan", "Kumar");

## Subroutine with return value
sub add {
    my ($n1, $n2) = @_;
    return $n1 + $n2;
}
my $result = add(20, 30);
print "Sum: $result\n";  # Sum: 50

## Default parameter values using shift
sub multiply {
    my $a = shift || 1;  # Default to 1 if not provided
    my $b = shift || 1;
    return $a * $b;
}

## Returning multiple values
sub get_min_max {
    my @numbers = @_;
    my ($min, $max) = ($numbers[0], $numbers[0]);
    foreach my $num (@numbers) {
        $min = $num if $num < $min;
        $max = $num if $num > $max;
    }
    return ($min, $max);  # Return multiple values
}
my ($min_val, $max_val) = get_min_max(10, 4, 20, 8, 15);
print "Min: $min_val, Max: $max_val\n"; # Min: 4, Max: 20

## Recursive function (Factorial)
sub factorial {
    my $n = shift;
    return 1 if $n == 0;
    return $n * factorial($n - 1);
}
print factorial(5) . "\n";  # 120

use strict;
use warnings;
use feature 'state';

## 1. Global scope — declared with 'our'
## Accessible throughout the entire script
our $global_var = "I am global";

sub show_global {
    print $global_var . "\n";  # Accessible here
}

## 2. Lexical scope — declared with 'my'
## Restricted to the enclosing block or subroutine
sub show_lexical {
    my $lex_var = "I am lexical";
    print $lex_var . "\n";  # OK inside this sub
}
# print $lex_var;  # ERROR! Out of scope

## 3. Persistent scope — declared with 'state'
## Retains its value between function calls (like a static variable)
sub counter {
    state $count = 0;  # Initialized only once
    $count++;
    print "Count: $count\n";
}
counter();  # Count: 1
counter();  # Count: 2
counter();  # Count: 3

use strict;
use warnings;

my $text = "Welcome to Perl Programming!";

# Basic match: =~ operator with m//
if ($text =~ /Perl/) {
    print "Match found!\n";
}

# Case-insensitive match using 'i' flag
if ($text =~ /perl/i) {
    print "Case-insensitive match!\n";
}

# Substitution: s/old/new/
$text =~ s/Perl/Python/;
print $text . "\n";  # Welcome to Python Programming!

# Global substitution (replace all): s/old/new/g
my $str = "apple apple apple";
$str =~ s/apple/orange/g;
print $str . "\n";  # orange orange orange

# Capturing groups — extract parts of a match
my $sentence = "Alice is 25 years old";
if ($sentence =~ /(\w+) is (\d+)/) {
    print "Name: $1, Age: $2\n";  # Name: Alice, Age: 25
}

# Positive lookahead: match 'hello' only if followed by 'world'
my $text = "hello world";
print "Found!\n" if $text =~ /hello(?=\s+world)/;

# Negative lookahead: match 'hello' only if NOT followed by 'world'
print "Found!\n" if $text =~ /hello(?!\s+world)/;

# Email validation regex
my $email = '[email protected]';
if ($email =~ /^[\w.%+\-]+@[\w.\-]+\.[a-zA-Z]{2,}$/) {
    print "Valid email!\n";
}

# Phone number validation (10 digits)
my $phone = "1234567890";
print "Valid phone!\n" if $phone =~ /^\d{10}$/;

use strict;
use warnings;

## READING a file — line by line (memory efficient)
open(my $fh, '<', 'input.txt') or die "Cannot open file: $!";
while (my $line = <$fh>) {
    chomp $line;
    print $line . "\n";
}
close $fh;

## WRITING to a file (overwrites existing content)
open(my $out, '>', 'output.txt') or die "Cannot write: $!";
print $out "Hello, Perl!\n";
print $out "File writing in Perl is easy.\n";
close $out;

## APPENDING to a file (adds to end, preserves existing content)
open(my $app, '>>', 'output.txt') or die "Cannot append: $!";
print $app "This line is appended.\n";
close $app;

cpan install Text::CSV

use strict;
use warnings;
use Text::CSV;

my $csv = Text::CSV->new({ binary => 1 });
open(my $fh, '<', 'data.csv') or die "Cannot open: $!";

# Skip header row
my $header = $csv->getline($fh);

while (my $row = $csv->getline($fh)) {
    print "Name: $row->[0], Age: $row->[1]\n";
}
close $fh;

cpan install JSON

use strict;
use warnings;
use JSON;

# Perl data structure (hash)
my %data = (
    name  => "Chandan",
    age   => 30,
    city  => "Pune",
);

# Encode Perl hash to JSON string
my $json_str = encode_json(\%data);
print $json_str . "\n";

# Write JSON to file
open(my $fh, '>', 'output.json');
print $fh $json_str;
close $fh;

# Read and decode JSON from file
open(my $in, '<', 'output.json');
my $text = do { local $/; <$in> };
close $in;
my $decoded = decode_json($text);
print "Name: $decoded->{name}\n";

# Install a module from CPAN
cpan install Module::Name

# Using cpanminus (faster, recommended)
cpanm Module::Name

# Install multiple modules at once
cpanm LWP::UserAgent HTML::TreeBuilder JSON DBI

## File: MyModule.pm
package MyModule;

use strict;
use warnings;

sub greet {
    my $name = shift;
    return "Hello, $name!";
}

1;  # MUST end with 1 to indicate successful loading

use strict;
use warnings;
use lib '.';  # Tell Perl to look in current directory
use MyModule;

print MyModule::greet("Chandan") . "\n";

package Person;
use strict;
use warnings;

# Constructor method
sub new {
    my ($class, $name, $age) = @_;
    my $self = {
        name => $name,
        age  => $age,
    };
    return bless $self, $class;  # bless creates the object
}

# Method
sub greet {
    my $self = shift;
    return "Hello, my name is $self->{name} and I am $self->{age} years old.";
}

1;

use strict;
use warnings;
use lib '.';
use Person;

# Create an object (instance of Person class)
my $person = Person->new("Chandan", 30);
print $person->greet() . "\n";

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

sub new {
    my ($class, $name, $age, $job) = @_;
    # Call parent constructor
    my $self = $class->SUPER::new($name, $age);
    $self->{job} = $job;
    return bless $self, $class;
}

# Overriding (Polymorphism) parent method
sub greet {
    my $self = shift;
    my $base = $self->SUPER::greet();
    return $base . " I work as a $self->{job}.";
}

1;

cpan install DBI
cpan install DBD::SQLite    # For SQLite
cpan install DBD::mysql     # For MySQL
cpan install DBD::Pg        # For PostgreSQL

use strict;
use warnings;
use DBI;

# Connect to SQLite database
my $dbh = DBI->connect(
    "DBI:SQLite:dbname=test.db",
    "", "",
    { RaiseError => 1, AutoCommit => 1 }
) or die $DBI::errstr;
print "Connected successfully!\n";

# CREATE TABLE
$dbh->do(q{
    CREATE TABLE IF NOT EXISTS users (
        id    INTEGER PRIMARY KEY AUTOINCREMENT,
        name  TEXT NOT NULL,
        age   INTEGER
    )
});

# INSERT data
my $sth = $dbh->prepare("INSERT INTO users (name, age) VALUES (?, ?)");
$sth->execute("Chandan", 30);
$sth->execute("Ram",     25);

# SELECT and display all rows
my $sel = $dbh->prepare("SELECT id, name, age FROM users");
$sel->execute();
while (my $row = $sel->fetchrow_hashref()) {
    print "ID: $row->{id}  Name: $row->{name}  Age: $row->{age}\n";
}

# UPDATE a record
$dbh->do("UPDATE users SET age = 31 WHERE name = 'Chandan'");

# DELETE a record
$dbh->do("DELETE FROM users WHERE name = 'Ram'");

$dbh->disconnect();
print "Done!\n";

cpan install LWP::UserAgent
cpan install HTML::TreeBuilder

use strict;
use warnings;
use LWP::UserAgent;
use HTML::TreeBuilder;

my $url = 'https://www.perl.org';
my $ua  = LWP::UserAgent->new(agent => 'PerlBot/1.0');

my $response = $ua->get($url);

unless ($response->is_success) {
    die "Failed: " . $response->status_line;
}

# Parse the HTML
my $tree = HTML::TreeBuilder->new();
$tree->parse_content($response->decoded_content);

# Extract all hyperlinks
print "=== All Links ===\n";
for my $link ($tree->look_down(_tag => 'a')) {
    my $href = $link->attr('href');
    print "$href\n" if defined $href;
}

$tree->delete;  # Clean up memory

use strict;
use warnings;
use LWP::UserAgent;
use JSON;

my $url = 'https://jsonplaceholder.typicode.com/posts/1';
my $ua  = LWP::UserAgent->new();
my $res = $ua->get($url);

if ($res->is_success) {
    my $data = decode_json($res->decoded_content);
    print "Title: $data->{title}\n";
    print "Body:  $data->{body}\n";
} else {
    die "API error: " . $res->status_line;
}

use strict;
use warnings;
use feature 'say';

my $secret = int(rand(100)) + 1;
say "Guess the number between 1 and 100! You have 10 attempts.";

my $attempts = 0;
while (1) {
    print "Your guess: ";
    my $guess = <STDIN>;
    chomp $guess;
    $attempts++;

    if ($guess == $secret) {
        say "🎉 Congratulations! You guessed it in $attempts attempts!";
        last;
    } elsif ($guess < $secret) {
        say "📈 Too low! Try again.";
    } else {
        say "📉 Too high! Try again.";
    }

    if ($attempts >= 10) {
        say "❌ Game over! The number was $secret.";
        last;
    }
}

use strict;
use warnings;

my $log_file = 'app.log';

sub parse_log {
    my $filter = shift;  # e.g., "ERROR", "WARNING", "INFO"
    open(my $fh, '<', $log_file) or die "Cannot open log: $!";
    while (my $line = <$fh>) {
        print $line if !$filter || $line =~ /$filter/i;
    }
    close $fh;
}

# Search log entries containing a keyword
sub search_log {
    my $keyword = shift;
    print "Search results for '$keyword':\n";
    parse_log($keyword);
}

search_log("ERROR");   # Show only error lines
search_log("backup");  # Search for backup-related entries

use strict;
use warnings;
use Text::CSV;
use DBI;
use JSON;

# Connect to SQLite
my $dbh = DBI->connect("DBI:SQLite:dbname=sales.db", "", "",
    { RaiseError => 1, AutoCommit => 1 });

# Create table
$dbh->do(q{
    CREATE TABLE IF NOT EXISTS sales (
        order_id TEXT, product TEXT, category TEXT,
        price REAL, quantity INTEGER
    )
});

# Read and insert CSV data
my $csv = Text::CSV->new({ binary => 1 });
open(my $fh, '<', 'sales_data.csv');
$csv->getline($fh);  # Skip header
my $ins = $dbh->prepare("INSERT INTO sales VALUES (?,?,?,?,?)");
while (my $row = $csv->getline($fh)) {
    $ins->execute(@$row);
}
close $fh;

# Filter: price > 1000, generate JSON report
my $sth = $dbh->prepare("SELECT * FROM sales WHERE price > 1000");
$sth->execute();
my @data;
while (my $row = $sth->fetchrow_hashref()) {
    push @data, $row;
}

open(my $out, '>', 'report.json');
print $out encode_json(\@data);
close $out;
print "Report generated: report.json\n";