sub to_string {

    die "This method must be overridden by a subclass of __PACKAGE__";

}

##</code><code>##

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 (subclass)

            # 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;

##</code><code>##

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;

##</code><code>##

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;

##</code><code>##

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;

##</code><code>##

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";

##</code><code>##

Atila says "bark bark!"
Donald says ...
Abstract method 'get_sound' of Animal was not overrided by Animal::Duck
Abstract method 'get_color' of Animal was not overrided by Animal::Dog