Everyone knows about Santa's Naughty or Nice list. Few lists are more revered, nor feared, than this one. For some of us, it led to the most wonderful surprises and cherished childhood memories. For others... well, let's just say that it was instrumental in the stockpiling of enough fossil fuel to keep us warm throughout the winter (and then some).
What few people know, though, is that the List stopped being scalable many years ago. With so many kids, and the Niceness matrix constantly growing in complexity, it was only a question of time before the North Pole scribes would lose the fight. So, once it became clear that the good ol' ways wouldn't do anymore, the big Ho-Ho-Honcho put his foot down and mandated the IT elves to overhaul the whole process.
And they did. As it turned out, they elected to base their solution on Test::Harness and the whole Perl testing infrastructure. In the span of a few months, through the sheer might of their merry hacking, they turned the quaint paper-based list of yore into a lean, mean, database server farm-backed machine. Now, the dirt could be gathered on all the children in the blink of an eye:
ok 1 - Li'l Timmy has been nice
ok 2 - Li'l Timmy ate his/her veggies
ok 3 - Li'l Timmy off to bed before 19:30
ok 4 - Li'l Timmy has not been pouting
ok 5 - Li'l Timmy has not been grouchy
not ok 6 - Li'l Dennis has been nice
not ok 7 - Li'l Dennis ate his/her veggies
ok 8 - Li'l Dennis off to bed before 19:30
ok 9 - Li'l Dennis has not been pouting
ok 10 - Li'l Dennis has not been grouchy
ok 11 - Li'l Linus has been nice
ok 12 - Li'l Linus ate his/her veggies
ok 13 - Li'l Linus off to bed before 19:30
ok 14 - Li'l Linus has not been pouting
ok 15 - Li'l Linus has not been grouchy
ok 16 - Li'l Lucy has been nice
ok 17 - Li'l Lucy ate his/her veggies
ok 18 - Li'l Lucy off to bed before 19:30
ok 19 - Li'l Lucy has not been pouting
not ok 20 - Li'l Lucy has not been grouchy
Pretty proud of their system, the elves went and presented it to the Big Man. Unfortunately, and as it is well-documented in songs, Santa's a busy man he has no time to play. And having millions of stockings to fill on Christmas day makes one a firm believer in executive summaries. So it's understandable that Father Christmas wasn't totally sold to the elves' solution. "I don't care if they're sleeping," he snapped, "I don't care if they're awake, I just want to know if they've been good, FOR GOODNESS' SAKE!"
Back to the drawing board the elves scurried. Would they have to rewrite their infrastructure from scratch? Could this unforeseen churn jeopardize Christmas' delivery date? It turned out they didn't need to, and -- heavens be thanked -- it wouldn't. For one of the lead develfpers thought of using Test::Group to bundle each child's tests into a single all-niceness-encompassing one.
ok 1 - Li'l Timmy
not ok 2 - Li'l Dennis
ok 3 - Li'l Linus
not ok 4 - Li'l Lucy
This was much more to Santa's liking and, boys and girls, this is still the system that the North Pole use to this very day...
Note to kiddies for 2008/2009 -- Bedtime niceness is an Average. Going to bed at sundown may save it at the last minute. Niceness and bedtime have some slack but vegetables, grouchy, pouting are seemingly Zero tolerance, so be careful! -- The Mgt
1 use Test::More 'no_plan'; 2 3 use ChildrenDB; 4 5 while ( my $kid = ChildrenDB::next_child() ) { 6 my $who = "Li'l " . $kid->name; 7 8 ok $kid->nice_level >= 5, "$who has been nice"; 9 ok $kid->eat_vegetables, "$who ate his/her veggies"; 10 ok $kid->avg_bedtime < 1930, "$who off to bed before 19:30"; 11 ok !$kid->been_pouting, "$who has not been pouting"; 12 ok !$kid->been_grouchy, "$who has not been grouchy"; 13 } 14
1 use Test::More 'no_plan'; 2 3 use ChildrenDB; 4 5 use Test::Group; 6 7 sub been_good($) { 8 my $kid = shift; 9 test "Li'l " . $kid->name => sub { 10 ok $kid->nice_level >= 5, 'has been nice'; 11 ok $kid->eat_vegetables, 'ate his/her veggies'; 12 ok $kid->avg_bedtime < 1930, 'off to bed before 19:30'; 13 ok !$kid->been_pouting, 'not been pouting'; 14 ok !$kid->been_grouchy, 'not been grouchy'; 15 } 16 } 17 18 while ( my $kid = ChildrenDB::next_child() ) { 19 been_good $kid; 20 }
1 package ChildrenDB; 2 3 use strict; 4 use warnings; 5 6 # mock-up of the North Pole children database 7 # which can't be reproduced here (as it's top-secret 8 # material) 9 10 my @children = ( 11 Kid->new( name => 'Timmy' ), 12 Kid->new( name => 'Dennis', nice_level => 2, eat_vegetables => 0, ), 13 Kid->new( name => 'Linus' ), 14 Kid->new( name => 'Lucy', been_grouchy => 1 ), 15 ); 16 17 sub next_child { 18 return shift @children; 19 } 20 21 { 22 23 package Kid; 24 25 sub new { 26 my ( $class, %attrs ) = @_; 27 28 return bless { 29 nice_level => 5, 30 eat_vegetables => 1, 31 avg_bedtime => 1900, 32 been_pouting => 0, 33 been_grouchy => 0, 34 %attrs, 35 }, $class; 36 37 } 38 39 sub AUTOLOAD { 40 no strict; 41 ( my $key = $AUTOLOAD ) =~ s/^.*:://; 42 return $_[0]->{$key}; 43 } 44 } 45 46 1;