File Coverage

blib/lib/OOP.pm

Criterion	Covered	Total	%
statement	16	37	43.2
branch	0	6	0.0
condition			n/a
subroutine	5	6	83.3
pod	0	1	0.0
total	21	50	42.0

package OOP;

use OOP::Constructor;
use OOP::Accessor;
@ISA = qw(OOP::Constructor OOP::Accessor);

use strict;

#***************************************************************************
############################################################################
#*[OOP]*********************************************************************
#
# Author  : Milan Adamovsky
# Date    : 01/14/2008
# Updated : 04/03/2008
#
# Version : 1.01
#
# Copyright 2007-Present Milan Adamovsky.  All rights reserved.
# It may be used and modified freely, but I do request that this copyright
# notice remain attached to the file.  You may modify this module  as  you
# wish,  but if you redistribute a modified version,  please attach a note
# listing the modifications you have made.
#
# Purpose : This class (module) provides a developer with various methods
#           that enforce uniform OOP conventions and ensure sound OOP
#           development in PERL.
#
# Usage   : For a full detailed usage of this class,  please refer to the
#           POD found attached below.  To read it simply type the command
#           'perldoc OOP' at the command-prompt or simply scroll down.
#
# History : 04/03/2008 - Version 1.01
#           Fixed logic that if a dataType is a hash with a writeAccess
#           of '1', that any elements not specified in the value can be
#           added dynamically and do not have to be explicitly specified.
#           Added missing EXISTS to _getArgs.pm
#
#***************************************************************************

$OOP::VERSION='1.01';

sub new {

 my ($class, $ARGS) = (@_);

 my $self = bless {}, $class;

 $self->{PROPERTIES} = $self->set_args($ARGS);

 return $self;

}

#***************************************************************************
#*[_init]*******************************************************************
# PLACEHOLDER FOR FUTURE . NOT USED UNTIL THIS NOTICE IS REMOVED!
sub _init
{

 no strict;

 my ($self, $ARGS) = @_;

 my $caller = $ARGS->{caller};
 my $callerPkg = ref $ARGS->{caller};
 my $pluginFolder = "./$callerPkg/Core";

 my $obj;

 opendir(COMPONENTS, $pluginFolder);
  my @files = readdir(COMPONENTS);
 closedir(COMPONENTS);

 map {
      /(.*)\.pm/;
      my $cpy = $1;

      if ($cpy)
       {
        ($cpy->use && print "Loading " . $cpy . " version ");
        $obj = $cpy->new($caller);

        if ($obj->{inherit})
         {
          push(@$callerPkg::ISA, $cpy)
         }

        $caller->{CORE}->{$cpy} = $obj;

        print ${$cpy.'::VERSION'} . "... ";
        print "Ok.\n";
       }
     } @files;

 return();

}

1;

__END__