Long ago I used to joke that perl is write-only... was that harsh or realistic? (I still believe it - too clever constructions which feel smart at the time you come up with them :)
"too clever constructions which feel smart at the time you come up with them"
That's the coder, not the language.
Which is more obvious what's happening.
print ''.join('%(pre)s%(num)s %(bot)s on the wall, %(nul)s %(bot)s,\n%(tak)s\n' % (lambda c,b: {'pre':['','%s %s on the wall.\n\n' % (c,b)][abs(cmp(c,'Ninety-nine'))], 'num':c, 'nul':c.lower(), 'bot':b, 'tak':['Go to the store and buy some more... Ninety-nine %s.' % b,'Take one down, pass it around,'][abs(cmp(x,0))] })((lambda x,o: [(['Twenty','Thirty','Forty','Fifty', 'Sixty','Seventy','Eighty','Ninety'][x/10-2]+'-'+o.lower()).replace('-no more',''), o][int(x=20)]]),'bottle%s of beer' % ['','s'][abs(cmp(x,1))]) for x in xrange(99,-1,-1))
my $firstline = 1;
my @tens = qw/Ninety Eighty Seventy Sixty Fifty Forty Thirty Twenty/;
my @teens = qw/Nineteen Eighteen Seventeen Sixteen Fifteen Fourteen Thirteen Twelve Eleven Ten/;
my @ones = qw/Nine Eight Seven Six Five Four Three Two One/;
sub go {
my $num = shift;
my $bottles = "bottles";
if ($num eq "One") {
$bottles = "bottle";
}
if ($firstline == 0) {
print "$num $bottles of beer on the wall.\n";
print "\n";
}
$firstline = 0;
print "$num $bottles of beer on the wall, ".lc($num)." $bottles of beer,\n";
print "Take one down, pass it around,\n";
if ($num eq "One") {
print "No more bottles of beer on the wall.\n";
print "\n";
}
}
foreach my $ten (@tens) {
foreach my $one (@ones) {
go("$ten-".lc($one));
}
go($ten);
}
foreach my $teen (@teens) {
go($teen);
}
foreach my $one (@ones) {
go($one);
}
print "No more bottles of beer on the wall, no more bottles of beer,\n";
print "Go to the store and buy some more... Ninety-nine bottles of beer.\n";
print "\n";