diff Lib/IMPL/Class/Property/Base.pm @ 194:4d0e1962161c

Replaced tabs with spaces IMPL::Web::View - fixed document model, new features (control classes, document constructor parameters)
author cin
date Tue, 10 Apr 2012 20:08:29 +0400
parents d1676be8afcc
children 6d8092d8ce1b
line wrap: on
line diff
--- a/Lib/IMPL/Class/Property/Base.pm	Tue Apr 10 08:13:22 2012 +0400
+++ b/Lib/IMPL/Class/Property/Base.pm	Tue Apr 10 20:08:29 2012 +0400
@@ -18,142 +18,142 @@
 my $validator_code = '$this->$validator(@_);'; 
 
 my %access_code = (
-	IMPL::Class::Member::MOD_PUBLIC , "",
-	IMPL::Class::Member::MOD_PROTECTED, "die new IMPL::Exception('Can\\'t access the protected member',\$name,\$class,scalar caller) unless UNIVERSAL::isa(scalar caller,\$class);",
-	IMPL::Class::Member::MOD_PRIVATE, "die new IMPL::Exception('Can\\'t access the private member',\$name,\$class,scalar caller) unless caller eq \$class;" 
+    IMPL::Class::Member::MOD_PUBLIC , "",
+    IMPL::Class::Member::MOD_PROTECTED, "die new IMPL::Exception('Can\\'t access the protected member',\$name,\$class,scalar caller) unless UNIVERSAL::isa(scalar caller,\$class);",
+    IMPL::Class::Member::MOD_PRIVATE, "die new IMPL::Exception('Can\\'t access the private member',\$name,\$class,scalar caller) unless caller eq \$class;" 
 );
 
 my $virtual_call = q(
-		my $method = $this->can($name);
+        my $method = $this->can($name);
         return $this->$method(@_) unless $method == $accessor or caller->isa($class);
 );
 
 my $owner_check = "die new IMPL::Exception('Set accessor is restricted to the owner',\$name,\$class,scalar caller) unless caller eq \$class;";
 
 sub GenerateAccessors {
-	my ($self,$param,@params) = @_;
-	
-	my %accessors;
-	
-	if (not ref $param) {
-		if ($param & prop_list) {
-			$accessors{get} = ($param & prop_get) ? $self->GenerateGetList(@params) : undef;
-			$accessors{set} = ($param & prop_set) ? $self->GenerateSetList(@params) : undef;
-		} else {
-			$accessors{get} = ($param & prop_get) ? $self->GenerateGet(@params) : undef;
-			$accessors{set} = ($param & prop_set) ? $self->GenerateSet(@params) : undef;
-		}
-		$accessors{owner} = (($param & owner_set) == owner_set) ? $owner_check : "";
-	} elsif (UNIVERSAL::isa($param,'HASH')) {
-		$accessors{get} = $param->{get} ? $custom_accessor_get : undef;
-		$accessors{set} = $param->{set} ? $custom_accessor_set : undef;
-		$accessors{owner} = "";
-	} else {
-		die new IMPL::Exception('The unsupported accessor/mutators supplied',$param);
-	}
-	
-	return \%accessors;
+    my ($self,$param,@params) = @_;
+    
+    my %accessors;
+    
+    if (not ref $param) {
+        if ($param & prop_list) {
+            $accessors{get} = ($param & prop_get) ? $self->GenerateGetList(@params) : undef;
+            $accessors{set} = ($param & prop_set) ? $self->GenerateSetList(@params) : undef;
+        } else {
+            $accessors{get} = ($param & prop_get) ? $self->GenerateGet(@params) : undef;
+            $accessors{set} = ($param & prop_set) ? $self->GenerateSet(@params) : undef;
+        }
+        $accessors{owner} = (($param & owner_set) == owner_set) ? $owner_check : "";
+    } elsif (UNIVERSAL::isa($param,'HASH')) {
+        $accessors{get} = $param->{get} ? $custom_accessor_get : undef;
+        $accessors{set} = $param->{set} ? $custom_accessor_set : undef;
+        $accessors{owner} = "";
+    } else {
+        die new IMPL::Exception('The unsupported accessor/mutators supplied',$param);
+    }
+    
+    return \%accessors;
 }
 
 sub GenerateSet {
-	die new IMPL::Exception("Standard accessors not supported",'Set');
+    die new IMPL::Exception("Standard accessors not supported",'Set');
 }
-	
+    
 sub GenerateGet {
-	die new IMPL::Exception("Standard accessors not supported",'Get');
+    die new IMPL::Exception("Standard accessors not supported",'Get');
 }
 
 sub GenerateGetList {
-	die new IMPL::Exception("Standard accessors not supported",'GetList');
+    die new IMPL::Exception("Standard accessors not supported",'GetList');
 }
 
 sub GenerateSetList {
-	my ($self) = @_;
-	die new IMPL::Exception("Standard accessors not supported",'SetList');
+    my ($self) = @_;
+    die new IMPL::Exception("Standard accessors not supported",'SetList');
 }
 
 sub Make {
-	my ($self,$propInfo) = @_;
-	
-	my $key = $self->MakeFactoryKey($propInfo);
-	
-	my $factoryInfo = $factoryCache{$key};
-	
-	unless ($factoryInfo) {
-		my $mutators = $self->GenerateAccessors($propInfo->Mutators);
-		$factoryInfo = {
-			factory => $self->CreateFactory(
-				$access_code{ $propInfo->Access },
-				$propInfo->Attributes->{validator} ? $validator_code : "",
-				$mutators->{owner},
-				$mutators->{get} || $accessor_get_no,
-				$mutators->{set} || $accessor_set_no
-			),
-			mutators => $mutators
-		};
-		$factoryCache{$key} = $factoryInfo; 
-	}
-	
-	{
-		no strict 'refs';
-		*{ $propInfo->Class.'::'.$propInfo->Name } = $factoryInfo->{factory}->($self->RemapFactoryParams($propInfo));
-	}
-	
-	my $mutators = $factoryInfo->{mutators};
-	
-	$propInfo->canGet( $mutators->{get} ? 1 : 0 );
-	$propInfo->canSet( $mutators->{set} ? 1 : 0 );
-	$propInfo->ownerSet( $mutators->{owner} );
-	
-	1;
+    my ($self,$propInfo) = @_;
+    
+    my $key = $self->MakeFactoryKey($propInfo);
+    
+    my $factoryInfo = $factoryCache{$key};
+    
+    unless ($factoryInfo) {
+        my $mutators = $self->GenerateAccessors($propInfo->Mutators);
+        $factoryInfo = {
+            factory => $self->CreateFactory(
+                $access_code{ $propInfo->Access },
+                $propInfo->Attributes->{validator} ? $validator_code : "",
+                $mutators->{owner},
+                $mutators->{get} || $accessor_get_no,
+                $mutators->{set} || $accessor_set_no
+            ),
+            mutators => $mutators
+        };
+        $factoryCache{$key} = $factoryInfo; 
+    }
+    
+    {
+        no strict 'refs';
+        *{ $propInfo->Class.'::'.$propInfo->Name } = $factoryInfo->{factory}->($self->RemapFactoryParams($propInfo));
+    }
+    
+    my $mutators = $factoryInfo->{mutators};
+    
+    $propInfo->canGet( $mutators->{get} ? 1 : 0 );
+    $propInfo->canSet( $mutators->{set} ? 1 : 0 );
+    $propInfo->ownerSet( $mutators->{owner} );
+    
+    1;
 }
 
 # extract from property info: class, name, get_accessor, set_accessor, validator
 sub RemapFactoryParams {
-	my ($self,$propInfo) = @_;
-	
-	my $mutators = $propInfo->Mutators;
-	my $class = $propInfo->Class;
-	my $validator = $propInfo->Attributes->{validator};
-	
-	die new IMPL::Exception('Can\'t find the specified validator',$class,$validator) if $validator and ref $validator ne 'CODE' and not $class->can($validator);
+    my ($self,$propInfo) = @_;
+    
+    my $mutators = $propInfo->Mutators;
+    my $class = $propInfo->Class;
+    my $validator = $propInfo->Attributes->{validator};
+    
+    die new IMPL::Exception('Can\'t find the specified validator',$class,$validator) if $validator and ref $validator ne 'CODE' and not $class->can($validator);
 
-	return (
-		$propInfo->get(qw(Class Name)),
-		(ref $mutators?
-			($mutators->{set},$mutators->{get})
-			:
-			(undef,undef)
-		),
-		$validator
-	);
+    return (
+        $propInfo->get(qw(Class Name)),
+        (ref $mutators?
+            ($mutators->{set},$mutators->{get})
+            :
+            (undef,undef)
+        ),
+        $validator
+    );
 }
 
 sub MakeFactoryKey {
-	my ($self,$propInfo) = @_;
-	
-	my ($access,$mutators,$validator) = ($propInfo->get(qw(Access Mutators)),$propInfo->Attributes->{validator});
-	
-	my $implementor = ref $self || $self;
-	
-	return join ('',
-		$implementor,
-		$access,
-		$validator ? 'v' : 'n',
-		ref $mutators ?
-			('c' , $mutators->{get} ? 1 : 0, $mutators->{set} ? 1 : 0)
-			:
-			('s',$mutators) 
-	); 
+    my ($self,$propInfo) = @_;
+    
+    my ($access,$mutators,$validator) = ($propInfo->get(qw(Access Mutators)),$propInfo->Attributes->{validator});
+    
+    my $implementor = ref $self || $self;
+    
+    return join ('',
+        $implementor,
+        $access,
+        $validator ? 'v' : 'n',
+        ref $mutators ?
+            ('c' , $mutators->{get} ? 1 : 0, $mutators->{set} ? 1 : 0)
+            :
+            ('s',$mutators) 
+    ); 
 }
 
 sub CreateFactory {
-	my ($self,$codeAccessCheck,$codeValidator,$codeOwnerCheck,$codeGet,$codeSet) = @_;
-	
-	my $strParams = join(',',$self->factoryParams);
-	
-	my $factory = <<FACTORY;
-	
+    my ($self,$codeAccessCheck,$codeValidator,$codeOwnerCheck,$codeGet,$codeSet) = @_;
+    
+    my $strParams = join(',',$self->factoryParams);
+    
+    my $factory = <<FACTORY;
+    
 sub {
     my ($strParams) = \@_;
     my \$accessor;
@@ -161,17 +161,17 @@
         my \$this = shift;
         $codeAccessCheck
         if (\@_) {
-        	$codeOwnerCheck
-        	$codeValidator
-        	$codeSet
+            $codeOwnerCheck
+            $codeValidator
+            $codeSet
         } else {
-        	$codeGet
+            $codeGet
         }
     }
 }
 FACTORY
 
-	return ( eval $factory or die new IMPL::Exception("Syntax error due compiling the factory","$@") );
+    return ( eval $factory or die new IMPL::Exception("Syntax error due compiling the factory","$@") );
 }
 
 1;