Perl exercises

use strict;
use warnings;
my $name = "Ada";
print "Hello, $name\n";

use strict;
use warnings;

sub average {
    my @values = @_;
    my $total = 0;
    $total += $_ for @values;
    return $total / @values;
}

print average(82, 91, 76, 95), "\n";

use strict;
use warnings;

my $line = "2024-03-15 ERROR disk full on /dev/sda1";
if ($line =~ /^(?<date>\d{4}-\d{2}-\d{2})\s+(?<level>[A-Z]+)\s+(?<message>.*)$/) {
    print "$+{date} | $+{level} | $+{message}\n";
}

my $text = "cat bat rat hat";
my @letters = $text =~ /\b(\w)at\b/g;
print scalar(@letters), " matches: @letters\n";

(my $copy = $text) =~ s/(\w)at/\U$1\Eat/g;
print "$copy\n";

(my $dna = "AACGT") =~ tr/ACGT/TGCA/;
my $count = ($text =~ tr/a//);
print "$dna $count\n";

my $prices = "apple=3, pear=12, fig=7";
(my $doubled = $prices) =~ s/(\d+)/$1 * 2/ge;
print "$doubled\n";

print join("|", split /\s*,\s*/, "a , b,c ,d"), "\n";

use strict;
use warnings;
use List::Util qw(sum);

my %scores = (Ada => [90, 85], Bo => [70], Cy => []);
push @{ $scores{Bo} }, 95;
$scores{Di}[0] = 60;

for my $name (sort keys %scores) {
    my @s = @{ $scores{$name} };
    my $average = @s ? sprintf("%.1f", sum(@s) / @s) : "n/a";
    print "$name: ", scalar(@s), " scores, average $average\n";
}

print join(" ", ref(\1), ref([]), ref({}), ref(sub { 1 }), ref(\\1)), "\n";

my %copy = %scores;
delete $copy{Cy};
print exists $scores{Cy} ? "Cy still in the original\n" : "Cy gone\n";
print join(",", sort keys %copy), "\n";
my @both = @scores{qw(Ada Bo)};
print scalar(@{ $both[0] }) + scalar(@{ $both[1] }), " scores for Ada and Bo\n";

use strict;
use warnings;

my $data = "alpha 3\nbeta 5\ngamma x\n";
open(my $in, '<', \$data) or die "cannot open: $!";
my $total = 0;
while (my $line = <$in>) {
    chomp $line;
    my ($name, $value) = split ' ', $line;
    if ($value =~ /^\d+$/) {
        print "$name=$value\n";
        $total += $value;
    } else {
        print "bad line: $line\n";
    }
}
close $in;
print "total $total\n";

my $report = '';
open(my $out, '>', \$report) or die "cannot open: $!";
printf $out "%-6s|%3d\n", "ab", 7;
print {$out} "done\n";
close $out;
print $report;

use strict;
use warnings;

sub minmax {
    my @sorted = sort { $a <=> $b } @_;
    return wantarray ? ($sorted[0], $sorted[-1]) : "$sorted[0]..$sorted[-1]";
}
my ($min, $max) = minmax(4, 9, 2, 7);
my $range = minmax(4, 9, 2, 7);
print "$min $max $range\n";

sub counter {
    my $n = shift // 0;
    return { inc => sub { return ++$n }, get => sub { return $n } };
}
my $c1 = counter();
my $c2 = counter(10);
$c1->{inc}->() for 1 .. 3;
$c2->{inc}->();
print $c1->{get}->(), " ", $c2->{get}->(), "\n";

my $factorial;
$factorial = sub {
    my $n = shift;
    return $n <= 1 ? 1 : $n * $factorial->($n - 1);
};
print $factorial->(5), "\n";

my @list = (3, 1, 2);
my $count = @list;
my ($first) = @list;
print "$count $first\n";

use strict;
use warnings;

package Animal;

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

sub name { return $_[0]{name} }
sub sound { return 'generic noise' }

sub speak {
    my $self = shift;
    return $self->name . ' says ' . $self->sound;
}

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

sub sound { return 'Woof' }

sub speak {
    my $self = shift;
    return $self->SUPER::speak() . '!';
}

package main;

my @animals = (Animal->new(name => 'Generic'), Dog->new(name => 'Rex'));
print $_->speak, "\n" for @animals;
print $animals[1]->isa('Animal') ? "a Dog is an Animal\n" : "not an Animal\n";
print Dog->can('speak') ? "Dog can speak\n" : "Dog cannot speak\n";
print ref($animals[1]), "\n";

use strict;
use warnings;

my @scores = (82, 91, 76);
push @scores, 95;
my $total = 0;
$total += $_ for @scores;
print scalar(@scores), " ", $total, "\n";

use strict;
use warnings;

my %scores = (Ada => 91, Grace => 88);
$scores{Linus} = 79;
for my $name (sort keys %scores) {
    print "$name: $scores{$name}\n";
}

use strict;
use warnings;

my @nums = (10, 9, 1, 25);
print join(" ", sort @nums), "\n";
print join(" ", sort { $a <=> $b } @nums), "\n";
print join(" ", reverse sort { $a <=> $b } @nums), "\n";

my %age = (Ada => 30, Bo => 25, Cy => 30, Di => 25);
my @by_age = sort { $age{$b} <=> $age{$a} or $a cmp $b } keys %age;
print "@by_age\n";

my @words = qw(pear fig apple kiwi);
my @by_length =
    map  { $_->[1] }
    sort { $a->[0] <=> $b->[0] or $a->[1] cmp $b->[1] }
    map  { [length($_), $_] } @words;
print "@by_length\n";

use strict;
use warnings;

my @stack;
push @stack, 1, 2, 3;
my $top = pop @stack;
print "$top @stack\n";

my @queue = (1, 2, 3);
my $front = shift @queue;
push @queue, 4;
print "$front @queue\n";
unshift @queue, 0;
print "@queue\n";

my $text = "the cat and the hat and the bat";
my %freq;
$freq{$_}++ for split ' ', $text;
print join(" ", map { "$_=$freq{$_}" } sort { $freq{$b} <=> $freq{$a} or $a cmp $b } keys %freq), "\n";

my @even = grep { $_ % 2 == 0 } 1 .. 10;
my @squares = map { $_ ** 2 } @even;
print "@even | @squares\n";

my %seen;
my @unique = grep { !$seen{$_}++ } qw(a b a c b);
print "@unique\n";

use strict;
use warnings;
use Digest::SHA qw(sha256_hex hmac_sha256_hex);

print sha256_hex("abc"), "\n";
print sha256_hex("abd"), "\n";

sub secure_equal {
    my ($x, $y) = @_;
    return 0 unless length($x) == length($y);
    my $diff = 0;
    $diff |= ord(substr($x, $_, 1)) ^ ord(substr($y, $_, 1)) for 0 .. length($x) - 1;
    return $diff == 0;
}

my $message = "what do ya want for nothing?";
my $tag = hmac_sha256_hex($message, "Jefe");
print "$tag\n";
print "valid: ", (secure_equal($tag, hmac_sha256_hex($message, "Jefe")) ? "yes" : "no"), "\n";
print "forged: ", (secure_equal($tag, hmac_sha256_hex("what do ya want for something?", "Jefe")) ? "yes" : "no"), "\n";