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;