CIS 33 - Programming in Perl
Final Examination

1. For each problem below, indicate what is printed on the screen.  
   No partial credit on any answer so BE CAREFUL!  Indicate spaces
   in your answers CLEARLY!


a)  @L = ([1,2,3], [4,5], [6,7,8,9], [], [11,12], [5], [6,8,10,12]);
    @X = map {$_->[0] + $_->[-1]} grep {@$_ > 1} @L;
    print "@X";

    #####   4 9 15 23 18 

b)  The Unix date command gives:  Thu Jun  1 19:48:03 PDT 2007
    @x = (localtime(time))[2,4,6];
    print "@x";

    #####  19 5 4

c)  $x = "a\n*\n2\n3\nX\n4\n5\n6\n*bcX\n7\n8\n*\n9\nX\n10\n";
    open(F, "+>foo");   #  Assume success.
    print F $x;
    seek(F, 0, 0);
    while(<F>) {chomp; print if /\*/../X/}

    #####  *23X*bcX*9X 

d)  %H = ("r" => -2, "a" => 4, "s" => -1, "j" => 2);
    $x =  "I love rasj!";
    $x =~ s/(.)/exists($H{$1}) ? chr(ord($1) + $H{$1}) : $1/ge;
    print $x;
    
    #####  I love perl!

e)  @L = qw(hi-there go-back get-lost go-forward leave-now save-me howdy-dude);
    @L = grep {($x) = (split /-/)[1]; length($x) > 4} @L;
    print "@L";

    #####  hi-there go-forward

f)  @L = qw{Kali Aikido Cannot Scare);
    $x = 0;
    @X = map ($x++; substr($_, -$x)} @L;
    print "@X";

    #####  i do not care

g)  $x = "person in green";   # One space between words!
    substr($x, 3, 3)  = "l";  # That is an "ell"!
    substr($x, -7, 1) = "s";
    substr($x, -2)    = "at";
    print $x;

    #####  perl is great

h)  %H = ("a" => {"a" => 3, "b" => 2, "c" => 5}, "b" => {"d" => 7, "e" => 4},
          "c" => {"d" => 6, "b" => 3}, "d" => {"x" => 2, "y" => 9, "z" => 2});
    foreach (sort keys %H)
    {
       $sum = 0;
       foreach $val (values %{$H{$_}}) {$sum += $val}
       push(@L, $sum);
    }
    print "@L";

    #####  10 11 9 13

i)  %H = ("a" => [3,2,4,5], "b" => [7,4,1,2,4], "c" => [11,9,6], "d" => [7]);
    @L = map {$_->[0] * $_->[-1]} values %H;
    @L = sort {$b <=> $a} @L;
    print "@L"; 

    #####  66 49 28 15
 
j)  $r = [[11,2,6,7], [2,8,5,4], [7,2,2], [5,5,3,2,8], [2,3,6,1,4]];
    @X = grep {$_->[0] > $_->[-1]} @$r;
    @Y = map {@$_} @X;
    print "@Y";

    #####  11 2 6 7 7 2 2 

k)   $r = [[3,2,9,6], [7,8,9,7], [6,4,10,8], [11,7,8,9]];
     @$r = sort {my ($hiA, $loA) = (sort {$a <=> $b} @$a)[-1,0];
                 my ($hiB, $loB) = (sort {$a <=> $b} @$b)[-1,0];
                 ($hiA - $loA) <=> ($hiB - $loB)} @$r;
     foreach (@$r) {print "$_->[0] "}  #  Space after $_->[0] 

     #####  7 11 6 3 

l)  A file "x" in the current directory has permission mask -r-x-wxr--

     printf "%03o", ((stat "x")[2]) & 0222;

     #####  020

m)   @L = (5,4) x 3;
     print "@L";

     #####  5 4 5 4 5 4

n)   An ls -l listing of foo is:

     -rw---xr-x    4 perry    cisStaff       37 Nov 22 20:20 foo

      print ((stat "foo")[3]);

     #####  4

o)   print "Happy Holidays!";

     #####  Happy Holidays!
   



2.   Write a Perl sub which expects a reference to a list of list and a
     reference to a list as its two parameters.  There are as many values
     in the list parameter as there are lists in the list of list parameter.
     Your sub will insert each list value in the list parameter into the
     corresponding list in the list of list parameter.  Example:  If the
     first two lists in the list of list are [5,6] and [9,4] and the list
     parameter starts with [8,7, ## More values here] then the two lists
     in the list of list will change to [5,6,8] and [9,4,7].

     #########################################################################
             sub AddValuesToEndsOfLists
             {
                 my ($rlol, $rlist) = @_;

                 @$rlol = map {push(@$_, shift(@$rlist)); $_} @$rlol;
             }
     #########################################################################







3.  Write a Perl sub which takes a reference to a hash of list parameter
    and an integer parameter.  The sub will delete key/value pairs from
    the hash when the integer parameter is equal to any member of a given
    list.  

    ##########################################################################
           sub DeleteHashElements
           {
              my ($rhol, $value) = @_;

              foreach (keys %$rhol)
              {
                 delete $rhol->{$_} if (grep {$_ == $value} @{$rhol->{$_}}) > 0;
              }
           }
    ###########################################################################