File Coverage

blib/lib/Acme/Meow.pm

Criterion	Covered	Total	%
statement	10	40	25.0
branch	0	16	0.0
condition	0	6	0.0
subroutine	4	10	40.0
pod	6	6	100.0
total	20	78	25.6

package Acme::Meow;

use warnings;
use strict;

require Exporter;
use base qw[ Exporter ];
=head1 NAME

Acme::Meow - It's the kitty you've always wanted

=head1 VERSION

Version 0.01 - please note this is a preview release, the API may change
$Id: Meow.pm 558 2007-09-07 12:14:11Z f00li5h $
=cut

our $VERSION = '0.01';
=head1 SYNOPSIS

This module is intended for use by folks who's leases
specify that they are not allowed to have any pets

    use Acme::Meow;

    my $kitty = Acme::Meow->new();
    $kitty->pet();
    $kitty->feed();


=head1 FUNCTIONS

=head2 new - kitty constructor

Currently only abstract kitties are available so no options are available,
although they may be added in the future.

This method will take a hashref of options as required.

=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 {

    my($kitty) =@_;
    return 'zZzZ' if $kitty->is_sleeping();
    $kitty->{'<3'} > 5 ? '=-_-=' : '=^_^=';

}

=head1 AUTHOR

FOOLISH, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to
C, or through the web interface at
L.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 TODO

=over 4

=item play

it'd be nince to play games with the kitty too

    $kitty->play( 'game' );

=back

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Acme::Meow

You can also look for information at:

=over 4

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * RT: CPAN's request tracker

L

=item * Search CPAN

L

=back

=head1 ACKNOWLEDGEMENTS

=head1 COPYRIGHT & LICENSE

Copyright 2007 FOOLISH, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1; # End of Acme::Meow