glasswalk3r has asked for the wisdom of the Perl Monks concerning the following question:
Greetings,
When I started learning OOP for Perl, I got some advices about what to do with abstract methods defined in superclasses. The suggestion usually goes like this:
sub to_string { die "This method must be overridden by a subclass of __PACKAGE__"; }
While this works fine, it feels unpleasant to repeat such code everytime I create a superclass with abstract methods. The module Attribute::Abstract helped with that (thanks Dan!).
Although laziness issue is fixed, now I think it would be better if the code could advice the programmer that he/she forgot to override some method that, for any reason, was not invoked during program execution. Later, of course, this error would popup. In a perfect world, unit testing would catch up this bug, but sometimes people just don't test the program enough.
I decided then to start extending the Attribute::Abstract to be able to, optionally, generate warning messages regarding methods that were not overrided by a subclass. The code will write warning messages thru DESTROY method implemented in the superclass, so this allows the use of code generators like Class::Accessor.
That said, I would like to receive some feedback from you monks about how do you address this kind of issue and regarding the code that I wrote as a solution (it follows next). I'm not sure if this code will work with multiple inheritance either.
Modified version of Attribute::Abstract:
package Attribute::Abstract; use warnings; use strict; use Attribute::Handlers; our $VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)/g; sub UNIVERSAL::Abstract : ATTR(CODE) { my ( $pkg, $symbol ) = @_; no strict 'refs'; my $sub = $pkg . '::' . *{$symbol}{NAME}; *{$sub} = sub { my ( $file, $line ) = (caller)[ 1, 2 ]; die "call to abstract method $sub at $file line $line.\n"; }; # creates a symbol table in the caller package to hold an array # with the abstract methods that it has my $abstract_methods = $pkg . '::abstract_methods'; # array ref my $abstract_ref = *{$abstract_methods}{ARRAY}; #checking if the array holding the abstract methods already exists if ( defined($abstract_ref) and ( @{$abstract_ref} ) ) { push( @{$abstract_ref}, *{$symbol}{NAME} ); } else { @{$abstract_methods} = ( *{$symbol}{NAME} ); } my $destroy_sub = $pkg . '::DESTROY'; # no need to redefine everytime the DESTROY sub unless ( defined( *{$destroy_sub}{CODE} ) ) { *{$destroy_sub} = sub { use strict; my $self = shift; my $class_name = ref($self); no strict 'refs'; # alias to check if the method exists in the package (subc +lass) # hash reference my $subclass_ref = *{ $class_name . '::' }{HASH}; # fetch the array with the abstract methods from the superclass # assuming that __PACKAGE__ holds de value of the superclass that uses + Attribute::Abstract method # array reference my $abstract_ref = *{ $pkg . '::abstract_methods' }{ARRAY} +; foreach my $method ( @{$abstract_ref} ) { print STDERR "Abstract method '$method' of $pkg was not overrided by $class_name\n" unless ( exists( $subclass_ref->{$method} ) ); } } } } #"Rosebud"; # for MARCEL's sake, not 1 -- dankogai 1;
Animal superclass:
package Animal; use Attribute::Abstract; use strict; use warnings; sub new { my $class = shift; # hash reference my $self = shift; bless $self, $class; return $self; } sub get_sound : Abstract; sub get_color : Abstract; 1;
Animal::Dog subclass:
package Animal::Dog; use base qw(Animal Class::Accessor); __PACKAGE__->follow_best_practice(); __PACKAGE__->mk_accessors(sound); __PACKAGE__->mk_ro_accessors(name); sub new { my $class = shift; my $self = $class->SUPER::new(@_); $self->{sound} = '"bark bark!"'; return $self; } 1;
Animal::Duck subclass:
package Animal::Duck; use base qw(Animal Class::Accessor); __PACKAGE__->follow_best_practice(); __PACKAGE__->mk_ro_accessors(qw(name color)); sub new { my $class = shift; my $self = $class->SUPER::new(@_); $self->{sound} = '"quack quack!"'; $self->{color} = 'I am white damn it!'; return $self; } 1;
Finally the proof of concept:
use strict; use warnings; use Animal::Dog; use Animal::Duck; my $dog = Animal::Dog->new( { name => 'Atila' } ); my $duck = Animal::Duck->new( { name => 'Donald' } ); print $dog->get_name(), ' says ', $dog->get_sound(), "\n"; print $duck->get_name(), ' says ...', "\n";
Executing it...
Atila says "bark bark!" Donald says ... Abstract method 'get_sound' of Animal was not overrided by Animal::Duc +k Abstract method 'get_color' of Animal was not overrided by Animal::Dog
Hints? Implementation suggestions? Thank you all.
Regards,
|
|---|