Created
October 30, 2014 19:35
-
-
Save msouth/dcd00556b5a8dd7fb2a6 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
use strict; | |
######################################### | |
############# would be in Animal.pm normally | |
######################################### | |
package Animal; | |
sub new { | |
my $package = shift; | |
# this 'bless' call tells that anonymous hash "if someone calls ->foo on you, look in $package for a sub named 'foo', | |
# and call it, with yourself as the first argument" | |
bless {age=>0,}, $package; | |
} | |
sub speak { | |
print "'Primal Grunt'\n"; | |
} | |
sub shed { | |
print "* some fur drops to the ground *\n"; | |
} | |
# common idiom for a getter/setter. "get" the value with $obj->age(); "set" the value with $obj->age($value); | |
sub age { | |
my $self = shift; | |
if (@_) { | |
$self->{age} = shift; | |
} | |
return $self->{age}; | |
} | |
sub have_birthday { | |
my $self = shift; | |
$self->age( $self->age() + 1 ); | |
} | |
######################################### | |
######################################### | |
############# would be in Dog.pm normally | |
######################################### | |
package Dog; | |
use base qw/Animal/; | |
sub speak { | |
print "'Woof'\n"; | |
} | |
######################################### | |
######################################### | |
############# would be in Snake.pm normally | |
######################################### | |
package Snake; | |
use base qw/Animal/; | |
sub speak { | |
print "'Hissssss'\n"; | |
} | |
sub shed { | |
print "* A dried, empty shell of a snakeskin is left ominously on your porch *\n"; | |
} | |
######################################### | |
######################################### | |
############ would be in FireDog.pm normally | |
######################################### | |
package FireDog; | |
use base qw/Dog/; | |
sub shed { | |
my $self = shift; | |
# the SUPER 'package' means "look in my inheritance hierarchy for something called [in this case] 'shed', and call it, (with me as the | |
# first argument) | |
$self->SUPER::shed; | |
print "* ...and then spontaneously combusts *\n"; | |
} | |
######################################### | |
######################################### | |
############ would just be the start of the file, normally, 'package main' would be implied in that case | |
######################################### | |
package main; | |
# 'Bareword->new' looks for a package called "Bareword", and calls that package's "new()" subroutine, with 'Bareword' as the first argument | |
my $generic = Animal->new(); | |
print "*******\n$generic\n\n"; | |
$generic->speak; | |
$generic->shed; | |
print "The generic animal is ". $generic->age(). " years old.\n"; | |
$generic->have_birthday; | |
print "Haivng had a birthday, the generic animal is ". $generic->age(). " year(s) old.\n"; | |
# This will call the Dog package's new() subroutine--but it doesn't have one, so it goes up to its "base" of Animal, | |
# and call's Animal's new(), but with 'Dog' as the first argument. | |
my $dog = Dog->new(); | |
print "*******\n$dog\n\n"; | |
$dog->speak; | |
$dog->shed; | |
my $snake = Snake->new(); | |
print "*******\n$snake\n\n"; | |
$snake->speak; | |
$snake->shed; | |
my $fire_dog = FireDog->new(); | |
print "*******\n$fire_dog\n\n"; | |
$fire_dog->speak; | |
$fire_dog->shed; | |
Author
msouth
commented
Oct 30, 2014
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment