Attribute::Final - Provides Java-style finalized methods


Attribute-Final documentation Contained in the Attribute-Final distribution.

Index


Code Index:

NAME

Top

Attribute::Final - Provides Java-style finalized methods

SYNOPSIS

Top

    use Attribute::Final;

    package Beverage::Hot; 
    sub serve :final { ... } 

    package Tea; 
    use base 'Beverage::Hot'; 

    sub Tea::serve { # Compile-time error. 
    } 

DESCRIPTION

Top

Final methods are methods which cannot be overriden in derived classes. This module will allow you to mark some methods as :final; prior to running the script, Perl will check that no packages which derive from classes with marked methods override those methods.

AUTHOR

Top

Originally by Simon Cozens, simon@cpan.org

Maintained by Scott Penrose, scott@cpan.org

SEE ALSO

Top

java.


Attribute-Final documentation Contained in the Attribute-Final distribution.

package Attribute::Final;
use 5.006;
use strict;
use warnings;
our $VERSION = '1.3';
our %marked;
my @all_packages;
use B qw(svref_2object);

sub fill_packages {
    no strict 'refs';
    my $root = shift;
    my @subs = grep s/::$//, keys %{$root."::"}; 
    push @all_packages, $root;
    for (@subs) {
        next if $root eq "main" and $_ eq "main"; # Loop
        fill_packages($root."::".$_);
    }
}

sub check {
    no strict 'refs';
    fill_packages("main") unless @all_packages;
    for my $derived_pack (@all_packages) {
        next unless @{$derived_pack."::ISA"};
        for my $marked_pack (keys %marked) {
            next unless $derived_pack->isa($marked_pack);
            for my $meth (@{$marked{$marked_pack}}) {
                my $glob_ref = \*{$derived_pack."::".$meth};
                if (*{$glob_ref}{CODE}) {
                    my $name = $marked_pack."::".$meth;
                    my $b = svref_2object($glob_ref);
                    die "Cannot override final method $name at ".
                        $b->FILE. ", line ".$b->LINE."\n";
                }
            }
        }
    }
}

CHECK { Attribute::Final->check() }

package UNIVERSAL;
use Attribute::Handlers;
sub final :ATTR(CODE) {
    my ($pack, $ref) = @_;
    push @{$marked{$pack}}, *{$ref}{NAME};
}

# Preloaded methods go here.

1;
__END__
# Below is stub documentation for your module. You better edit it!