package dog; sub new { my $proto=shift; my $class=ref($proto)||$proto; my $self = { # I'll add attrs later... }; bless $self,$class; return $self; } 1; #### package dog::cocker; use dog; use vars qw/ @ISA /; @ISA=qw/dog/; sub new { my $proto=shift; my $class=ref($proto)||$proto; my $self = { habits => 'barks at strangers', size => 'small', temperment => 'very loyal' }; bless $self,$class; } 1; #### use dog::cocker; my $sasha=new dog::cocker; #### package dog; sub new { my $proto=shift; my $class=ref($proto)||$class; my $self={}; # We should be overriding this... my $breed=shift; # OK... so what kind of doggie are we? if ( $breed ) { # if not nill... $breed = "dog::" . $breed; eval " use $breed; " ; die $@ if $@; $self= new $breed; bless $self,$breed; } else { bless $self,$class; # kinda useless but we have to. return $self; } } sub bark { my $self=shift; print "Woof!\n"; } 1; #### use dog; my $sasha= new dog('cocker'); $sasha -> bark(); #### package dog::samoyed; use dog; use vars qw/ @ISA /; @ISA=qw/dog/; sub new { my $proto=shift; my $class=ref($proto) || $proto; my $self => { habits => 'generally ignores strangers', temperment => 'lazy', size => 'large' }; bless $self, $class; } 1; #### . . . my $frosty = new dog('samoyed'); . . . #### # after the "my $self" line we add: %def_attrs=( voice => "woof", color => "brown", likes_chilren => "yes" ); # # After the $self = new $breed; line we do: foreach my $key(keys %def_attrs){ $self->{$key} = $def_attrs{$key} if not $self->{key}; } #### package dog::cattle_dog; use dog; use vars qw /@ISA/; @ISA=qw/dog/; sub new { my $proto=shift; my $class=ref($proto)|| $proto; my $self = { temperment => 'fiercley loyal', habits => 'leary of strangers', size => 'medium', voice => 'shriek', loves_children => 'slathered in barbecue sauce' }; bless $self, $class; return $self; } sub wag_tail { # This is an override.. you'll see why later print "Tail raises over back!\n"; } 1; #### package dog; sub new { my $proto=shift; my $class=ref($proto)||$class; my $self={}; # We should be overriding this... my %def_attrs = ( color => "brown", loves_children => "yes", voice => "woof" ); my $breed=shift; # OK... so what kind of doggie are we? if ( $breed ) { # if not nill... $breed = "dog::" . $breed; eval " use $breed; " ; die $@ if $@; $self= new $breed; foreach my $key{keys %def_attrs){ $self->{$key} = $def_attrs{$key} if not $self->{$key}; } bless $self,$breed; } else { bless $self,$class; # kinda useless but we have to. return $self; } } sub bark { my $self=shift; print "Woof\n" if not $self->{voice}; printf "%s\n",$self->{voice} if $self->{voice}; } # # Late addition sub wag_tail { print "tail wagging\n"; } 1; #### use dog; use Data::Dumper; use strict; my $frosty = new dog('samoyed'); my $cosette= new dog('cattle_dog'); my $moose= new dog('cocker'); print Dumper($frosty,$cosette,$moose); $moose->bark; $moose->wag_tail; $cosette->bark; $cosette->wag_tail; $frosty->bark; $frosty->wag_tail; #### $VAR1 = bless( { 'voice' => 'yarf', 'color' => 'brown', 'habits' => 'does not even look at strangers', 'loves_children' => 'yes', 'temperment' => 'lazy', 'size' => 'large' }, 'dog::samoyed' ); $VAR2 = bless( { 'voice' => 'shreik', 'color' => 'brown', 'habits' => 'bites strangers', 'loves_children' => 'slathered in barbeque sauce', 'temperment' => 'fiercely loyal', 'size' => 'medium' }, 'dog::cattle_dog' ); $VAR3 = bless( { 'voice' => 'harf', 'color' => 'brown', 'habits' => 'bark at strangers', 'loves_children' => 'if well behaved', 'temperment' => 'loyal', 'size' => 'small' }, 'dog::cocker' ); harf butt wiggles shreik tail over back yarf tail wagging