Mercurial > pub > Impl

comparison Lib/IMPL/lang.pm @ 167:1f7a6d762394

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
SQL schema in progress
author sourcer
date Thu, 12 May 2011 08:57:19 +0400
parents 76515373dac0
children 6148f89bb7bf
comparison
equal deleted inserted replaced
166:4267a2ac3d46 167:1f7a6d762394
3 use warnings; 3 use warnings;
4 4
5 use parent qw(Exporter); 5 use parent qw(Exporter);
6 use IMPL::_core::version; 6 use IMPL::_core::version;
7 7
8 require IMPL::Class::PropertyInfo;
8 9
9 our @EXPORT = qw(&is); 10 our @EXPORT = qw(&is);
11 our %EXPORT_TAGS = (
12 base => [
13 qw(
14 &is
15 )
16 ],
17 constants => [
18 qw(
19 &ACCESS_PUBLIC
20 &ACCESS_PROTECTED
21 &ACCESS_PRIVATE
22 &PROP_GET
23 &PROP_SET
24 &PROP_OWNERSET
25 &PROP_LIST
26 &PROP_ALL
27 )
28 ],
29
30 declare => [
31 qw(
32 &public
33 &protected
34 &private
35 &virtual
36 &property
37 &static
38 &property
39 )
40 ],
41 compare => [
42 qw(
43 &equals
44 &equals_s
45 )
46 ]
47 );
48
49 our @EXPORT_OK = keys %{ { map (($_,1) , map (@{$_}, values %EXPORT_TAGS) ) } };
50
51 use constant {
52 ACCESS_PUBLIC => 1,
53 ACCESS_PROTECTED => 2,
54 ACCESS_PRIVATE => 3,
55 PROP_GET => 1,
56 PROP_SET => 2,
57 PROP_OWNERSET => 10,
58 PROP_LIST => 4,
59 PROP_ALL => 3
60 };
10 61
11 sub is($$) { 62 sub is($$) {
12 eval { $_[0]->isa($_[1]) } 63 eval { $_[0]->isa( $_[1] ) };
64 }
65
66 sub virtual($) {
67 $_[0]->Virtual(1);
68 $_[0];
69 }
70
71 sub public($) {
72 $_[0]->Access(ACCESS_PUBLIC);
73 $_[0]->Implement;
74 $_[0];
75 }
76
77 sub private($) {
78 $_[0]->Access(ACCESS_PRIVATE);
79 $_[0]->Implement;
80 $_[0];
81 }
82
83 sub protected($) {
84 $_[0]->Access(ACCESS_PROTECTED);
85 $_[0]->Implement;
86 $_[0];
87 }
88
89 sub property($$;$) {
90 my ( $propName, $mutators, $attributes ) = @_;
91 my $Info = new IMPL::Class::PropertyInfo(
92 {
93 Name => $propName,
94 Mutators => $mutators,
95 Class => scalar(caller),
96 Attributes => $attributes
97 }
98 );
99 return $Info;
100 }
101
102 sub static($$) {
103 my ( $name, $value ) = @_;
104 my $class = caller;
105 $class->static_accessor( $name, $value );
106 }
107
108 sub equals {
109 if (defined $_[0]) {
110 return 0 if (not defined $_[1]);
111
112 return $_[0] == $_[1];
113 } else {
114 return 0 if defined $_[1];
115
116 return 1;
117 }
118 }
119
120 sub equals_s {
121 if (defined $_[0]) {
122 return 0 if (not defined $_[1]);
123
124 return $_[0] eq $_[1];
125 } else {
126 return 0 if defined $_[1];
127
128 return 1;
129 }
13 } 130 }
14 131
15 1; 132 1;