A classic children's poem using Tie'd variables and some abuse to the ternary operator. 
#!/usr/bin/perl 

use strict;
use Tie::Cycle;

tie my $parent, 'Tie::Cycle', [ qw(Mama Papa) ];
tie my $head_owner, 'Tie::Cycle', [ qw(his her) ];
my $monkeys = 5;

do {
        print "$monkeys little monkeys jumping on the bed,\n";
        print "One fell off and bumped $head_owner head.\n";
        print "$parent called the Doctor and the Doctor said,\n";
        (--$monkeys)  ? print "\"No more monkeys jumping on the bed!\"
+\n\n" : print "\"Put those monkeys straight to bed!\"\n\n\n";

} while ($monkeys);

[download]
--
I used to drive a Heisenbergmobile, but every time I looked at the speedometer, I got lost.

Replies are listed 'Best First'.
Re: Five litte Tie::Cycle Monkeys
by codeacrobat (Chaplain) on Nov 21, 2007 at 22:24 UTC
    I like it :-)
    How about this one: 
    #!/usr/bin/perl

use strict;
use Tie::Cycle;

tie my $parent, 'Tie::Cycle', [ qw(Mama Papa) ];
tie my $head_owner, 'Tie::Cycle', [ qw(his her) ];
my $monkeys = 5;

print qq(
$monkeys little monkeys jumping on the bed,
One fell off and bumped $head_owner head.
$parent called the Doctor and the Doctor said,
@{[--$monkeys ?
'"No more monkeys jumping on the bed!"' :
'"Put those monkeys straight to bed!"'
]}
) while $monkeys;

    [download]
    UPDATE: refactored print statement.
    print+qq(\L@{[ref\&@]}@{['@'x7^'!#2/"!4']});
[reply]
[d/l]
[select]
Re: Five litte Tie::Cycle Monkeys
by bart (Canon) on Nov 21, 2007 at 23:07 UTC
    Very nice. I actually installed Tie::Cycle just to run it.

    One little spot is when it gets down to one, it says:

    1 little monkeys jumping on the bed
    where ideally, that should read "1 little monkey".
[reply]
      More monkey madness :-) 
      use strict;
use Tie::Cycle;

my $monkeys = 5;
tie my $parent,        'Tie::Cycle', [ qw(Mama Papa) ];
tie my $head_owner,    'Tie::Cycle', [ qw(his her) ];
tie my $s,             'Tie::Cycle', [ ('s') x ($monkeys-1), '' ];
tie my $doctors_words, 'Tie::Cycle', [
  ('"No more monkeys jumping on the bed!"') x ($monkeys-1),
  '"Put those monkeys straight to bed!"'
];

print qq(
$monkeys little monkey$s jumping on the bed,
One fell off and bumped $head_owner head.
$parent called the Doctor and the Doctor said,
$doctors_words
) and $monkeys-- while $monkeys;

      [download]
      print+qq(\L@{[ref\&@]}@{['@'x7^'!#2/"!4']});
[reply]
[d/l]
[select]

      You know. I wrote it. I ran it. I posted it.

      Then I showed it to my 6 year old daughter and the first thing she said was "1 monkeys? That doesn't make any sense."

      I'd probably abuse the ternary op some more to get the number of monkeys right in that part. But I guess I'll leave up my original version.

      --
      I used to drive a Heisenbergmobile, but every time I looked at the speedometer, I got lost.
[reply]

Back to Perl Poetry