Solutions and Discussion for Perl Quiz of the Week #3

Sample solutions and discussion
Perl Quiz of The Week #3 (20021030)


        Write a program, 'spoilers-ok'.  It will read the
        quiz-of-the-week email message from the standard input,
        extract the date that the message was sent, and print a
        message that says

                It is okay to send spoilers for this quiz

        or

                It is too soon to send spoilers for this quiz.
                You may send spoilers in another 4 hours 37 minutes.

        It becomes okay to send spoilers after 60 hours have elapsed
        from the time the quiz was sent.

        You can be sure that the 'Date' field of the QOTW email
        message will always be in the same format, which is dictated
        by internet mail format standards.  For those unfamiliar with
        this format:

                Date: Wed, 23 Oct 2002 16:10:15 -0400

        The "16:10:15" is the time of day.  "-0400" means that the
        time of day is in a time zone that is 4 hours behind
        Greenwich.

Effective use of modules turned out to be the key to the best
solutions to this quiz.  There are three key items:

  extract the date field from the mail header
  parse the date
  format the output

When I went to write up a sample solution last week, I knew there must
be a module for parsing mail headers, but I just couldn't find it.  I
spent some time looking for it, and then lost patience.  It turned out
to be Mail::Header.

This short and utterly straightforward solution was provided by Craig
Sanders:

        #! /usr/bin/perl -w

        use Mail::Header;
        use Date::Parse; 

        use strict;

        my $head = new Mail::Header [<>], Modify => 0;

        my $date = $head->get("Date");

        my $message_time = str2time($date);

        my $ok_time = $message_time + 3600 * 60;

        my $now = time();

        if ($now >= $ok_time) {
          print "It is okay to send spoilers for this quiz\n" ;
        } else {
          my $diff = $ok_time - $now ;
          my $hours = int($diff / 3600);
          my $minutes = int(($diff - $hours * 3600) / 60);
          print "It is too soon to send spoilers for this quiz.\n" ;
          print "You may send spoilers in another $hours hours $minutes minutes.\n" ;
        }

Some people (including me) wrote more than twice as much code to
accomplish the same thing.


1. People used a variety of date-parsing modules.  In addition to
   Date::Parse, people also used Date::Manip, Time::Local, and
   HTTP::Date.  But if you use Time::Local, you must extract and
   combine the parts of the date yourself; then there is a possibility
   to make a mistake.  One of the submitted solutions that used
   Time::Local made an error in the time zone handling:

        $release_time += ((-$3 * 36) + 216000);  # timezone, 60 hr.delay
    
   The (-$3 * 36) is the time zone adjustment here; $3 contains the
   time zone part of the date field.  This adjustment works for most
   time zones, but not all.  For example, had the quiz-of-the-week
   been sent from India, where the time zone is +0530 (five hours,
   thirty minutes) the calculated adjustment would have been 19080
   seconds, instead of 19800.  This is probably an argument in favor
   of the modules.

2. Craig's solution has a minor defect: at times, it will generate
   outputs like

        You may send spoilers in another 1 hours 1 minutes.

   This is bad English.  One easy way to take care of it:

        my $Hours   = $hours == 1   ? 'hour'  : 'hours';        
        my $Minutes = $minutes == 1 ? 'minute : 'minutes;        

        print "You may send spoilers in another $hours $Hours $minutes $Minutes.\n" ;

   Seth Blumberg used Lingua::EN::Inflect to handle this.

3. Another possible defect in Craig's solution is that if $diff is
   7379 seconds, the output is "... 2 hours 2 minutes"; but really
   it's 2 hours, 2 minutes, and 59 seconds.  There was a brief
   discussion of how to round off times; Kevin Pfeiffer observed:

        For dividing seconds into hours and minutes, I believe that a
        normal rounding operation is wrong. If you have 1.7 hrs, you
        don't want to round up, but rather take the 1 and leave the
        remainder to convert to minutes.

   To handle this in Craig's code, you could use:

          my $hours = int($diff / 3600);
          my $minutes = int(($diff - $hours * 3600) / 60 + .5);

   (The + .5 is the only new thing here.)

   Iain Truskett used Time::Duration to format the output, which takes
   care of the plural and the rounding issues.  It doesn't produce the
   specified output format; it might say "1 day 17 hours" instead of
   "41 hours 17 minutes".  Whether this is a bug or a feature is up to
   you.  

4. The solution I wrote up beforehand seems to me to be clearly
   inferior to Craig's; it's longer and more complicated because it
   does everything manually:

        #!/usr/bin/perl

        use Time::Local 'timegm';

        my $date_field;
        while (<>) {
          chomp;
          last unless /\S/;
          if (s/^Date:\s+//) {
            $date_field = $_;
            while (<>) {                # read continuation lines?
              last unless s/^\s//;
              chomp;
              $date_field .= $_;
            }
            last;
          }
        }

        die "No Date: field found\n" unless defined $date_field;

        # Typical value:
        # Wed, 30 Oct 2002 21:34:54 -0000
        my ($dy, $mo, $yr, $hr, $mn, $sc, $tzd, $tzh, $tzm) =
          $date_field =~ 
                   /\w\w\w,\              #  Day of week
                    ([\d\s]\d)\ (\w\w\w)\ (\d\d\d\d)\ # Day, month, year
                    (\d\d):(\d\d):(\d\d)\ # Time
                    ([+-])(\d\d)(\d\d)/x; # Time zone

        unless (defined $dy) {
          die "Couldn't parse Date: field\n";
        }

        my %mo = qw(jan 0 feb 1 mar 2 apr 3 may 4 jun 5
                    jul 6 aug 7 sep 8 oct 9 nov 10 dec 11);

        die "Unknown month name '$mo'\n" unless exists $mo{lc $mo};
        my $msgtime = timegm($sc, $mn, $hr, $dy, $mo{lc $mo}, $yr-1900);
        my $tz_adjust = ($tzm * 60 + $tzh * 3600);
        $tz_adjust *= -1 if $tzd eq '+';
        $msgtime += $tz_adjust;   # msgtime is now adjusted for time zone

        my $time_left = ($msgtime + 60 * 3600) - time();

        if ($time_left < 0) {
          print "It is okay to send spoilers for this quiz\n";
        } else {
          print "It is too soon to send spoilers for this quiz.\n";
          my $hr = int($time_left / 3600);
          my $min = int(($time_left - 3600*$hr)/60 + 0.5);
          my $hours = ($hr == 1 ? 'hour' : 'hours');
          my $minutes = ($min == 1 ? 'minute' : 'minutes');
          print "You may send spoilers in another $hr $hours $min $minutes.\n";
        }


   And sure enough, it did have a bug:  In the date-parsing regex, I
   originally wrote (\d\d) to match the day of the month, instead of
   ([\d\s]\d); as a result, any message sent in the first 9 days of
   any month would fail to match, and the program would die.


Thanks again for your interest.  I will send another quiz tomorrow; 
it will not contain any date arithmetic.