Heh, cute. Of course, I couldn't help but simplify this, with a little help from CPAN.

#! /usr/bin/perl -w

use strict;
use Lingua::EN::Inflect qw/NUMWORDS ORD/;

my @gift = (
    'this element purposely left blank',
    'partridge in a pear tree',
    'turtle doves',
    'French hens',
    'calling birds',
    'golden rings',
    'geese a-laying',
    'swans a-swimmings',
    'maids a-milkings',
    'ladies dancing',
    'lords a-leaping',
    'pipers piping',
    'drummers drumming',
);

for my $day( 1..12 ) {
    print "On the ${\NUMWORDS(ORD($day))} day of Christmas,\nmy true l
+ove gave to me,\n";
    if( $day > 1 ) {
        print "${\NUMWORDS($_)} $gift[$_],\n" for reverse 2..$day;
        print 'and ';
    }
    print "a $gift[1].\n\n";
}
[download]

Of course all those plurals are just begging for Lingua::EN::Inflect::PL but I leave that an exercise to the reader...

Season's greetings to all the monks :o)

Very nice. But still not Lazy enough. ;-)

Try this:

use Lingua::EN::Inflect qw/inflect NUM PART_PRES/;
use Lingua::Conjunction qw/conjunction/;

my @gift = ( '',
  'partridge in a pear tree', 'turtle dove', 'French hen', 'calling bi
+rd',
  'gold ring',                'goose',       'swan',       'maid',
  'lady',                     'lord',        'piper',      'drummer',
);

my @action = map {$_ && PART_PRES $_} ( '',
    '',         '',         '',         '',
    '',         ' a-lay',   ' a-swim',  ' a-milk',
    ' dance',   ' a-leap',  ' pipe',    ' drum',
);

for my $day( 1..12 ) {
  print inflect("On the NUMWORDS(ORD($day)) day of Christmas,\n"),
        "my true love gave to me:",
        conjunction(
          map { NUM($_); inflect "\n\tA(PL_N($gift[$_]))$action[$_]"}
            reverse 1..$day
        ), ".\n\n";
}
[download]

Which then makes it easy to change it to:

use Lingua::EN::Inflect qw/inflect NUM PART_PRES/;
use Lingua::Conjunction qw/conjunction/;

my @gift = ( '',
  'Swiss Army switch statement', 'style of OO', 'loop type',
  'sigil fix',                   'catch block', 'junction',     
  'ref',                         'sub',         'type',
  'try',                         'function',    'less-than',
);

my @action = map {$_ && PART_PRES $_} ( '',
    '',         '',           '',         '',
    '',         ' OR',        ' a-bind',  ' overload',
    ' a-check', ' a-catch',   ' curry',   ' chain',
);

for my $apo ( 1..12 ) {
  print inflect("In the NUMWORDS(ORD($apo)) Perl Apocalypse,\n"),
        "my Larry gave to me:",
        conjunction(
          map { NUM($_); inflect "\n\tA(PL_N($gift[$_]))$action[$_]"}
            reverse 1..$apo
        ), ".\n\n";
}



;-)
[download]

Santa has to leave the Linuga::EN::Inflect module under the tree for your code to work... :-P
I like it tho! ++!

ibanix

$ echo '$0 & $0 &' > foo; chmod a+x foo; foo;

++ I knew you could do it!

I had to remove your sig from the code before it would run... how'd that get in there?

Small omission... it's the "Twelve Days of Christmas" so why aren't you printing "day"?
print "On the $prefix[$day-1] day of Christmas\,\n";

My .sig is embeded in code blocks, so it probally got in with the rest.

As someone else already mentioned, it probally would have made more sense to replace all $day-1 with $day and change the body loop to  for (0..11) { todays_gift $_; }

But oh well, it was fun to hack this together in ~ 20 minutes. :-D

ibanix

$ echo '$0 & $0 &' > foo; chmod a+x foo; foo;

my @redneck_gifts = (
    'some parts to a Mustang GT',
    'two huntin\' dogs',
    'three shotgun shells',
    'four big mud tires',
    'five flannel shirts',
    'six cans of Spam',
    'seven packs of Red Man',
    'eight table dancers',
    'nine years probation',
    'ten of Copenhagen',
    'eleven rasslin\' tickets',
    'twelve pack of Bud',
);
[download]

#include <stdio.h>

main(t,_,a)
char *a;
{return!0<t?t<3?main(-79,-13,a+main(-87,1-_,
main(-86, 0, a+1 )+a)):1,t<_?main(t+1, _, a ):3,main ( -94, -27+t, a
)&&t == 2 ?_<13 ?main ( 2, _+1, "%s %d %d\n" ):9:16:t<0?t<-72?main(_,
t,"@n'+,#'/*{}w+/w#cdnr/+,{}r/*de}+,/*{*+,/w{%+,/w#q#n+,/#{l,+,/n{n+\
,/+#n+,/#;#q#n+,/+k#;*+,/'r :'d*'3,}{w+K w'K:'+}e#';dq#'l q#'+d'K#!/\
+k#;q#'r}eKK#}w'r}eKK{nl]'/#;#q#n'){)#}w'){){nl]'/+#n';d}rw' i;# ){n\
l]!/n{n#'; r{#w'r nc{nl]'/#{l,+'K {rw' iK{;[{nl]'/w#q#\
n'wk nw' iwk{KK{nl]!/w{%'l##w#' i; :{nl]'/*{q#'ld;r'}{nlwb!/*de}'c \
;;{nl'-{}rw]'/+,}##'*}#nc,',#nw]'/+kd'+e}+;\
#'rdq#w! nr'/ ') }+}{rl#'{n' ')# }'+}##(!!/")
:t<-50?_==*a ?putchar(a[31]):main(-65,_,a+1):main((*a == '/')+t,_,a\
+1 ):0<t?main ( 2, 2 , "%s"):*a=='/'||main(0,main(-61,*a, "!ek;dc \
i@bK'(q)-[w]*%n+r3#l,{}:\nuwloca-O;m .vpbks,fxntdCeghiry"),a+1);}
[download]

This is really worth running. You can compile as follows:     cc xmas.c -o xmas

Reverse Engineering the Twelve Days of Christmas explains what is going on.

Larry Wall was also a winner of the IOCCC in 1986 and 1987.

--
John.

--

Brother Frankus.