comparison Lib/IMPL/lang.pm @ 278:4ddb27ff4a0b

core refactoring
author cin
date Mon, 04 Feb 2013 02:10:37 +0400
parents 6253872024a4
children c6d0f889ef87
comparison
equal deleted inserted replaced
277:6585464c4664 278:4ddb27ff4a0b
5 use parent qw(Exporter); 5 use parent qw(Exporter);
6 use IMPL::_core::version; 6 use IMPL::_core::version;
7 use IMPL::clone qw(clone); 7 use IMPL::clone qw(clone);
8 use Scalar::Util qw(blessed); 8 use Scalar::Util qw(blessed);
9 9
10 require IMPL::Class::PropertyInfo;
11
12 our @EXPORT = qw(&is &isclass &typeof); 10 our @EXPORT = qw(&is &isclass &typeof);
13 our %EXPORT_TAGS = ( 11 our %EXPORT_TAGS = (
14 base => [ 12 base => [
15 qw( 13 qw(
16 &is 14 &is
23 declare => [ 21 declare => [
24 qw( 22 qw(
25 &public 23 &public
26 &protected 24 &protected
27 &private 25 &private
28 &virtual
29 &property 26 &property
30 &static 27 &static
31 &property 28 &property
29 &_direct
32 &ACCESS_PUBLIC 30 &ACCESS_PUBLIC
33 &ACCESS_PROTECTED 31 &ACCESS_PROTECTED
34 &ACCESS_PRIVATE 32 &ACCESS_PRIVATE
35 &PROP_GET 33 &PROP_GET
36 &PROP_SET 34 &PROP_SET
37 &PROP_OWNERSET 35 &PROP_OWNERSET
38 &PROP_LIST 36 &PROP_LIST
39 &PROP_ALL 37 &PROP_ALL
40 &PROP_RO 38 &PROP_RO
41 &PROP_RW 39 &PROP_RW
40 &PROP_DIRECT
42 ) 41 )
43 ], 42 ],
44 compare => [ 43 compare => [
45 qw( 44 qw(
46 &equals 45 &equals
74 73
75 sub typeof(*) { 74 sub typeof(*) {
76 eval { $_[0]->typeof } || blessed($_[0]); 75 eval { $_[0]->typeof } || blessed($_[0]);
77 } 76 }
78 77
79 sub virtual($) {
80 $_[0]->Virtual(1);
81 $_[0];
82 }
83
84 sub public($) { 78 sub public($) {
85 $_[0]->access(ACCESS_PUBLIC); 79 my $info = shift;
86 $_[0]->Implement; 80 $info->{access} = ACCESS_PUBLIC;
87 $_[0]; 81 my $implementor = delete $info->{implementor};
82 $implementor->Implement($info);
88 } 83 }
89 84
90 sub private($) { 85 sub private($) {
91 $_[0]->access(ACCESS_PRIVATE); 86 my $info = shift;
92 $_[0]->Implement; 87 $info->{access} = ACCESS_PRIVATE;
93 $_[0]; 88 my $implementor = delete $info->{implementor};
89 $implementor->Implement($info);
94 } 90 }
95 91
96 sub protected($) { 92 sub protected($) {
97 $_[0]->access(ACCESS_PROTECTED); 93 my $info = shift;
98 $_[0]->Implement; 94 $info->{access} = ACCESS_PROTECTED;
99 $_[0]; 95 my $implementor = delete $info->{implementor};
100 } 96 $implementor->Implement($info);
101 97 }
102 sub property($$;$) { 98
103 my ( $propName, $mutators, $attributes ) = @_; 99 sub _direct ($) {
104 my $Info = new IMPL::Class::PropertyInfo( 100 my $info = shift;
101 $info->{direct} = 1;
102 return $info;
103 }
104
105 sub property($$) {
106 my ($propName,$attributes) = @_;
107
108 $attributes = {
109 get => $attributes & PROP_GET,
110 set => $attributes & PROP_SET,
111 isList => $attributes & PROP_LIST
112 } unless ref $attributes;
113
114 my $class = caller;
115
116 return hashMerge (
117 $attributes,
105 { 118 {
106 name => $propName, 119 implementor => $class->ClassPropertyImplementor,
107 mutators => $mutators, 120 name => $propName,
108 class => scalar(caller), 121 class => scalar(caller),
109 attributes => $attributes
110 } 122 }
111 ); 123 );
112 return $Info;
113 } 124 }
114 125
115 sub static($$) { 126 sub static($$) {
116 my ( $name, $value ) = @_; 127 my ( $name, $value ) = @_;
117 my $class = caller; 128 my $class = caller;