Re^2: Design a Perl training day

Somewhat more than a week later! However, here are the reference "answers":
Session 1

Code: Hello World x 10
perl -e "print qq{Hello World\n} x 10"


Code: Reverse stuff
perl -e "print join ' ', reverse 1 .. 20"
perl -e "print scalar reverse join '', 'a' .. 'z'"


Code: Reverse less stuff
perl -e "@array = 1 .. 20; @array[5 .. 10] = reverse @array[5 .. 10]; 
+print qq{@array}"


Code: Reverse less stuff – string version
my $str = join '', 'a' .. 'z';

substr $str, 6, 7, reverse substr $str, 6, 7;
say "$str";


Code: Hashy uniqueness
Case sensitive version
my $name = "Peter Jaquiery";
my %letters;

++$letters{$_} for grep {/[a-z]/i} split '', $name;
say join '', sort keys %letters;

Case insensitive version
my $name = "Peter Jaquiery";
my %letters;

$letters{lc $_} //= $_ for grep {/[a-z]/i} split '', $name;
say join '', map {$letters{$_}} sort keys %letters;


Code: sub – optimal defaults
#!/usr/bin/perl
use strict;
use warnings;
use 5.010;

test('a');
test('b', 0);
test('c', 2, 0);
test('peter ', 2, 3);

sub test {
    my ($str, $lines, $reps) = @_;
    die "No string provided" if ! defined $str;

    $reps ||= 1;
    $lines //= 1;
    say $str x $reps for 1 .. $lines;
}


Session 2

Code: Go loopy
#!/usr/bin/perl
use strict;
use warnings;
use 5.010;

my $count = 0;
my $bailed;

say "Enter 0 to bail.";

while (my $target = int rand 11 and say "I have a number from 1 to 10.
+") {
    print "What is your guess: ";
    my $guess = <>;

    chomp $guess;

    if (!$guess) {
        $bailed = 1;
        last;
    }

    if ($guess == $target) {
        say "You got it.";
        next;
    }
    
    say "Your guess is too ", $guess < $target ? "low" : "high";
    redo;
} continue {
    ++$count;
}

say "I'm sick of playing now." if ! $bailed;
say "You guessed $count numbers.";


Code: An odd hash
#!/usr/bin/perl
use strict;
use warnings;
use 5.010;

my @array = map {int rand 100} 1 .. 20;
my %numbers;

push @{$numbers{$_ % 2 ? 'odd' : 'even'}}, $_ for @array;
say "@{$numbers{odd}}";
say "@{$numbers{even}}";


Code: Passing Arrays
#!/usr/bin/perl
use strict;
use warnings;
use 5.010;

my @array = map {int rand 100} 1 .. 20;
my %numbers;

push @{$numbers{$_ % 2 ? 'odd' : 'even'}}, $_ for sortList (@array);
say "@{$numbers{odd}}";
say "@{$numbers{even}}";


sub sortList {
    return sort {$a <=> $b} @_;
}


Code: Passing Arrays by reference
#!/usr/bin/perl
use strict;
use warnings;
use 5.010;

my @array = map {int rand 100} 1 .. 20;
my %numbers;

push @{$numbers{$_ % 2 ? 'odd' : 'even'}}, $_ for @array;
$_ = sortList ($_) for @numbers{'odd', 'even'};
say "@{$numbers{odd}}";
say "@{$numbers{even}}";


sub sortList {
    return [sort {$a <=> $b} @{$_[0]}];
}


Code: What the hash!
my %hash = (1 .. 20);
say join ' ', theSub(%hash);
sub theSub {return @_;}


Code: Hash sorted
my %hash = (1 .. 20);
say join ' ', theSub(%hash);

sub theSub {
    my %hash = @_;
    return map {$_, $hash{$_}} sort {$a <=> $b} keys %hash;
}


Code: Reversing old school
my @array = 1 .. 20;
my @reversed;

unshift @reversed, shift @array while @array;
say "@reversed";


Session 3

Code: Normalise a file path
(my $path = 'c:\This\That\something\else') =~ s!\\!/!g;
say $path;


Code: More normalise a file path
(my $path = 'This:That\something/else') =~ s![:\\]!/!g;
say $path;


Code: Lines of numbers
my @lines = split '\n', `perldoc perlrequick`;
say for grep {/\d/} @lines;


Code: This or that
my @lines = split '\n', `perldoc perlrequick`;
say for grep {/(or|not)\s+more\b/} @lines;


Code: Just this or that
my @lines = split '\n', `perldoc perlrequick`;
say for map {/(or|not)\s+more\b/; $1} grep {/(or|not)\s+more\b/} @line
+s;


Code: play it again Sam
my @lines = split '\n', `perldoc perlrequick`;
say for grep {/\b(\w+)\s+\1/} @lines;


Code: you wear that in public?
my @apparel;

while (defined(my $line = <DATA>)) {
    chomp $line;

    my ($name, @items) = split /\s*,\s*/, $line;

    while (@items >= 3) {
        my %row;

        @row{qw{name item colour material}} = ($name, splice @items, 0
+, 3);
        push @apparel, \%row;
    }
}

for my $row (grep {$_->{colour} eq 'blue'} @apparel) {
    printf "%-10s %-10s %-10s\n", @{$row}{'name', 'item', 'material'};
}

__DATA__
Peter,shirt,white,cotton,trousers,black,cotton,shoes,black,leather,bum
+ bag,black,synthetic
Ina,shirt,grey,cotton,jeans,blue,denim,shoes,light grey,leather
Phil,T-shirt,blue,synthetic,jeans,blue,denim,sneakers,blue,synthetic


Code: Nasty sentences
#!/usr/bin/perl
use strict;
use warnings;
use 5.010;
use Lingua::EN::Sentence;

my $para = <<PARA;
Sentences can be hard to parse. Take the following for example:
"Mr. Jones works for I.B.M. ... or maybe not.". (Not so easy eh?)
So, did this get it right?
PARA
my $sentences = Lingua::EN::Sentence::get_sentences ($para);

say "$_\n" for map {s/\n+/ /g; $_} @$sentences;


Session 4

Code: Create a password
perl -e "@chrs = ('a'..'z', 'A'..'Z', 0 .. 9); print ((map {$chrs[rand
+ @chrs]} 1 .. 10), qq{\n})"


Code: reprise - you wear that in public?
use DBI;

my $dbh = DBI->connect ("dbi:SQLite:Test.sqlite");
die "connect failed: $DBI::errstr" if ! $dbh;
$dbh->{AutoCommit} = 0;
$dbh->{RaiseError} = 1;
$dbh->{PrintError} = 0;

my $sql = qq{CREATE TABLE People
    (
    name VARCHAR(100),
    item VARCHAR(30),
    colour VARCHAR(30),
    material VARCHAR(50)
    )
};

eval {
    $dbh->do ($sql);
    $dbh->commit ();
    return 1;
} or do {
    $dbh->rollback ();
    die "Failed to create table: $@\n";
};


$sql = qq{INSERT INTO People (name, item, colour, material) VALUES (?,
+ ?, ?, ?)};

my $entries = 0;

eval {
    my $sth = $dbh->prepare ($sql);

    while (defined (my $line = <DATA>)) {
        chomp $line;
        
        my ($name, @items) = split /\s*,\s*/, $line;
        
        $sth->execute ($name, splice @items, 0, 3) while @items >= 3;
    }

    $dbh->commit ();
    return 1;
} or do {
    my $err = $@ || "Unknown error inserting data";
    
    eval {$dbh->rollback ()} or $err .= "\n   Rollback processing fail
+ed!";
    die $err;
};

__DATA__
Peter,shirt,white,cotton,trousers,black,cotton,shoes,black,leather,bum
+ bag,black,synthetic
Ina,shirt,grey,cotton,jeans,blue,denim,shoes,light grey,leather
Phil,T-shirt,blue,synthetic,jeans,blue,denim,sneakers,blue,synthetic


Code: mix and match
use DBI;

my $dbh = DBI->connect ("dbi:SQLite:Test.sqlite");
die "connect failed: $DBI::errstr" if ! $dbh;
$dbh->{AutoCommit} = 0;
$dbh->{RaiseError} = 1;
$dbh->{PrintError} = 0;

my $sql = qq{SELECT name, item, material FROM People WHERE colour LIKE
+ ? order by name};

eval {
    my $sth = $dbh->prepare ($sql);

    $sth->execute ('blue');

    while (my $row = $sth->fetchrow_hashref ()) {
        printf "%-10s %-10s %-10s\n", @{$row}{'name', 'item', 'materia
+l'};
    }
};


Code: dir, ls or something else
my $secPerDay = 60 * 60 * 24;
opendir my ($scan), '.' or die "opendir failed: $!\n";

while (defined(my $entry = readdir $scan)) {
    next if !-f $entry;

    printf "%-20s %10d bytes  %s\n", $entry, -s $entry,
        scalar localtime($^T + $secPerDay * -M $entry);
}


Code: Simple calculator
#!/usr/bin/perl
use strict;
use warnings;
use 5.010;

my %kOps = (
    '*' => sub {return $_[0] * $_[1];},
    '+' => sub {return $_[0] + $_[1];},
    '-' => sub {return $_[0] - $_[1];},
    '/' => \&div,
    );


while ((print "Expression: ") and defined(my $line = <>)) {
    chomp $line;

    my @parts = grep {/\S/} split / |\b/, $line;

    last if !@parts;

    eval {
        unshift @parts, process(\@parts) while @parts > 1;
        return 1;
    } or do {
        print $@;
        next;
    };

    if (!@parts) {
        say "No result calculated for: $line";
        next;
    }

    say "$line = $parts[0]";
}


sub process {
    my ($parts) = @_;
    my ($lhs, $op, $rhs) = splice @$parts, 0, 3;

    die "Bad expression syntax.\n"
        if !defined $rhs || $lhs !~ /^\d+$/ || $rhs !~ /^\d+$/;
    die "Not an operator: $op\n" if !exists $kOps{$op};
    return $kOps{$op}->($lhs, $rhs);
}


sub div {
    my ($lhs, $rhs) = @_;

    die "Divide by zero\n" if !$rhs;
    return $lhs / $rhs;
}
[download]
True laziness is hard work
Comment on Re^2: Design a Perl training day - program and report Download Code

Problems? Is your data what you think it is?
	PerlMonks
Re^2: Design a Perl training day - program and report
