view release on metacpan or  search on metacpan

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

package Anansi::Actor;


=head1 NAME

Anansi::Actor - A dynamic usage module definition

=head1 SYNOPSIS

    use Anansi::Actor;
    my $object = Anansi::Actor->new(
        PACKAGE => 'Anansi::Example',
    );
    $object->someSubroutine() if(defined($object));

    use Anansi::Actor;
    use Data::Dumper qw(Dumper);
    my %modules = Anansi::Actor->modules();
    if(defined($modules{DBI})) {
        Anansi::Actor->new(
            PACKAGE => 'DBI',
        );
        print Data::Dumper::Dumper(DBI->available_drivers());
    }

    use Anansi::Actor;
    use Data::Dumper qw(Dumper);
    if(1 == Anansi::Actor->modules(
        PACKAGE => 'DBI',
    )) {
        Anansi::Actor->new(
            PACKAGE => 'DBI',
        );
        print Data::Dumper::Dumper(DBI->available_drivers());
    }

=head1 DESCRIPTION

This is a dynamic usage module definition that manages the loading of a required
namespace and blessing of an object of the namespace as required.  Uses L<Fcntl>,
L<File::Find>, L<File::Spec::Functions> and L<FileHandle>.

=cut


our $VERSION = '0.15';

use base qw(Anansi::Singleton);

use Fcntl ':flock';
use File::Find;
use File::Spec::Functions;
use FileHandle;


my $ACTOR = Anansi::Actor->SUPER::new();


=head1 METHODS

=cut


=head2 Anansi::Class

See L<Anansi::Class|Anansi::Class> for details.  A parent module of L<Anansi::Singleton|Anansi::Singleton>.

=cut


=head3 DESTROY

See L<Anansi::Class::DESTROY|Anansi::Class/"DESTROY"> for details.  Overridden by L<Anansi::Singleton::DESTROY|Anansi::Singleton/"DESTROY">.

=cut


=head3 finalise

See L<Anansi::Class::finalise|Anansi::Class/"finalise"> for details.  A virtual method.

=cut


=head3 implicate

See L<Anansi::Class::implicate|Anansi::Class/"implicate"> for details.  A virtual method.

=cut


=head3 import

See L<Anansi::Class::import|Anansi::Class/"import"> for details.

=cut


=head3 initialise

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

                        next if($pod);
                        next if($_ !~ /^\s*package\s+[a-zA-Z0-9_:]+\s*;.*$/);
                        ($package = $_) =~ s/^\s*package\s+([a-zA-Z0-9_:]+)\s*;.*$/$1/;
                    }
                    close(FILE);
                    return if(!defined($package));
                    return if(defined(${$ACTOR->{MODULES}}{$package}));
                    ${$ACTOR->{MODULES}}{$package} = $path;
                },
                follow => 1,
                follow_skip => 2,
                no_chdir => 1,
            },
            @INC
        );
    }
    if(defined($filename)) {
        if(open(FILE_HANDLE, '<'.$filename)) {
            close(FILE_HANDLE);
        } else {
            my $content = join(',', @{[%{$ACTOR->{MODULES}}]});
            if(open(FILE_HANDLE, '+>'.$filename)) {
                FILE_HANDLE->autoflush(1);
                flock(FILE_HANDLE, LOCK_EX);
                print FILE_HANDLE $content;
                flock(FILE_HANDLE, LOCK_UN);
                close(FILE_HANDLE);
            }
        }
    }
    if(defined($parameters{PACKAGE})) {
        foreach my $package (@{$parameters{PACKAGE}}) {
            return 0 if(!defined(${$ACTOR->{MODULES}}{$package}));
        }
        return 1;
    }
    return %{$ACTOR->{MODULES}};
}


=head2 new

    my $object = Anansi::Actor->new(
        PACKAGE => 'Anansi::Example',
    );

=over 4

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

Either an object or a string of this namespace.

=item parameters I<(Hash)>

Named parameters.

=over 4

=item BLESS I<(String, Optional)>

The name of the subroutine within the namespace that creates a blessed object of
the namespace.  Defaults to I<"new">.

=item IMPORT I<(Array, Optional)>

An array of the names to import from the loading module.

=item PACKAGE I<(String, Required)>

The namespace of the module to load.

=item PARAMETERS I<(Array B<or> Hash, Optional)>

Either An array or a hash of the parameters to pass to the blessing subroutine.

=back

=back

Overrides I<(L<Anansi::Singleton::new|Anansi::Singleton/"new">)>.  Instantiates
an object instance of a dynamically loaded module.

=cut


sub new {
    my ($class, %parameters) = @_;
    return if(!defined($parameters{PACKAGE}));
    return if(ref($parameters{PACKAGE}) !~ /^$/);
    return if($parameters{PACKAGE} !~ /^[a-zA-Z]+[a-zA-Z0-9_]*(::[a-zA-Z]+[a-zA-Z0-9_]*)*$/);
    if(!defined($parameters{BLESS})) {
        $parameters{BLESS} = 'new';
    } else {
        return if(ref($parameters{BLESS}) !~ /^$/);
        return if($parameters{BLESS} !~ /^[a-zA-Z]+[a-zA-Z0-9_]*$/);
    }
    if(defined($parameters{PARAMETERS})) {
        $parameters{PARAMETERS} = [(%{$parameters{PARAMETERS}})] if(ref($parameters{PARAMETERS}) =~ /^HASH$/i);
        return if(ref($parameters{PARAMETERS}) !~ /^ARRAY$/i);
    }
    if(defined($parameters{IMPORT})) {
        return if(ref($parameters{IMPORT}) !~ /^ARRAY$/i);
        foreach my $import (@{$parameters{IMPORT}}) {
            return if(ref($import) !~ /^$/);
            return if($import !~ /^[a-zA-Z_]+[a-zA-Z0-9_]*$/);
        }
    }
    my $package = $parameters{PACKAGE};
    my $bless = $parameters{BLESS};
    my $self;
    eval {
        (my $file = $package) =~ s/::/\//g;
        require $file.'.pm';
        if(defined($parameters{IMPORT})) {
            $package->import(@{$parameters{IMPORT}});
        } else {
            $package->import();
        }
        if(defined($parameters{PARAMETERS})) {
            $self = $package->$bless(@{$parameters{PARAMETERS}});
        } else {
            $self = $package->$bless();
        }
        1;
    } or do {
        my $error = $@;
        return ;
    };
    return $self;
}


=head1 NOTES

This module is designed to make it simple, easy and quite fast to code your
design in perl.  If for any reason you feel that it doesn't achieve these goals
then please let me know.  I am here to help.  All constructive criticisms are
also welcomed.

=cut


=head1 AUTHOR

Kevin Treleaven <kevin I<AT> treleaven I<DOT> net>

=cut


1;