Anansi-ObjectManager
view release on metacpan or search on metacpan
lib/Anansi/ObjectManager.pm view on Meta::CPAN
Either a previously registered object or an object's identifying registration
number or an object's unique ordinal number as stored internally by this module.
=back
Assigns an identifying number to a module object instance as required and either
returns the identifying number or the unique ordinal number of the module object
instance as stored internally by this module.
=cut
sub identification {
my ($self, $instance) = @_;
if(!defined($instance)) {
my ($second, $minute, $hour, $day, $month, $year) = localtime(time);
my $random;
my $identification;
do {
$random = int(rand(1000000));
$identification = sprintf("%4d%02d%02d%02d%02d%02d%06d", $year + 1900, $month, $day, $hour, $minute, $second, $random);
} while(defined($self->identification($identification)));
return $identification;
} elsif(ref($instance) =~ /^(CODE|FORMAT|GLOB|HASH|IO|LVALUE|REF|Regexp|SCALAR|VSTRING)$/i) {
} elsif(ref($instance) =~ /^$/) {
return if($instance =~ /^\s*$/);
return if(!defined($self->{IDENTIFICATIONS}));
return if(ref($self->{IDENTIFICATIONS}) !~ /^ARRAY$/i);
for(my $index = 0; $index < scalar(@{$self->{IDENTIFICATIONS}}); $index++) {
return $index if($instance == @{$self->{IDENTIFICATIONS}}[$index]);
}
return if($instance !~ /^\d+$/);
if(0 + $instance < scalar(@{$self->{IDENTIFICATIONS}})) {
return ${$self->{IDENTIFICATIONS}}[$instance];
}
} else {
return if(!defined($instance->{Anansi}));
return if(ref($instance->{Anansi}) !~ /^HASH$/i);
return if(!defined(${$instance->{Anansi}}{ObjectManager}));
return if(ref(${$instance->{Anansi}}{ObjectManager}) !~ /^HASH$/i);
return if(!defined(${${$instance->{Anansi}}{ObjectManager}}{IDENTIFICATION}));
return if(ref(${${$instance->{Anansi}}{ObjectManager}}{IDENTIFICATION}) !~ /^$/);
return if(${${$instance->{Anansi}}{ObjectManager}}{IDENTIFICATION} !~ /^\d+$/);
for(my $index = 0; $index < scalar(@{$self->{IDENTIFICATIONS}}); $index++) {
return $index if(${${$instance->{Anansi}}{ObjectManager}}{IDENTIFICATION} == @{$self->{IDENTIFICATIONS}}[$index]);
}
}
return;
}
=head2 initialise
package Some::Example;
use base qw(Anansi::ObjectManager);
sub initialise {
my ($self, %parameters) = @_;
$self->SUPER::initialise(%parameters);
}
1;
=over 4
=item self I<(Blessed Hash, Required)>
An object of this namespace.
=item parameters I<(Hash, Optional)>
Named parameters.
=back
Performs after creation actions on the first instance object of this module that
is created.
=cut
sub initialise {
my ($self, %parameters) = @_;
$self->{IDENTIFICATION} = $self->identification();
$self->{IDENTIFICATIONS} = [
$self->{IDENTIFICATION}
];
}
=head2 new
my $objectManager = Anansi::ObjectManager->new();
=over 4
=item class I<(Blessed Hash B<or> String, Required)>
Either an object of this namespace or this module's namespace.
=item parameters I<(Hash, Optional)>
Named parameters.
=back
Instantiates an object instance of this module, ensuring that the object
instance can be interpreted by this module. This object is a singleton so only
one object will ever be created at any one time by a Perl script. Subsequent
uses of this subroutine will return the existing object.
=cut
sub new {
my ($class, %parameters) = @_;
return if(ref($class) =~ /^(ARRAY|CODE|FORMAT|GLOB|HASH|IO|LVALUE|REF|Regexp|SCALAR|VSTRING)$/i);
$class = ref($class) if(ref($class) !~ /^$/);
if(!defined($NAMESPACE)) {
lib/Anansi/ObjectManager.pm view on Meta::CPAN
}
}
} else {
next if(!defined($uses->{Anansi}));
next if(ref($uses->{Anansi}) !~ /^HASH$/i);
next if(!defined(${$uses->{Anansi}}{ObjectManager}));
next if(ref(${$uses->{Anansi}}{ObjectManager}) !~ /^HASH$/i);
next if(!defined(${${$uses->{Anansi}}{ObjectManager}}{IDENTIFICATION}));
my $usesIndex = $self->identification(${${$uses->{Anansi}}{ObjectManager}}{IDENTIFICATION});
next if(!defined($usesIndex));
next if(!defined($self->{'INSTANCE_'.$usesIndex}));
if(defined($self->{'INSTANCE_'.$usesIndex}->{'USER_'.$userIndex})) {
if(!defined($self->{'INSTANCE_'.$usesIndex}->{PACKAGE})) {
$self->unregister($self->{'INSTANCE_'.$usesIndex});
} elsif(ref($self->{'INSTANCE_'.$usesIndex}->{PACKAGE}) !~ /^$/) {
$self->unregister($self->{'INSTANCE_'.$usesIndex});
} elsif($self->{'INSTANCE_'.$usesIndex}->{PACKAGE} !~ /^Anansi::.*$/) {
$self->unregister($self->{'INSTANCE_'.$usesIndex});
}
$self->{'INSTANCE_'.$usesIndex}->DESTROY();
if(defined($self->{'INSTANCE_'.$usesIndex})) {
delete $self->{'INSTANCE_'.$usesIndex}->{'USER_'.$userIndex} if(defined($self->{'INSTANCE_'.$usesIndex}->{'USER_'.$userIndex}));
}
}
}
}
} else {
my $uses = $parameters{USES};
return if(!defined($uses->{Anansi}));
return if(ref($uses->{Anansi}) !~ /^HASH$/i);
return if(!defined(${$uses->{Anansi}}{ObjectManager}));
return if(ref(${$uses->{Anansi}}{ObjectManager}) !~ /^HASH$/i);
return if(!defined(${${$uses->{Anansi}}{ObjectManager}}{IDENTIFICATION}));
my $usesIndex = $self->identification(${${$uses->{Anansi}}{ObjectManager}}{IDENTIFICATION});
return if(!defined($usesIndex));
if(defined($self->{'INSTANCE_'.$usesIndex}->{'USER_'.$userIndex})) {
if(!defined($self->{'INSTANCE_'.$usesIndex}->{PACKAGE})) {
$self->unregister($self->{'INSTANCE_'.$usesIndex});
} elsif(ref($self->{'INSTANCE_'.$usesIndex}->{PACKAGE}) !~ /^$/) {
$self->unregister($self->{'INSTANCE_'.$usesIndex});
} elsif($self->{'INSTANCE_'.$usesIndex}->{PACKAGE} !~ /^Anansi::.*$/) {
$self->unregister($self->{'INSTANCE_'.$usesIndex});
}
$self->{'INSTANCE_'.$usesIndex}->DESTROY();
if(defined($self->{'INSTANCE_'.$usesIndex})) {
delete $self->{'INSTANCE_'.$usesIndex}->{'USER_'.$userIndex} if(defined($self->{'INSTANCE_'.$usesIndex}->{'USER_'.$userIndex}));
}
}
}
}
=head2 old
package Some::Example;
use base qw(Anansi::ObjectManager);
sub old {
my ($self, %parameters) = @_;
$self->SUPER::old(%parameters);
}
1;
=over 4
=item self I<(Blessed Hash, Required)>
An object of this namespace.
=item parameters I<(Hash, Optional)>
Named parameters.
=back
Performs module object instance clean-up actions.
=cut
sub old {
my ($self, %parameters) = @_;
$self->finalise(%parameters);
}
=head2 register
my $someObject = Some::Example->new();
my $objectManager = Anansi::ObjectManager->new();
$objectManager->register($someObject);
=over 4
=item self I<(Blessed Hash, Required)>
An object of this namespace.
=item instance I<(Blessed Hash, Required)>
The object to register with this module.
=back
Ties as required an object instance to this module and increments an internal
counter as to how many times the object instance has been tied. This ensure
that the perl garbage collection does not remove the object instance from memory
until either the object instance is untied or this module has terminated.
=cut
sub register {
my ($self, $instance) = @_;
return 0 if(!defined($instance));
return 0 if(ref($instance) =~ /^(|ARRAY|CODE|FORMAT|GLOB|HASH|IO|LVALUE|REF|Regexp|SCALAR|VSTRING)$/i);
if(!defined($instance->{Anansi})) {
$instance->{Anansi} = {};
} elsif(ref($instance->{Anansi}) !~ /^HASH$/i) {
lib/Anansi/ObjectManager.pm view on Meta::CPAN
push(@{$self->{IDENTIFICATIONS}}, ${${$instance->{Anansi}}{ObjectManager}}{IDENTIFICATION});
}
my $instanceIndex = $self->identification($instance);
return 0 if(!defined($instanceIndex));
${${$instance->{Anansi}}{ObjectManager}}{REGISTERED} = 0 if(!defined(${${$instance->{Anansi}}{ObjectManager}}{REGISTERED}));
${${$instance->{Anansi}}{ObjectManager}}{REGISTERED}++;
$self->{'INSTANCE_'.$instanceIndex} = $instance if(!defined($self->{'INSTANCE_'.$instanceIndex}));
return 1;
}
=head2 registrations
my $someObject = Some::Example->new();
my $objectManager = Anansi::ObjectManager->new();
$objectManager->register($someObject);
if(0 < $objectManager->registrations($someObject));
=over 4
=item self I<(Blessed Hash, Required)>
An object of this namespace.
=item instance I<(Blessed Hash, Required)>
The object that has previously been registered with this module.
=back
Determines the number of times an object instance has been tied to this module.
If no previous registrations exist then B<0> I<(zero)> will be returned.
=cut
sub registrations {
my ($self, $instance) = @_;
return 0 if(!defined($instance));
return 0 if(ref($instance) =~ /^(|ARRAY|CODE|FORMAT|GLOB|HASH|IO|LVALUE|REF|Regexp|SCALAR|VSTRING)$/i);
return 0 if(!defined($instance->{Anansi}));
return 0 if(ref($instance->{Anansi}) !~ /^HASH$/i);
return 0 if(!defined(${$instance->{Anansi}}{ObjectManager}));
return 0 if(ref(${$instance->{Anansi}}{ObjectManager}) !~ /^HASH$/i);
return 0 if(!defined(${${$instance->{Anansi}}{ObjectManager}}{IDENTIFICATION}));
return 0 if(ref(${${$instance->{Anansi}}{ObjectManager}}{IDENTIFICATION}) !~ /^$/);
return 0 if(${${$instance->{Anansi}}{ObjectManager}}{IDENTIFICATION} !~ /^\d+$/);
return 0 if(!defined(${${$instance->{Anansi}}{ObjectManager}}{REGISTERED}));
return ${${$instance->{Anansi}}{ObjectManager}}{REGISTERED};
}
=head2 reinitialise
package Some::Example;
use base qw(Anansi::ObjectManager);
sub reinitialise {
my ($self, %parameters) = @_;
$self->SUPER::reinitialise(%parameters);
}
1;
=over 4
=item self I<(Blessed Hash, Required)>
An object of this namespace.
=item parameters I<(Hash, Optional)>
Named parameters.
=back
Performs additional after creation actions on subsequent instance objects of
this module that are created.
=cut
sub reinitialise {
my ($self, %parameters) = @_;
}
=head2 unregister
my $someObject = Some::Example->new();
my $objectManager = Anansi::ObjectManager->new();
$objectManager->register($someObject);
my $objectManager = Anansi::ObjectManager->new();
$objectManager->unregister($someObject);
=over 4
=item self I<(Blessed Hash, Required)>
An object of this namespace.
=item instance I<(Blessed Hash, Required)>
The object that has previously been registered with this module.
=back
Reduce the number of times an object instance has been tied to this module and
remove the tie that inhibits the perl garbage collection from removing the
object instance from memory if the object instance is no longer tied.
=cut
sub unregister {
my ($self, $instance) = @_;
return 1 if(!defined($instance));
return 1 if(ref($instance) =~ /^(|ARRAY|CODE|FORMAT|GLOB|HASH|IO|LVALUE|REF|Regexp|SCALAR|VSTRING)$/i);
return 1 if(!defined($instance->{Anansi}));
return 1 if(ref($instance->{Anansi}) !~ /^HASH$/i);
( run in 1.311 second using v1.01-cache-2.11-cpan-0bb4e1dffa6 )