changeset 417:3ed0c58e9da3 ref20150831

working on di container, tests
author cin
date Mon, 02 Nov 2015 01:56:53 +0300
parents cc2cf8c0edc2
children 3f38dabaf5cc
files _test/Test/Config/Bar.pm _test/Test/Config/Container.pm _test/Test/Config/Foo.pm _test/config.t _test/temp.pl lib/IMPL/Code/BasePropertyImplementor.pm lib/IMPL/Config/ActivationContext.pm lib/IMPL/Config/Bag.pm lib/IMPL/Config/Container.pm lib/IMPL/Config/ReferenceDescriptor.pm lib/IMPL/Config/ServiceDescriptor.pm lib/IMPL/Config/ValueDescriptor.pm lib/IMPL/SQL/Schema.pm lib/IMPL/SQL/Schema/Column.pm lib/IMPL/SQL/Schema/Constraint.pm lib/IMPL/declare.pm
diffstat 16 files changed, 297 insertions(+), 159 deletions(-) [+]
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/Test/Config/Bar.pm	Mon Nov 02 01:56:53 2015 +0300
@@ -0,0 +1,18 @@
+package Test::Config::Bar;
+use strict;
+use IMPL::declare {
+	base => [
+	   'IMPL::Object' => undef
+	],
+	props => [
+	   value => 'r'
+	]
+};
+
+sub CTOR {
+	my $this = shift;
+	
+	$this->value(shift) if @_;
+}
+
+1;
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/Test/Config/Container.pm	Mon Nov 02 01:56:53 2015 +0300
@@ -0,0 +1,40 @@
+package Test::Config::Container;
+use strict;
+
+{
+    package Test::Config::Container::Baz;
+    use IMPL::declare {
+        base => {
+            'IMPL::Object' => undef
+        },
+        props => [
+          value => 'r'
+        ]
+    };
+    
+    sub CTOR {
+        my $this = shift;
+        $this->value(shift);
+    }
+}
+
+use IMPL::declare {
+	require => {
+		Container => 'IMPL::Config::Container'
+	},
+	base => {
+		'IMPL::Test::Unit' => '@_'
+	}
+};
+use IMPL::Test qw(test assert failed);
+
+test CreateContainer => sub {
+	my $c1 = Container->new();
+};
+
+sub RegisterServices {
+	my $c1 = Container->new();
+}
+
+
+1;
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/Test/Config/Foo.pm	Mon Nov 02 01:56:53 2015 +0300
@@ -0,0 +1,18 @@
+package Test::Config::Foo;
+use strict;
+use IMPL::declare {
+    base => [
+       'IMPL::Object' => undef
+    ],
+    props => [
+       value => 'r'
+    ]
+};
+
+sub CTOR {
+    my $this = shift;
+    
+    $this->value(shift) if @_;
+}
+
+1;
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/config.t	Mon Nov 02 01:56:53 2015 +0300
@@ -0,0 +1,12 @@
+#!/usr/bin/perl -w
+use strict;
+use lib '../Lib';
+use lib '.';
+
+use IMPL::Test qw(run_plan);
+
+run_plan( qw(
+    Test::Config::Container
+) );
+
+1;
--- a/_test/temp.pl	Thu Oct 29 03:50:25 2015 +0300
+++ b/_test/temp.pl	Mon Nov 02 01:56:53 2015 +0300
@@ -5,9 +5,45 @@
 use Scalar::Util qw(blessed refaddr);
 use YAML::XS qw(Dump);
 
-print Dump {
-	services => [
-	   { role => 'db', type => 'My::Data::Context', params => { '-ref' => 'some-role' } }
+my $t = [gettimeofday];
+
+use IMPL::require {
+	Container => 'IMPL::Config::Container',
+	Service => 'IMPL::Config::ServiceDescriptor',
+	Reference => 'IMPL::Config::ReferenceDescriptor',
+	Value => 'IMPL::Config::ValueDescriptor'
+};
+
+my $c1 = Container->new();
+
+$c1->Register('db', Service->new(
+    type => 'Foo::Data',
+    norequire => 1,
+    activation => 'container'
+) );
+
+$c1->Register(['sec', 'ldap'], Reference->new('db') );
+
+$c1->Register('mixed', Value->new([
+    Reference->new('db'),
+    Reference->new('sec'),
+    Reference->new('ldap')
+]));
+
+my $c2 = Container->new($c1);
+
+my $data = [ $c1->Resolve('mixed')] ;
+
+print "Activated: ",tv_interval($t,[gettimeofday]),"\n";
+
+print Dump($data);
+
+
+package Foo::Data;
+use IMPL::declare {
+	base => [
+	   'IMPL::Object' => undef
 	]
 };
+
 1;
--- a/lib/IMPL/Code/BasePropertyImplementor.pm	Thu Oct 29 03:50:25 2015 +0300
+++ b/lib/IMPL/Code/BasePropertyImplementor.pm	Mon Nov 02 01:56:53 2015 +0300
@@ -53,8 +53,8 @@
 	} elsif ($spec =~ /(\*)?(r)?(w)?/) {
 		return {
 			get => $2 ? 1 : 0,
-			set => $3 ? 1 : 0,
-			ownerSet => $2 ? 1 : 0,
+			set => 1,
+			ownerSet => not($3),
 			direct => $1 ? 1 : 0
 		};
 	} else {
--- a/lib/IMPL/Config/ActivationContext.pm	Thu Oct 29 03:50:25 2015 +0300
+++ b/lib/IMPL/Config/ActivationContext.pm	Mon Nov 02 01:56:53 2015 +0300
@@ -5,18 +5,18 @@
 use IMPL::Exception();
 use IMPL::declare {
 	require => {
-		Bag => 'IMPL::Config::ServicesBag',
+		Bag                      => 'IMPL::Config::ServicesBag',
 		ServiceNotFoundException => 'IMPL::Config::ServiceNotFoundException',
 	},
 	base => {
 		'IMPL::Object' => '@_'
 	},
-	props => {
+	props => [
 		container => PROP_RW,
+		instances => PROP_RW,
 		_services => PROP_RW,
-		_cache    => PROP_RW,
 		_stack    => PROP_RW
-	}
+	]
 };
 
 sub CTOR {
@@ -24,8 +24,9 @@
 
 	$this->container($container)
 	  or die IMPL::InvalidArgumentException->new('container');
-	$this->_cache({});
-	$this->_stack([]);
+	$this->_services( $container->services );
+	$this->instances( {} );
+	$this->_stack( [] );
 }
 
 sub EnterScope {
@@ -44,6 +45,7 @@
 			my $container = $this->container;
 			$bag = Bag->new( $this->_services );
 
+			#
 			$bag->Register(
 				$container->GetLinearRoleHash( $_->{role}, $_->{descriptor} ) )
 			  foreach @$services;
@@ -55,46 +57,42 @@
 		$this->_services($bag);
 	}
 
-	push @{$this->_stack}, $info;
+	push @{ $this->_stack }, $info;
 }
 
 sub LeaveScope {
 	my ($this) = @_;
 
-	my $info = pop @{$this->_stack}
+	my $info = pop @{ $this->_stack }
 	  or die IMPL::InvalidOperationException->new();
 
 	$this->_services( $info->{services} ) if $info->{services};
 }
 
-sub GuardScope {
-	my ( $this, $name, $services, $action ) = @_;
-
-	$this->EnterScope( $name, $service );
-	eval { $action ($this) if $action; } my $err = $@;
-	$this->LeaveScope();
-	die $err if $err;
-}
-
 sub Resolve {
 	my ( $this, $role, %opts ) = @_;
-	
-	my $d = $this->_services->Reolve($role);
-	
-	unless($d) {
+
+	my $d = $this->_services->Resolve($role);
+
+	unless ($d) {
 		die ServiceNotFoundException->new($role) unless $opts{optional};
 		return $opts{default};
-	} else {
+	}
+	else {
 		return $d->Activate($this);
 	}
 }
 
 sub Clone {
 	my ($this) = @_;
-	
-	my $clone = SELF->new($this->container);
-	
-	$clone->_
+
+	my $clone = SELF->new( $this->container );
+
+	$clone->_services( $this->_services );
+	$clone->instances( { %{ $this->instances } } );
+	$clone->_stack( [ @{ $this->_stack } ] );
+
+	return $clone;
 }
 
 1;
--- a/lib/IMPL/Config/Bag.pm	Thu Oct 29 03:50:25 2015 +0300
+++ b/lib/IMPL/Config/Bag.pm	Mon Nov 02 01:56:53 2015 +0300
@@ -41,9 +41,9 @@
 }
 
 sub _Seal {
-	unless ($_[0]->{$_sealed}) {
-		$_[0]->{$_sealed} = 1;
-		$_[0]->{$_timestamp} = 0; # from now the timestamp is important
+	unless ( $_[0]->{$_sealed} ) {
+		$_[0]->{$_sealed}    = 1;
+		$_[0]->{$_timestamp} = 0;    # from now the timestamp is important
 	}
 }
 
@@ -53,19 +53,20 @@
 	my $chain = $this->{$_parents}
 	  or return 1;
 
-	my $rev = 0; # rev 0 means that parent was never modified
-	            # this allows to made more efficient checks
+	my $rev = 0;    # rev 0 means that parent was never modified
+	                # this allows to made more efficient checks
 	my $flush;
-	
-	foreach my $bag (@$chain, $this) {
+
+	foreach my $bag ( @$chain, $this ) {
+
 		# we need to updated all bags after the first change was detected;
-        if ($flush ||= $rev and $bag->{$_parentRev} != $rev) {
-            $bag->{$_cache} = {};
-            $bag->{$_parentRev} = $rev;
-        }
-        $rev = $bag->{$_timestamp};
+		if ( $flush ||= $rev and $bag->{$_parentRev} != $rev ) {
+			$bag->{$_cache}     = {};
+			$bag->{$_parentRev} = $rev;
+		}
+		$rev = $bag->{$_timestamp};
 	}
-	
+
 	return $flush ? 0 : 1;
 }
 
@@ -105,29 +106,30 @@
 	$d = undef;
 	my $prev;
 
-	if ( my $parents = $this->{$_parents} ) {
-		foreach my $bag ( @$parents, $this ) {
+	my $parents = $this->{$_parents};
+	my @bags = $parents ? ( @$parents, $this ) : ($this);
 
-			# check the cache;
-			unless ( my $t = $bag->{$_cache}{$role} ) {
+	foreach my $bag (@bags) {
+
+		# check the cache;
+		unless ( my $t = $bag->{$_cache}{$role} ) {
 
 	  # no cached entry this may be due cache flush
 	  # go through own entries and find better entry than inherited from parents
-				foreach my $entry ( @{ $bag->{$_entries} } ) {
-					my $level = $entry->{isa}{$role};
-					if ( $level and ( not($prev) or $level <= $prev ) ) {
-						$d    = $entry;
-						$prev = $level;
-					}
+			foreach my $entry ( @{ $bag->{$_entries} } ) {
+				my $level = $entry->{isa}{$role};
+				if ( $level and ( not($prev) or $level <= $prev ) ) {
+					$d    = $entry;
+					$prev = $level;
 				}
+			}
 
-				#cache it
-				$bag->{$_cache}{$role} = $d if $d;
-			}
-			else {
-				$d    = $t;
-				$prev = $d->{isa}{$role};
-			}
+			#cache it
+			$bag->{$_cache}{$role} = $d if $d;
+		}
+		else {
+			$d    = $t;
+			$prev = $d->{isa}{$role};
 		}
 	}
 
@@ -140,7 +142,7 @@
 	return [
 		map $_->{value},
 		grep $_->{isa}{$role},
-		map @{$_->{$_entries}},
+		map @{ $_->{$_entries} },
 		@{ $this->{$_parents} || [] },
 		$this
 	];
--- a/lib/IMPL/Config/Container.pm	Thu Oct 29 03:50:25 2015 +0300
+++ b/lib/IMPL/Config/Container.pm	Mon Nov 02 01:56:53 2015 +0300
@@ -47,6 +47,12 @@
 	}
 }
 
+sub Require {
+	my ($this, $class) = @_;
+	
+	return $this->loader->Require($class);
+}
+
 sub Register {
 	my ( $this, $role, $service ) = @_;
 
@@ -64,7 +70,7 @@
 
 	if ( isarray($role) ) {
 		my $tempRole = "unnamed-" . $nextRoleId++;
-		$this->role->AddRole( $tempRole, $role );
+		$this->roles->AddRole( $tempRole, $role );
 		$role = $tempRole;
 	}
 
@@ -77,7 +83,7 @@
 	my $descriptor = $this->services->Resolve($role);
 
 	return $descriptor->Activate( ActivationContext->new($this) )
-	  if $descirptor;
+	  if $descriptor;
 
 	return $opts{default} if exists $opts{default};
 }
--- a/lib/IMPL/Config/ReferenceDescriptor.pm	Thu Oct 29 03:50:25 2015 +0300
+++ b/lib/IMPL/Config/ReferenceDescriptor.pm	Mon Nov 02 01:56:53 2015 +0300
@@ -34,7 +34,7 @@
 sub Activate {
 	my ( $this, $context ) = @_;
 
-	$this->EnterScope( $this->_name, $this->services );
+	$context->EnterScope( $this->_name, $this->services );
 
 	my $ref = $this->reference;
 	my %opts;
@@ -51,7 +51,7 @@
 		return $context->Resolve( $ref, %opts );
 	}
 
-	$this->LeaveScope();
+	$context->LeaveScope();
 }
 
 1;
--- a/lib/IMPL/Config/ServiceDescriptor.pm	Thu Oct 29 03:50:25 2015 +0300
+++ b/lib/IMPL/Config/ServiceDescriptor.pm	Mon Nov 02 01:56:53 2015 +0300
@@ -13,10 +13,11 @@
 		'IMPL::Config::Descriptor' => undef
 	],
 	props => [
-		type       => 'ro',
-		activation => 'ro',
-		args       => 'ro',
-		services   => 'ro',
+		type       => 'r',
+		activation => 'r',
+		args       => 'r',
+		services   => 'r',
+		norequire  => 'r',
 		_name      => 'rw',
 		_loaded    => 'rw'
 	]
@@ -30,8 +31,9 @@
 
 	$this->activation(
 		IMPL::Config::Descriptor::ParseActivation( $opts{activation} ) );
-	$this->args( $opts{args} )         if exists $opts{args};
-	$this->services( $opts{services} ) if exists $opts{services};
+	$this->args( $opts{args} )           if exists $opts{args};
+	$this->services( $opts{services} )   if exists $opts{services};
+	$this->norequire( $opts{norequire} ) if exists $opts{norequire};
 
 	$this->_name( 'new {'
 		  . IMPL::Config::Descriptor::ActivationToString( $this->activation )
@@ -43,35 +45,29 @@
 	my ( $this, $context ) = @_;
 
 	my $instance;
-	$context->GuardScope(
-		$this->_name,
-		$this->services,
-		sub {
+	$context->EnterScope( $this->_name, $this->services );
 
-			my $activation = $this->activation;
-			my $cache;
+	my $activation = $this->activation;
+	my $cache;
 
-			if ( $activation == IMPL::Config::Descriptor::ACTIVATE_SINGLETON ) {
-				$cache = $context->container->root->instances;
-			}
-			elsif (
-				$activation == IMPL::Config::Descriptor::ACTIVATE_CONTAINER )
-			{
-				$cache = $context->container->instances;
-			}
-			elsif ( $activation == IMPL::Config::Descriptor::ACTIVATE_CONTEXT )
-			{
-				$cache = $context->instances;
-			}
+	if ( $activation == IMPL::Config::Descriptor::ACTIVATE_SINGLETON ) {
+		$cache = $context->container->root->instances;
+	}
+	elsif ( $activation == IMPL::Config::Descriptor::ACTIVATE_CONTAINER ) {
+		$cache = $context->container->instances;
+	}
+	elsif ( $activation == IMPL::Config::Descriptor::ACTIVATE_CONTEXT ) {
+		$cache = $context->instances;
+	}
 
-			$instance = $cache->{ ref($this) } if $cache;
-			unless ($instance) {
-				$instance = $this->CreateInstance($context);
-			}
+	$instance = $cache->{ ref($this) } if $cache;
+	unless ($instance) {
+		$instance = $this->CreateInstance($context);
+	}
 
-			$cache->{ ref($this) } = $instance if $cache;
-		}
-	);
+	$cache->{ ref($this) } = $instance if $cache;
+
+	$context->LeaveScope();
 
 	return $instance;
 }
@@ -79,7 +75,10 @@
 sub CreateInstance {
 	my ( $this, $context ) = @_;
 
-	my $class = $context > container->Require( $this->type );
+	my $class =
+	    $this->norequire
+	  ? $this->type
+	  : $context->container->Require( $this->type );
 
 	my $args = $this->args ? $this->args->Activate($context) : undef;
 
--- a/lib/IMPL/Config/ValueDescriptor.pm	Thu Oct 29 03:50:25 2015 +0300
+++ b/lib/IMPL/Config/ValueDescriptor.pm	Mon Nov 02 01:56:53 2015 +0300
@@ -38,11 +38,11 @@
 		return $value->Activate($context);
 	}
 	elsif ( isarray($value) ) {
-		return [ map $this->_ActivateValue($_), @$value ];
+		return [ map $this->_ActivateValue($_, $context), @$value ];
 	}
 	elsif ( ishash($value) ) {
 		return {
-			map { $_, $this->_ActivateValue( $value->{$_} ) }
+			map { $_, $this->_ActivateValue( $value->{$_}, $context ) }
 			  keys %$value
 		};
 	}
--- a/lib/IMPL/SQL/Schema.pm	Thu Oct 29 03:50:25 2015 +0300
+++ b/lib/IMPL/SQL/Schema.pm	Mon Nov 02 01:56:53 2015 +0300
@@ -12,7 +12,6 @@
     base => [
         'IMPL::Object' => undef,
         'IMPL::Object::Disposable' => undef,
-        'IMPL::Object::Autofill' => '@_',
         'IMPL::Object::Clonable' => undef,
     ],
     props => [
@@ -22,6 +21,12 @@
     ]
 };
 
+sub CTOR {
+	my ($this,%args) = @_;
+	
+	$this->$_($args{$_}) foreach grep exists $args{$_}, qw(name version);
+}
+
 sub AddTable {
     my ($this,$table) = @_;
     
--- a/lib/IMPL/SQL/Schema/Column.pm	Thu Oct 29 03:50:25 2015 +0300
+++ b/lib/IMPL/SQL/Schema/Column.pm	Mon Nov 02 01:56:53 2015 +0300
@@ -1,75 +1,78 @@
 use strict;
+
 package IMPL::SQL::Schema::Column;
 
-use IMPL::lang qw( :DEFAULT :compare :hash );
+use IMPL::lang qw( :base :compare :hash );
 use IMPL::Exception();
 use IMPL::Const qw(:prop);
 use IMPL::declare {
-    require => {
-        SchemaType => '-IMPL::SQL::Schema::Type'
-    },
-    base => [
-        'IMPL::Object' => undef,
-        'IMPL::Object::Autofill' => '@_'
-    ],
-    props => [
-        name => PROP_RO | PROP_DIRECT,
-        type => PROP_RO | PROP_DIRECT,
-        isNullable => PROP_RO | PROP_DIRECT,
-        defaultValue => PROP_RO | PROP_DIRECT,
-        tag => PROP_RO | PROP_DIRECT
-    ]
+	require => {
+		SchemaType => '-IMPL::SQL::Schema::Type'
+	},
+	base => [
+		'IMPL::Object'           => undef,
+	],
+	props => [
+		name         => PROP_RO | PROP_DIRECT,
+		type         => PROP_RO | PROP_DIRECT,
+		isNullable   => PROP_RO | PROP_DIRECT,
+		defaultValue => PROP_RO | PROP_DIRECT,
+		tag          => PROP_RO | PROP_DIRECT
+	]
 };
 
 sub CTOR {
-    my $this = shift;
-    
-    $this->{$name} or
-        die new IMPL::InvalidArgumentException('A column name is required');
-    
-    $this->{$isNullable} ||= 0; # if not exists $this->{$isNullable};
-    
-    is( $this->{$type}, SchemaType) or
-        die new IMPL::InvalidArgumentException('a type is required for the column',$this->{$name});
+	my ( $this, %args ) = @_;
+
+	$this->$_( $args{$_} )
+	  foreach grep exists $args{$_}, qw( name type isNullable defaultValue tag);
+
+	$this->{$name} or
+	  die new IMPL::InvalidArgumentException('A column name is required');
+
+	$this->{$isNullable} ||= 0;    # if not exists $this->{$isNullable};
+
+	is( $this->{$type}, SchemaType )
+	  or die new IMPL::InvalidArgumentException(
+		'a type is required for the column',
+		$this->{$name} );
 }
 
 sub SameValue {
-    my ($this,$other) = @_;
-    
-    return (
-        $this->{$name} eq $other->{$name}
-        and $this->{$isNullable} == $other->{$isNullable}
-        and equals_s($this->{$defaultValue}, $other->{$defaultValue})
-        and $this->{$type}->SameValue($other->{$type})
-    );
+	my ( $this, $other ) = @_;
+
+	return (  $this->{$name} eq $other->{$name}
+		  and $this->{$isNullable} == $other->{$isNullable}
+		  and equals_s( $this->{$defaultValue}, $other->{$defaultValue} )
+		  and $this->{$type}->SameValue( $other->{$type} ) );
 }
 
 sub SetType {
-    my ($this,$newType) = @_;
-    
-    $this->{$type} = $newType;
+	my ( $this, $newType ) = @_;
+
+	$this->{$type} = $newType;
 }
 
 sub SetDefaultValue {
-    my ($this,$value) = @_;
-    
-    $this->{$defaultValue} = $value;
+	my ( $this, $value ) = @_;
+
+	$this->{$defaultValue} = $value;
 }
 
 sub SetNullable {
-    my ($this, $value) = @_;
-    
-    $this->{$isNullable} = $value;
+	my ( $this, $value ) = @_;
+
+	$this->{$isNullable} = $value;
 }
 
 sub SetOptions {
-    my ($this,$diff) = @_;
-    
-    return unless ref $diff eq 'HASH';
-    
-    $this->tag({}) unless $this->tag;
-    
-    hashApply($this->tag,$diff);
+	my ( $this, $diff ) = @_;
+
+	return unless ref $diff eq 'HASH';
+
+	$this->tag( {} ) unless $this->tag;
+
+	hashApply( $this->tag, $diff );
 }
 
-1; 
+1;
--- a/lib/IMPL/SQL/Schema/Constraint.pm	Thu Oct 29 03:50:25 2015 +0300
+++ b/lib/IMPL/SQL/Schema/Constraint.pm	Mon Nov 02 01:56:53 2015 +0300
@@ -20,7 +20,7 @@
 
 sub CTOR {
     my ($this,%args) = @_;
-    is( $args{table}, typeof IMPL::SQL::Schema::Table ) or
+    is( $args{table}, 'IMPL::SQL::Schema::Table' ) or
         die new IMPL::InvalidArgumentException("table argument must be a table object");
     $this->{$name} = $args{'name'};
     $this->{$table} = $args{'table'};
@@ -75,13 +75,13 @@
 sub ResolveAlias {
     my ($self,$alias) = @_;
     
-    return isclass($alias, typeof IMPL::SQL::Schema::Constraint) ? $alias : $aliases{$alias};
+    return isclass($alias, 'IMPL::SQL::Schema::Constraint') ? $alias : $aliases{$alias};
 }
 
 sub RegisterAlias {
     my ($self,$alias) = @_;
     
-    $aliases{$alias} = typeof($self);
+    $aliases{$alias} = ref $self ? typeof($self) : $self;
 }
 
 1;
--- a/lib/IMPL/declare.pm	Thu Oct 29 03:50:25 2015 +0300
+++ b/lib/IMPL/declare.pm	Mon Nov 02 01:56:53 2015 +0300
@@ -2,6 +2,7 @@
 use strict;
 
 use Carp qw(carp);
+use IMPL::lang qw( :base );
 use IMPL::Class::PropertyInfo();
 use IMPL::Const qw(:access);
 use IMPL::require();
@@ -16,7 +17,7 @@
 
 	return unless $args;
 
-	die "A hash reference is required" unless ref $args eq 'HASH';
+	die "A hash reference is required" unless ishash($args);
 
 	no strict 'refs';
 	no warnings 'once';
@@ -49,7 +50,7 @@
 	my %ctor;
 	my @isa;
 
-	if ( ref $base eq 'ARRAY' ) {
+	if ( isarray($base) ) {
 		carp "Odd elements number in require"
 		  unless scalar(@$base) % 2 == 0;
 		while ( my ( $class, $mapper ) = splice @$base, 0, 2 ) {
@@ -62,7 +63,7 @@
 			$ctor{$class} = $mapper;
 		}
 	}
-	elsif ( ref $base eq 'HASH' ) {
+	elsif ( ishash($base) ) {
 		while ( my ( $class, $mapper ) = each %$base ) {
 			_trace("parent $class");
 			$IMPL::require::level++;
@@ -77,18 +78,18 @@
 	%{"${caller}::CTOR"} = %ctor;
 	push @{"${caller}::ISA"}, @isa;
 
-	if ( ref( $args->{meta} ) eq 'ARRAY' ) {
+	if ( isarray( $args->{meta} ) ) {
 		$caller->SetMeta($_) foreach @{ $args->{meta} };
 	}
 
 	my $props = $args->{props} || [];
 
-	if ( $props eq 'HASH' ) {
+	if ( ishash($props) ) {
 		$props = [%$props];
 	}
 
 	die "A hash or an array reference is required in the properties list"
-	  unless ref $props eq 'ARRAY';
+	  unless isarray($props);
 
 	carp "Odd elements number in properties declaration of $caller"
 	  unless scalar(@$props) % 2 == 0;