view release on metacpan or  search on metacpan

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

=cut 

sub new {
    bless{},shift
}

=head1 METHODS

=head2 pet - pet the kitty

=cut

our @snacks = qw[ milk nip ];

sub pet {
    my($kitty) =@_;

    my @reactions = qw[ purr nuzzle meow ];

    $kitty->{'<3'} ++;
    $kitty->{'favs'} = {
        snack => @snacks[ rand @snacks ]
    };

    print $kitty->_kitty_status,
          $reactions[ rand @reactions ], $kitty->{'<3'} > 15 ? '<3' : '' 
     

}


=head2 feed - give the kitty a snack

the kitty does need to eat, otherwise it will get unhealthy

=cut

sub feed {

    my($kitty) =@_;

    my @reactions = ( 'crunch', 'lap lap', '');

    if (!$kitty->is_sleeping()){
        $kitty->{'^_^'} ++; 
        $kitty->{'<3' } += 0.5;
    }
    else {
        $kitty->{'^_^'} -= 0.5; 
        $kitty->{'<3' } += 0.25;
    }

    print $kitty->_kitty_status,
        $reactions[ rand @reactions ];

}

=head1 EXPORTS

by default this package exports some methods for playing with your 
kitties.

=head2 milk - give milk to a kitty.

if not called directly on a kitty, $_ will be checked for a kitty;

=cut

our @EXPORT    = qw(&milk &nip);   # afunc is a function
# @EXPORT_OK = qw(&%hash *typeglob); # explicit prefix on &bfunc

sub milk {
    my $kitty;

    if(not @_ and ref $_ eq __PACKAGE__){
        $kitty = $_
    }
    if( @_ ){ $kitty = shift }

    $kitty->feed( 'milk' );
}

=head2 nip - give nip to a kitty.

if not called directly on a kitty, $_ will be checked for a kitty;

=cut
sub nip {

    my $kitty;

    if(not @_ and ref $_ eq __PACKAGE__){
        $kitty = $_
    }
    if( @_ ){ $kitty = shift }

    $kitty->feed( 'nip' );

}


=head2 is_sleeping

This method will tell you if your kitty is having a cat nap.
Kittens may be very cranky during their nap time, and waking them may be a bad
idea.

=cut
sub is_sleeping {

    my($kitty) =@_;
    0; #TODO: our kitties are currently insomniacs
}

=head2 _kitty_status

private 

=cut
sub _kitty_status {