diff Lib/IMPL/declare.pm @ 228:431db7034a88

Для синхронизации
author andrei <andrei@nap21.upri>
date Thu, 13 Sep 2012 17:55:01 +0400
parents 2b9b55cfb79b
children 6d8092d8ce1b
line wrap: on
line diff
--- a/Lib/IMPL/declare.pm	Fri Sep 07 16:32:17 2012 +0400
+++ b/Lib/IMPL/declare.pm	Thu Sep 13 17:55:01 2012 +0400
@@ -3,65 +3,100 @@
 
 use Scalar::Util qw(set_prototype);
 use Carp qw(carp);
+use IMPL::Class::PropertyInfo();
 
 sub import {
-	my ($self,$args) = @_;
-	
+	my ( $self, $args ) = @_;
+
 	return unless $args;
-    
-    die "A hash reference is required" unless ref $args eq 'HASH';
-    
-    no strict 'refs';
-	
+
+	die "A hash reference is required" unless ref $args eq 'HASH';
+
+	no strict 'refs';
+
 	my $caller = caller;
-	
+
 	my $aliases = $args->{require} || {};
-	
-	while( my ($alias, $class) = each %$aliases ) {
+
+	while ( my ( $alias, $class ) = each %$aliases ) {
 		my $c = _require($class);
-        
-        *{"${caller}::$alias"} = set_prototype(sub {
-            $c
-        }, '');
-    }
-    
-    my $base = $args->{base} || {};
-    
-    my %ctor;
-    my @isa;
-    
-    if (ref $base eq 'ARRAY') {
-    	carp "Odd elements number in require" unless scalar(@$base)%2 == 0;
-    	while ( my ($class,$mapper) = splice @$base, 0, 2 ) {
-    		$class = $aliases->{$class} || _require($class);
-    		
-    		push @isa,$class;
-    		$ctor{$class} = $mapper;
-    	}
-    } elsif (ref $base eq 'HASH' ) {
-    	while ( my ($class,$mapper) = each %$base ) {
-    		$class = $aliases->{$class} || _require($class);
-    		
-    		push @isa,$class;
-    		$ctor{$class} = $mapper;
-    	}
-    }
-    
-    *{"${caller}::CTOR"} = \%ctor;
-    *{"${caller}::ISA"} = \@isa;
+
+		*{"${caller}::$alias"} = set_prototype(
+			sub {
+				$c;
+			},
+			''
+		);
+	}
+
+	my $base = $args->{base} || {};
+
+	my %ctor;
+	my @isa;
+
+	if ( ref $base eq 'ARRAY' ) {
+		carp "Odd elements number in require"
+		  unless scalar(@$base) % 2 == 0;
+		while ( my ( $class, $mapper ) = splice @$base, 0, 2 ) {
+			$class = $aliases->{$class} || _require($class);
+
+			push @isa, $class;
+			$ctor{$class} = $mapper;
+		}
+	}
+	elsif ( ref $base eq 'HASH' ) {
+		while ( my ( $class, $mapper ) = each %$base ) {
+			$class = $aliases->{$class} || _require($class);
+
+			push @isa, $class;
+			$ctor{$class} = $mapper;
+		}
+	}
+
+	my $props = $args->{props} || [];
+
+	if ( $props eq 'HASH' ) {
+		$props = [%$props];
+	}
+
+	die "A hash or an array reference is required in the properties list"
+	  unless ref $props eq 'ARRAY';
+
+	carp "Odd elements number in properties declaration of $caller"
+	  unless scalar(@$props) % 2 == 0;
+
+	if (@$props) {
+		for ( my $i = 0 ; $i < @$props - 1 ; $i = $i + 2 ) {
+			my ( $prop, $spec ) = @{$props}[ $i, $i + 1 ];
+
+			my $propInfo = IMPL::Class::PropertyInfo->new(
+				{
+					Name     => $prop,
+					Mutators => $spec,
+					Class    => $caller,
+					Access   => $prop =~ /^_/
+					? IMPL::Class::MemberInfo::MOD_PRIVATE
+					: IMPL::Class::MemberInfo::MOD_PUBLIC
+				}
+			);
+			$propInfo->Implement();
+		}
+	}
+
+	*{"${caller}::CTOR"} = \%ctor;
+	*{"${caller}::ISA"}  = \@isa;
 }
 
 sub _require {
 	my ($class) = @_;
-	
-	if (not $class =~ s/^-//) {
-		(my $file = $class) =~ s/::|'/\//g;
+
+	if ( not $class =~ s/^-// ) {
+		( my $file = $class ) =~ s/::|'/\//g;
 		require "$file.pm";
 	}
 	$class;
 }
 
-
 1;
 
 __END__
@@ -150,4 +185,4 @@
 
 =end code
 
-=cut
\ No newline at end of file
+=cut