2008 Winter Scripting Games
Jan Dubois' Solution to Advanced Perl Event 4: Image is Everything
About the Author Jan Dubois is the tech lead for all Perl technologies at ActiveState. He is a member of the core Perl5-Porters group that maintains the Perl language implementation. Jan wrote the Win32::OLE Automation support for Perl while he was still working in the financial industry. He has a Masters degree in Physics from the University of Hamburg, Germany. Jan now lives in Vancouver in Beautiful British Columbia, home of the 2010 Winter Olympics. |
Image is Everything
The fourth event in the 2008 Winter Scripting Games states that “Image is Everything”. While this claim seems a bit broad to me, I will immediately agree that information can become much more useful when displayed in a visually pleasing manner.
The challenge
Given a month and year we are to display a nice looking calendar for this month, looking like the following for the input of “2/2008”.
February 2008
Sun Mon Tue Wed Thu Fri Sat
1 2
3 4 5 6 7 8 9
10 11 12 13 14 15 16
17 18 19 20 21 22 23
24 25 26 27 28 29
How we are going to solve it
After printing the header we are going to use the timelocal() function to determine a time value for the first day of the requested month. Then we walk backwards one day at a time until we are on a Sunday. Now we print the day number for the following 7 days on each line. If the month for that date is not the same as the requested calendar month then we print just blanks instead of the number. We repeat this week for week until we are no longer in the correct month:
use strict;
use warnings;
use POSIX qw(strftime);
use Time::Local qw(timelocal);
print "Enter month/year: ";
chomp($_ = <>);
my($month,$year) = m|^(\d\d?)/(\d{4})$| or die "Invalid input\n";
--$month; $year -= 1900;
my $time = timelocal(0, 0, 12, 1, $month, $year);
print strftime("\n%B %Y\n\n", 0, 0, 0, 1, $month, $year);
print join(" "x5, qw(Sun Mon Tue Wed Thu Fri Sat)), "\n";
$time -= 24*60*60 while (localtime($time))[6];
do {
for my $wday (0..6) {
my($mday,$mon) = (localtime($time))[3,4];
print " "x5 if $wday;
printf "%3s", ($mon == $month) ? $mday : "";
$time += 24*60*60;
}
print "\n";
} while (localtime($time))[4] == $month;
Much of the code should look familiar if you have been following my commentaries for the previous events.
my($month,$year) = m|^(\d\d?)/(\d{4})$| or die "Invalid input\n";
Here we combine input validation and splitting the argument into the month and year parts. I used “|” as the delimiter for the regular expression because the usual “/” is already part of the pattern (it separates the month from the year). In this case the “m” in front of the regular expression is no longer optional.
Using parenthesis in a regular expression creates “capture groups”, and the content of each of these capture groups is returned when the matching happens in list context (the values are always stored in the $1, $2, $3… special variables as well). This way we can assign the month and year parts to $month and $year.
The question mark after the second \d in the pattern means that the second digit is optional. In other words, \d\d? is the same as \d{1,2} and allows us to write either 2/2008 or 02/2008.
--$month; $year -= 1900;
We are going to use the timelocal() and localtime() functions to convert between time() values and dates broken down into year/month/day parts. For historical reasons these functions represent the year relative to 1900, so 2008 needs to be year 108. Months are also encoded from 0 to 11 and not 1 to 12. So we need to transform our input value to that representation.
my $time = timelocal(0, 0, 12, 1, $month, $year);
print strftime("\n%B %Y\n\n", 0, 0, 0, 1, $month, $year);
print join(" "x5, qw(Sun Mon Tue Wed Thu Fri Sat)), "\n";
I started by getting a time value for the first day of the month. I choose 12pm (noon) for the time of day to be right in the middle and not at the edge between 2 dates. That way I won’t have to worry about changes in daylight savings time pushing me across this boundary as I add/subtract 24 hours to this value to move forward/backward by one day.
To print the “February 2008” string I used the strftime() function from the POSIX module. It supports a %B format for the month name, so I did not have to write a list of the names myself. The final header line consists of the 3-letter weekday names, separated by 5 spaces each.
$time -= 24*60*60 while (localtime($time))[6];
Since the first column is for a Sunday and we don’t want to miss any days at the beginning of the month, we subtract one day at a time from our $time value to move backwards until we stop at a Sunday. The weekday is returned by the localtime() function in list context and is the seventh value in that list. Sunday is encoded as 0, so we just continue until we reach that value.
do {
for my $wday (0..6) {
my($mday,$mon) = (localtime($time))[3,4];
print " "x5 if $wday;
printf "%3s", ($mon == $month) ? $mday : "";
$time += 24*60*60;
}
print "\n";
} while (localtime($time))[4] == $month;
Now we print one line for each week. The day of the month, and the month itself, are the fourth and fifth return values of the localtime() function. We print the day number when we are inside the correct month, or 3 spaces when we are not. On each day except for the initial Sunday we also prefix our output with 5 spaces to make everything align properly under our column labels.
Once we hit the end of the first week we are back in our target month. So we know we can stop when the current month at the end of the loop is no longer the right one.
Too many hardcoded assumptions
I did not like this initial script. It contains too much implicit knowledge about the order and encoding of the return values of localtime(). Having to extract these numbers by position, with list slices is just awkward. And why do I have to remember that February is encoded as 1, or Sunday is 0?
Perl 5.10 includes the Time::Piece module which overrides localtime() to return a date object. We can also access all the different fields of a Time::Piece object using accessor methods (properties):
use 5.010;
use strict;
use warnings;
use Time::Piece ();
use Time::Seconds qw(ONE_DAY);
use constant WDAY_SUNDAY => 1;
$_ = shift or do { print "Enter month/year: "; chomp($_ = <>) };
my($month,$year) = m,^(\d\d?)/(\d{4})$, or die "Invalid input\n";
my $time = Time::Piece->strptime("$month/1/$year 12", "%m/%d/%Y %H");
print $time->strftime("\n%B %Y\n\n");
print join("\t", qw(Sun Mon Tue Wed Thu Fri Sat)), "\n";
$time -= ONE_DAY until $time->wday == WDAY_SUNDAY;
do {
my $output;
for (1..7) {
$output .= "\t" unless $time->wday == WDAY_SUNDAY;
$output .= sprintf "%3s", ($time->mon == $month) ? $time->mday : "";
$time += ONE_DAY;
}
$output =~ s/\t*$//;
say $output;
} while $time->mon == $month;
Here are the changes to the original script:
use Time::Piece (); use Time::Seconds qw(ONE_DAY); use constant WDAY_SUNDAY => 1;
We are loading the Time::Piece module, but are not going to use the overridden localtime() function; that means that we don’t need to import it into our namespace. Providing an explicit import list is a good practice: it makes it much easier to notice later on that a module may no longer be used by a program if none of the functions being imported are called anymore.
The Time::Seconds module provides several constants for Time::Piece, but we are only interested in ONE_DAY. This happens to be the same as 24*60*60, but we don’t care about how Time::Piece objects are implemented internally.
Unfortunately there are no importable constants for the weekdays, so we need to define our own at the top of the script. That way we can avoid using hardcoded values later on. Of course the right way to do this is to report the shortcoming to the module author so that it can be fixed in a later release. I’ll do that once I get a spare tuit.
$_ = shift or do { print "Enter month/year: "; chomp($_ = <>) };
my($month,$year) = m,^(\d\d?)/(\d{4})$, or die "Invalid input\n";
I got tired of always having to enter the month/year to an additional prompt, so I added some trivial code to fetch it from the command line first, and only prompt if no additional argument was provided.
my $time = Time::Piece->strptime("$month/1/$year 12", "%m/%d/%Y %H");
print $time->strftime("\n%B %Y\n\n");
print join("\t", qw(Sun Mon Tue Wed Thu Fri Sat)), "\n";
Instead of using localtime() with all its weird parameters I decided to use the strptime() method of the Time::Piece class to create our initial $time object. It parses a date string against the specified format.
I also decided to separate the output columns with \t (tab) characters instead of 5 spaces, just for variety. It should make no visible difference.
$time -= ONE_DAY until $time->wday == WDAY_SUNDAY;
The Time::Piece objects provide overloaded numeric semantics. So we can still add/subtract ONE_DAY from the object, and it will adjust its internal state accordingly.The old script used (localtime($time))[6] to determine if $time represents a Sunday. The new code uses the “wday” accessor and compares the value against WDAY_SUNDAY explicitly, making this much more readable.
do {
my $output;
for (1..7) {
$output .= "\t" unless $time->wday == WDAY_SUNDAY;
$output .= sprintf "%3s", ($time->mon == $month) ? $time->mday : "";
$time += ONE_DAY;
}
$output =~ s/\t*$//;
say $output;
} while $time->mon == $month;
The rest of the code is just more of the same kind of changes. For some non-rational reasons I was also bothered by the trailing whitespace we used to emit for the last week of the month (unless the month ended on a Saturday). Therefore I decided to assemble the output for each line in an $output variable, and strip off any trailing tab characters before printing it.
I like this new script much better than the previous one. Except for the definition of WDAY_SUNDAY it doesn’t require me to remember any of the minute details of the implementation of localtime() and timelocal(). What do you think? Let me know at jand@activestate.com.
