view release on metacpan or  search on metacpan

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

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    ] ;
#    }     #Then    finsh  for        more   stuff.
#    no strict 'refs';*{$class.'::monkey' }=\$self;
#    *{ $class . '::DESTROY' } = sub{$monkey->slap}
#    ;  return 'SUPERCALIFRAJULISTICEXPIALIDOTIOUS'
#}

sub bastardize {
    return 'SUPERCALIFRAJULISTICEXPIALIDOTIOUS'
}

=head2 slap

Poor monkey...

=cut

sub slap {
    grrrr('Ouch!');
    $_[0]->_happiness( -1 );
}

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 = @_;