Mercurial > pub > Impl
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