Wikipedia had a decent example that got to the point:
So, here's some poop I through together just to use as my own reference. It's a Poop class!
(NOTE: Some of the lines may have been screwed up during the copying and pasting... but I don't care right now)
package Poop;
use strict;
our $VERSION = "1.0";
my $DEBUG = 0;
=head1 NAME
Poop - A pooping package.
=head1 SYNOPSIS
use Poop;
my $boy = Poop->new();
$boy->eat("Candy Bar", "Ice Cream");
$boy->poop() if $boy->turd();
=head1 DESCRIPTION
Just an OO Perl template
=head1 METHODS
=head3 new
my $cat = Poop->new();
my $dog = Poop->new(eat => @food, debug => 1, size => $size);
Instantiates a new Pooping object.
If a list of C<@food> is given, the object eats right away.
If $size is given, the object's stomach is set to that size (default 10).
If "debug" is a true value, debugging will be turned on.
=cut
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my %params = @_;
my $self = {};
bless ($self, $class);
$self->debug($params{debug}) if exists $params{debug};
$self->{TURD} = 0;
$self->{FOOD} = [];
$self->{SIZE} = exists $params{size} ? $params{size} : 10;
$self->eat(@{$params{eat}}) if exists $params{eat};
return $self;
}
=head3 eat
my $dog = Poop->new();
$dog->eat("Dog food", "Dog bone");
Causes the object to eat the items in the list. The object will quit eating when it has to poop.
Returns a list of food it couldn't eat if it can't eat it all.
Returns an empty list if it ate it all.
=cut
sub eat($) {
my $self = shift;
$self->_DEBUG_PRINT("Eating...");
while (@_ && ! $self->turd()) {
my $f = shift;
push @{$self->{FOOD}}, $f;
print "-- Mmmmm... $f\n";
}
return @_;
}
=head3 turd
my $dog = Poop->new();
$dog->poop() if $dog->turd();
Reports whether the object has a turd. And object with a turd cannot eat anything else.
=cut
sub turd() {
my $self = shift;
$self->_DEBUG_PRINT("Checking for turd...");
return 1 if @{$self->{FOOD}} >= $self->{SIZE};
return 0;
}
=head3 poop
my $dog = Poop->new();
$dog->poop() if $dog->turd();
Makes the object poop. If there is no turd, it will return 0 and not poop.
=cut
sub poop() {
my $self = shift;
my @sounds = ("Grunt","Plop","Spphhlll","Splash","Pfffft");
$self->_DEBUG_PRINT("Entering pooping phase...");
if (! $self->turd()) {
$self->_DEBUG_PRINT("No turd to poop with...");
return 0;
}
while (my $food = shift @{$self->{FOOD}}) {
my $sound= $sounds[int(rand() * @sounds)];
print "-- $sound... $food\n";
sleep 1;
}
$self->{TURD} = 0;
}
=head3 puke
my $dog->puke();
Expells the most recent item ate. Returns the item if it existed, otherwise returns undef.
=cut
sub puke() {
my $self = shift;
my $last = pop @{$self->{FOOD}};
if ($last) {
print "-- Blahhhhh..... $last\n";
return $last;
}
return undef;
}
=head3 debug
$dog->debug();
$dog->debug(0);
$dog->debug(1);
Returns the current debug setting, sets it to false, or sets it to true (respectively).
=cut
sub debug($) {
my $self = shift;
return $DEBUG unless @_;
if ($_[0]) { $DEBUG = 1 }
else { $DEBUG = 0 }
return $DEBUG;
}
sub _DEBUG_PRINT ($) {
my $self = shift;
return unless $DEBUG;
print "-- DEBUG: " . shift;
print "\n";
}
1; # Really only need this unless you make this a .pm and "use" it.
#
# Just putting it all in one file...
#
package main;
#use Poop;
sub feed(@) {
my $obj = shift;
print "Feeding it: " . join(", ", @_) . "\n";
my @full = $obj->eat(@_);
if (@full) {
print "Couldn't eat: " . join(", ", @_) . "\n";
} else {
print "Ate it all. Good boy!\n";
}
print "\n";
}
my $dog = Poop->new(size => 5);
feed($dog, qw/Bones Chocolate Cat Soap/);
feed($dog, "Saw Dust", "Dog Food");
print "Puked up " . $dog->puke() . "\n";
print "Puked up " . $dog->puke() . "\n";
feed($dog, "Pie", "Hot Dog");
print "Go potty, boy:\n";
$dog->poop();
print "Good boy, here's a treat!\n";
$dog->eat("Treat");
print "Nooo!!! Don't puke in here!!!\n";
print "Puked: " . $dog->puke() . "\n";
