From www.manning.com/getpage.html?project=johnson&filename=solutions.html

-------------------------------------------------------------------------------

Below you will find solutions (not answers) to most (not all) of the
exercises in the book. Keep in mind that these solutions are not the
only possible solutions, nor are they necessarily the best solutions
(in some cases the solution could be improved by things learned in
later chapters).  

Chapter 3:

   1. Declare two new variables ($right, $wrong) at the top level
   (just before $quit is declared), and set them to 0.

     my ($right, $wrong) = (0, 0);

      Then, change the "test response" code to look like:

     # test response
     if ($response eq 'q') {
         $quit = 1;
     } elsif ($response = $solution) {
         print "Correct\n";
         $right = $right + 1;
     } else {
         print "Incorrect: $question $solution\n";
         $wrong = $wrong + 1;
     }

      You may then add a print statement showing the totals whenn the
      program exits, or display the current totals before each
      question.

   2. To roll two 6 sided dice you need to generate two random
   integers from 1 to 6 inclusive. A pseudo code design might look
   like:

   display start message
   set first_die  to random integer between 1 and 6 inclusive
   set second_die to random integer between 1 and 6 inclusive
   set total to first_die plus second_die
   display each die and the total.

      In real code, it doesn't look much different:

   #!/usr/bin/perl -w
   use strict;
   print "Rolling two die:\n";
   my $first  = int(rand(6) + 1);
   my $second = int(rand(6) + 1);
   my $total  = $first + $second;
   print "You rolled: [$first and $second] $total\n";

      Modification to print a representation of the dice is still left
      as an exercise.

Chapter 4:

   1. A program that asks for a weight in pounds and returns an
   equivalent weight in kilograms (using 1 kilogram = 2.2 pounds):

   #!/usr/bin/perl -w
   use strict;
   
   print "Enter a weight in pounds: ";
   my $pounds <STDIN>;
   chomp($pounds);
   my $kilos = $pounds / 2.2;
   print "$pounds pounds equals $kilos kilograms\n";

   2. Calculate the gross pay of an employee based on hourly rate,
   number of regular hours, and number of overtime hours (using
   overtime rate of time and a half):

   #!/usr/bin/perl -w
   use strict;
   
   print "Enter your hourly pay rate: ";
   my $rate = <STDIN>
   chomp($rate);

   print "Enter the number of regular hours: ";
   my $reg_hours = <STDIN>;
   chomp($reg_hours);
   
   print "Enter the number of overtime hours: ";
   my $over_hours = <STDIN>;
   chomp($over_hours);
   
   my $reg_pay   = $rate * $reg_hours;
   my $over_pay  = $rate * $over_hours * 1.5;
   my $gross_pay = $reg_pay + $over_pay;
   print "Gross pay is: $gross_pay\n";

Chapter 5:

   1. Get 20 or less values from user and display in reversed order:

    #!/usr/bin/perl -w
    use strict;
    
    my @values;
    foreach my $count ( 1 .. 20 ) {
        print "Enter value $count [or 'q' to stop]: ";
        chomp(my $value = <STDIN>);
        last if $value eq 'q';
        unshift(@values, $value);
    }

    print "Reversed values are:\n";
    foreach my $value (@values) {
        print "$value \n";
    }

   2. Modified to remove duplicates, but show the number of times a
   value was entered:

    #!/usr/bin/perl -w
    use strict;
    
    my @values;
    my %seen;
    foreach my $count ( 1 .. 20 ) {
        print "Enter value $count [or 'q' to stop]: ";
        chomp(my $value = <STDIN>);
        last if $value eq 'q';
        next if $seen{$value}++;
        unshift(@values, $value);
    }

    print "Reversed values are:\n";
    foreach my $value (@values) {
        print "$value : used $seen{$value} time(s)\n";
    }

Chapter 6:

   1. Create report of user time online from data:

    #!/usr/bin/perl -w
    use strict;

    my %users;
    while(<DATA>){
        chomp;
        my ($user, $time) = split /:/;
        $users{$user} += $time;
    }

    foreach my $user (keys %users){
        print "User: $user\n";
        print "Total time online: $users{$user}\n\n";
    }

    __DATA__
    bjones:27
    asmith:102
    asmith:12
    jdoe:311
    bjones:45

   2. Modify word count to take command line option for size. In this
   case, we simply check the first item in @ARGV to see if it is a
   '-s' followed by digits. Here is the segment to get and set the
   size, using 4 if no size given:

    my $size;
    if ( $ARGV[0] =~ m/^-s(\d+)$/ ) {
        $size = $1;
        shift @ARGV; # remove the -s option
    } else {
        $size = 4;
    }

Chapter 7

   1. A subroutine to return the sum of its arguments:

    sub sum {
        my $sum = 0;
        foreach my $arg ( @_ ) {
            $sum += $arg;
        }
        return $sum;
    }

   2. Two routines, max_num() and min_num() to return the maximum and
   minimum of their argument lists:

    sub max_num {
        my $max = shift;
        foreach my $item (@_) {
            $max = $item if $item > $max;
        }
        return $max;
    }

    sub min_num {
        my $min = shift;
        foreach my $item (@_) {
            $min = $item if $item < $min;
        }
        return $min;
    }

      The string versions would just replace '>' and '<' with 'gt' and
      'lt' respectively.

Chapter 8:

   1. Read in data into a 2 dimensional array and print out the
   transpose of that array:

    #!/usr/bin/perl -w
    use strict;

    my @table;

    while(<DATA>){
        chomp;
        push @table, [split];
    }

    @table = transpose(@table);

    foreach my $row (@table){
        print join("\t", @$row),"\n";
    }

    sub transpose {
        my @mat = @_;
        my @return;
        for(my $i = 0; $i < @mat; $i++){
            for(my $j = 0; $j < @{$mat[$i]}; $j++){
                $return[$j][$i] = $mat[$i][$j];
            }
        }
        return @return;
    }

    __DATA__
    one   two   three
    four  five  six
    seven eight nine

Chapter 10:

   1. Will the pattern +m/(.*)(\d\d?)/ match on the string `foo12bar'?
   If so, what will $1 and $2 contain? 

   Yes, and $1 would contain 'foo1', and $2 would contain '2'. What
   would change if the pattern was m/(.*)(\d\d)?bar/? Now the entire
   second grouping is optional, so the match can succeed without it
   --- the pattern matches and $1 is 'foo12' and $2 is not set.

   2. Regex to match target if it contains only digits:

    m/^\d+$/

      Regex to match if target is positive integer or decimal number:

    m/^\d+(\.\d+)?$/

      Regex to match if target is positive or negative number
      including scientific format (from perlfaq4):

    m/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/

Chapter 11

   1. A function that returns a list of doubled words, including
   different cases and crossing line boundaries:

    sub doubles {
        my $string = shift;
        my @dups = m/\b([a-z]+)\s+\1\b/ig;
        return @dups;
    }

   2. Regex to substitute every occurence of the word 'apple' with
   'orange' only if followed by a space and 'peel' (don't change
   'pineapple peel'):

    s/\bapple(?= peel)/orange/g;

   3. Function to print out summary of vowels in a string:

    sub print_vowels {
        my $string = shift;
        print "a ", $string =~ tr/a//,"\n";
        print "e ", $string =~ tr/e//,"\n";
        print "i ", $string =~ tr/i//,"\n";
        print "o ", $string =~ tr/o//,"\n";
        print "u ", $string =~ tr/u//,"\n";
    }

      There are several other ways to do this. 

Chapter 12:

   1. Function that returns the values of a hash sorted by the keys:

    my %hash = (a => 15, d => 42, c => 31, b => 25);
    print join('|',values_by_key(%hash)),"\n";
    sub values_by_key {
        my %hash = @_;
        my @values;
        foreach my $key (sort keys %hash){
            push @values, $hash{$key}
        }
        return @values;
    }

    # Same thing using map():
    
    print join('|', map{$hash{$_}} sort keys %hash);

   2. Modify one-liner to filter out values less than 25:

    print join('|', grep{$_ >= 25} map{$hash{$_}} sort keys %hash);

Chapter 13:

   1. Run the 'ps' command (unix):

    #!/usr/bin/perl -w
    use strict;
    system('ps');

   2. Read from 'ps' comand and display processes run by user given as
   an argument:

    #!/usr/bin/perl -w
    use strict;
    $ARGV[0] or die "no user given\n";
    my $user = $ARGV[0];
    my @ps = `ps -aux`;
    foreach my $line (@ps) {
        print $line if $line =~ /^$user/;
    }

   3. Filetest program to list file types:

    #!/usr/bin/perl -w
    use strict;
    my $dirname = shift @ARGV if @ARGV;
    $dirname ||= '.';

    opendir(DIR, $dirname) || die "can't: $!";
    my @entries = map{"$dirname/$_"} grep !/^(\.|\.\.)$/, readdir DIR;
    closedir DIR;

    my %counts;
    foreach (@entries) {
        $counts{files}++        if -f;
        $counts{directories}++  if -d;
        $counts{sockets}++      if -S;
        $counts{fifo}++         if -p;
        $counts{symlink}++      if -l;
    }

    foreach my $key (keys %counts){
        print "$counts{$key} $key(s) under $dirname\n";
    }

Chapter 17:

   1. Rewrite pushdown() as a recursive routine:

    sub pushdown {
        my $i = shift;
        my $l = 2 * $i;
        my $r = $l + 1;
        my $largest = 0;
        if ($l <= $_[0] and $_[$l] > $_[$i]){
            $largest = $l;
        }else{
            $largest = $i;
        }
        if ($r <= $_[0] and $_[$r] > $_[$largest]){
            $largest = $r;
        }
        if ($largest != $i) {
            ($_[$largest],$_[$i]) = ($_[$i],$_[$largest]);
            unshift @_, $i;
            &pushdown;
        }
    }

      Recursion is generally more costly than iterative solutions, but
      it won't hurt too much here as the recursion depth is never more
      than the height of the heap.

   2. This is answered in chapter 19 whenn we implement a heap class.

   3. This is also discussed in chapter 19. 

Chapter 18:

   1. Dump_keys

    sub dump_keys {
        my $self = shift;
        my @list = ($self->{key});
        while(1){
            last unless $self->{next};
            $self = $self->{next};
            push @list,$self->{key};
        }
        return @list;
    }