view release on metacpan or  search on metacpan

lib/Class/LOP.pm  view on Meta::CPAN

    after 'name' => sub {
        print "This code block runs after the original!\n";
    };

Wow, that all looks familiar.. but we wrote it all in a fairly small amount of code. Class::LOP takes care of the 
dirty work for you, so you can just worry about getting the features in your module that you want.

=cut

use warnings;
use strict;
use mro;

our $VERSION = '0.003';

sub new {
    my ($self, $class) = @_;
    if (!$class) {
        warn "No class specified";
        return 0;
    }

    {
        no strict 'refs';
        if (! scalar %{ "${class}::" }) {
            *{"${class}::new"} = sub {
                return bless {}, $class;
            };
        }
    }

    return bless {
        _name => $class,
        _attributes => [],
    },
    __PACKAGE__;
}

sub init {
    my ($self, $class) = @_;
    if (!$class) {
        warn "No class specified";
        return 0;
    }

    return bless {
        _name => $class,
    },
    __PACKAGE__;
}

sub name {
    my $self = shift;
    return $self->{_name};
}

sub warnings_strict {
    my $self = shift;
    warnings->import();
    strict->import();
    return $self;
}

sub getscope {
    my ($self) = @_;
    return scalar caller(1);
}

sub class_exists {
    my ($self, $class) = @_;
    $class = $self->{_name} if !$class;
    {
        no strict 'refs';
        return scalar %{ "${class}::" };
    }
}

sub list_methods {
    my $self = shift;
    my $class = $self->{_name};
    my @methods = ();
    {
        no strict 'refs';
        foreach my $method (keys %{"${class}::"}) {
            push @methods, $method
                if substr($method, -2, 2) ne '::';
        }
    }

    return @methods;
}

sub method_exists {
    my ($self, $class, $method) = @_;
    if (!$method) {
        $method = $class;
        $class = $self->{_name};
    }
    return $class->can($method);
}

sub subclasses {
    my $self = shift;
    my @list = ();
    my $class = $self->{_name};
    @list = @{ $class->mro::get_isarev() };

    return scalar(@list) > 0 ? @list : 0;
}

sub superclasses {
    my $self = shift;
    my $class = $self->{_name};
    {
        no strict 'refs';
        return @{ "${class}::ISA" };
    }
}

sub import_methods {