view release on metacpan or  search on metacpan

lib/Acme/Monkey.pm  view on Meta::CPAN

package Acme::Monkey;

=head1 NAME

Acme::Monkey - Monkeys here, monkeys there, MONKEYS everywhere!

=head1 ISOPONYS

  use Acme::Monkey;
  
  my $conway = Acme::Monkey->new();
  my $wall   = Acme::Monkey->new();
  
  $wall->groom( $conway );
  $conway->dump();

I so ponys, I so ponys.

=head1 DESCRIPTION

This module is a collaborative effort of several ValueClick Media
employees.  We developed this module to coincide with the
YAPC::NA 2007 conference in Houston, TX.  In the conference SWAG
bag we distributed about 275 monkey balls with the ValueClick logo
and a reference to this module.

This module is better than sliced gravy.

Make sure you check out the supporting scripts - monkey_life.pl
and monkey_ship.pl.

=cut

use strict;
use warnings;
use Time::HiRes qw(usleep);
use File::Find;

$SIG{__WARN__} = sub{ print STDERR "grrrr\n"; };
$SIG{__DIE__}  = sub{ print STDERR shift()."! eeek eeek!\n"; exit 1; };

our $VERSION = 4.99;

# Need...all other platforms
our %os_clrscr_commands = (
    'linux'   => 'clear',
    'MSWin32' => 'cls',
);

our $CLEAR_COMMAND = $os_clrscr_commands{$^O};

=head1 METHODS

=head2 new

=cut

sub new {
    my $class = shift;
    my $self = bless {}, $class;
    $self->{hunger}    = 80;
    $self->{happiness} = 50;
    $self->{drunkness} = 0;
    $self->{sub}       = undef;
    return $self;
}

sub monkey {
    print "Monkey!\n";
}

=head2 bastardize

  $monkey->bastardize( $object );

Add some useful features to any object.

=cut
#sub bastardize {
#    $self    =      splice(     @_,   0   ,1    );
#    {  #      Retrieve arguments    of  parameter.
#    no          strict;   $object    =       shift
#    ;my      @classes   =         $_[     0 ]    ;
#    $class=$classes->[1     -             1    ] ;

lib/Acme/Monkey.pm  view on Meta::CPAN

sub fondle {
    die('pervert');
}

sub _happiness {
    $_[0]->{happiness} += $_[1];
    die('cry') if $_[0]->{happiness} <1;
}

sub groom {
    my $self   = shift;
    my $target = shift;
    if (ref($target) eq 'Acme::Monkey') {
        $target->_happiness(+1);
    }
    else {
        die "Target is not a monkey!\n";
    }
}

sub dump {
    my $self = shift;
    use Data::Dumper;
    print Dumper($self);
    return;
}

=head2 see

Allows the monkey to see a function. See do

sub shoot {
    print "Bang!\n";
}
$monkey = Acme::Monkey->new();
$monkey->see(\&shoot);
$monkey->do();
$monkey->do();

=cut

sub see {
    my $self = shift;
    my $sub  = shift;
    $self->{sub} = $sub;
}

=head2 do

Does what the monkey see()s

=cut

sub do {
    my $self = shift;
    return $self->{sub}->() if defined $self->{sub};
}


sub _hologram {
    print '  _   ######   _'."\n";
    print ' / \ #(*)(*)# / \\'."\n";
    print ' | {<#/ {} \#>} |'."\n";          
    print ' \_/#|      |#\_/'."\n";
    print '    #\======/#'."\n";
    print '     ########'."\n";          
    print '       ####'."\n";
}

=head2 swing

    $monkey->swing("/bin"); # Well, it sounds like vine. :)

    $monkey->swing(qw(/bin /var));

Monkey seeks out bananas in given directory trees.

=cut

sub swing {
    my $self            = shift;
    my @directory_trees = @_;

    our @bunch_o_nanas;

    $self->_hologram();
    print "\nSearching for bananas...\n\n";
    find(\&while_im_swinging_in, @directory_trees);

    # Bananas call back. Bananas find Monkey...
    sub while_im_swinging_in {
        if ($File::Find::name =~ m/.*banana.*/i) {
            push @bunch_o_nanas, $File::Find::dir.$File::Find::name;
        }
    }

    # Report on my swinging
    if (@bunch_o_nanas) {
        print "NO, we found bananas at...\n";
        print join("\n", @bunch_o_nanas);
        print "\n";
    }
    else {
        print "YES, we have no bananas.\n";
        print "How about dropping some!\n";
    }    
}

=head2 fling

A verb.

    $monkey->fling();

=cut

sub fling {
    my $fling_buffer = Acme::Monkey::FrameBuffer->new(W => 40, H => 10);

    system($CLEAR_COMMAND);
    for my $seq(@{$Acme::Monkey::FlingFrames::sequence}) {
        system($CLEAR_COMMAND);
        $fling_buffer->clear();
        $fling_buffer->put(@{$Acme::Monkey::FlingFrames::frames}[$seq], 2, 2);
        $fling_buffer->put([__PACKAGE__], 1, 1);
        $fling_buffer->draw();
        usleep(120000);
    }
}


use Exporter qw( import );
our @EXPORT = qw(grrrr bannana grubs wine beer vodka swing fling);

=head1 SUBROUTINES

Exporter is used to these on you.

  grrrr($stuff); # Like warn().
  bannana();     # For feeding.

=head2 CONSUMEABLES

  wine()      # For happy monkeys.
  grubs()     # Yummy.
  beer()     # Have anything stronger?