view release on metacpan or  search on metacpan

lib/Anansi/Library.pm  view on Meta::CPAN

        $self->libraryExample();
        $self->LibraryExample::libraryExample();
    }

    1;

=head1 DESCRIPTION

This is a base module definition that manages the functionality extension of
module object instances.

=cut


our $VERSION = '0.03';

my $LIBRARY = {};


=head1 METHODS

=cut


=head2 abstractClosure

    my $CLOSURE = Anansi::Library->abstractClosure(
        'Some::Namespace',
        'someKey' => 'some data',
        'anotherKey' => 'Subroutine::Namespace',
        'yetAnotherKey' => Namespace::someSubroutine,
    );
    $CLOSURE->anotherKey();
    $CLOSURE->yetAnotherKey();

    sub Subroutine::Namespace {
        my ($self, $closure, %parameters) = @_;
        my $abc = ${$closure}{abc} || 'something';
        ${$closure}{def} = 'anything';
    }

=over 4

=item class I<(Blessed Hash B<or> String, Required)>

Either an object of this namespace or this module's namespace.

=item abstract I<(String, Required)>

The namespace to associate with the closure's encapsulating object.

=item parameters I<(Hash, Optional)>

Named parameters where either the key is the name of a variable stored within
the closure and the value is it's data or when the value is a subroutine the key
is the name of a generated method of the closure's encapsulating object that
runs the subroutine and passes it a reference to the closure.

=back

Creates both an anonymous hash to act as a closure variable and a blessed object
as the closure's encapsulating accessor.  Supplied data is either stored within
the closure using the key as the name or in the case of a subroutine, accessed
by an auto-generated method of that name.  Closure is achieved by passing a
reference to the anonymous hash to the supplied subroutines via the
auto-generated methods.

=cut


sub abstractClosure {
    my ($class, $abstract, %parameters) = @_;
    return if(ref($abstract) !~ /^$/);
    return if($abstract !~ /[a-zA-Z]+[a-zA-Z0-9_]*(::[a-zA-Z]+[a-zA-Z0-9_]*)+$/);
    my $ABSTRACT = {
        NAMESPACE => $abstract,
    };
    my $CLOSURE = {
    };
    foreach my $key (keys(%parameters)) {
        next if(ref($key) !~ /^$/);
        next if($key !~ /^[a-zA-Z_]*[a-zA-Z0-9_]+$/);
        next if('NAMESPACE' eq $key);
        if(ref($parameters{$key}) =~ /^CODE$/i) {
            *{$abstract.'::'.$key} = sub {
                my ($self, @PARAMETERS) = @_;
                return &{$parameters{$key}}($self, $CLOSURE, (@PARAMETERS));
            };
        } elsif(ref($parameters{$key}) !~ /^$/i) {
            ${$CLOSURE}{$key} = $parameters{$key};
        } elsif($parameters{$key} =~ /^[a-zA-Z]+[a-zA-Z0-9_]*(::[a-zA-Z]+[a-zA-Z0-9_]*)+$/) {
            if(exists(&{$parameters{$key}})) {
                *{$abstract.'::'.$key} = sub {
                    my ($self, @PARAMETERS) = @_;
                    return &{\&{$parameters{$key}}}($self, $CLOSURE, (@PARAMETERS));
                };
            } else {
                ${$CLOSURE}{$key} = $parameters{$key}
            }
        } else {
            ${$CLOSURE}{$key} = $parameters{$key};
        }
    }
    return bless($ABSTRACT, $abstract);
}


=head2 abstractObject

    my $OBJECT = Anansi::Library->abstractObject(
        'Some::Namespace',
        'someKey' => 'some data',
        'anotherKey' => 'Subroutine::Namespace',
        'yetAnotherKey' => Namespace::someSubroutine,
    );
    $OBJECT->anotherKey();
    $OBJECT->yetAnotherKey();

    sub Subroutine::Namespace {
        my ($self, %parameters) = @_;
        my $abc = $self->{abc} || 'something';
        $self->{def} = 'anything';
    }

=over 4

=item class I<(Blessed Hash B<or> String, Required)>

Either an object of this namespace or this module's namespace.

=item abstract I<(String, Required)>

The namespace to associate with the object.

=item parameters I<(Hash, Required)>

Named parameters where either the key is the name of a variable stored within
the object and the value is it's data or when the value is a subroutine the key
is the name of a namespace method.

=back

Creates a blessed object.  Supplied data is either stored within the object or
in the case of a subroutine as a namespace method of that name.

=cut


sub abstractObject {
    my ($class, $abstract, %parameters) = @_;
    return if(ref($abstract) !~ /^$/);
    return if($abstract !~ /[a-zA-Z]+[a-zA-Z0-9_]*(::[a-zA-Z]+[a-zA-Z0-9_]*)+$/);
    my $ABSTRACT = {
        NAMESPACE => $abstract,
    };
    foreach my $key (keys(%parameters)) {
        next if(ref($key) !~ /^$/);
        next if($key !~ /^[a-zA-Z_]*[a-zA-Z0-9_]+$/);
        next if('NAMESPACE' eq $key);
        if(ref($parameters{$key}) =~ /^CODE$/i) {
            *{$abstract.'::'.$key} = $parameters{$key};
        } elsif(ref($parameters{$key}) !~ /^$/i) {
            $ABSTRACT->{$key} = $parameters{$key};
        } elsif($parameters{$key} =~ /^[a-zA-Z]+[a-zA-Z0-9_]*(::[a-zA-Z]+[a-zA-Z0-9_]*)+$/) {
            if(exists(&{$parameters{$key}})) {
                *{$abstract.'::'.$key} = *{$parameters{$key}};
            } else {
                $ABSTRACT->{$key} = $parameters{$key}
            }
        } else {
            $ABSTRACT->{$key} = $parameters{$key};
        }
    }
    return bless($ABSTRACT, $abstract);
}


=head2 hasAncestor

    my $MODULE_ARRAY = $OBJECT->hasAncestor();
    if(defined($MODULE_ARRAY));

    if(1 == $OBJECT->hasAncestor(
        'Some::Module',
        'Another::Module',
        'Etc'
    ));

=over 4

=item self I<(Blessed Hash, Required)>

An object of this namespace.

=item name I<(Array B<or> String, Optional)>

A namespace or an array of namespaces.

=back

Either returns an array of all the loaded modules that the object inherits from
or whether the object inherits from all of the specified loaded modules with a
B<1> I<(one)> for yes and B<0> I<(zero)> for no.

=cut


sub hasAncestor {
    return if(0 == scalar(@_));
    my $self = shift(@_);
    return if(ref($self) =~ /^(|ARRAY|CODE|FORMAT|GLOB|HASH|IO|LVALUE|REF|Regexp|SCALAR|VSTRING)$/i);
    my %modules;
    while(my ($name, $value) = each(%INC)) {
        next if($name !~ /\.pm$/);
        $name =~ s/\.pm//;
        $name =~ s/\//::/g if($name =~ /\//);
        next if(!$self->isa($name));
        next if($self eq $name);
        $modules{$name} = 1;
    }
    if(0 == scalar(@_)) {
        return [( keys(%modules) )] if(0 < scalar(keys(%modules)));
        return;
    }
    while(0 < scalar(@_)) {
        my $name = shift(@_);
        return 0 if(ref($name) !~ /^$/);
        return 0 if(!defined($modules{$name}));
    }
    return 1;
}


=head2 hasDescendant