|
407
|
1 package IMPL::Class::Property;
|
|
|
2 use strict;
|
|
|
3 use parent qw(Exporter);
|
|
|
4
|
|
|
5 BEGIN {
|
|
|
6 our @EXPORT = qw(property prop_get prop_set owner_set prop_none prop_all prop_list CreateProperty);
|
|
|
7 }
|
|
|
8
|
|
|
9 use IMPL::lang qw(:hash);
|
|
|
10 use IMPL::Const qw(:prop);
|
|
|
11 use Carp qw(carp);
|
|
|
12 require IMPL::Class::Member;
|
|
|
13
|
|
|
14 sub import {
|
|
|
15 __PACKAGE__->export_to_level(1,@_);
|
|
|
16 IMPL::Class::Member->export_to_level(1,@_);
|
|
|
17 }
|
|
|
18
|
|
|
19 sub prop_get { 1 };
|
|
|
20 sub prop_set { 2 };
|
|
|
21 sub owner_set { 10 };
|
|
|
22 sub prop_none { 0 };
|
|
|
23 sub prop_all { 3 };
|
|
|
24 sub prop_list { 4 };
|
|
|
25
|
|
|
26 sub property($$) {
|
|
|
27 my ($propName,$attributes) = @_;
|
|
|
28
|
|
|
29 my $class = caller;
|
|
|
30
|
|
|
31 return hashMerge (
|
|
|
32 $class->ClassPropertyImplementor->NormalizeSpecification($attributes),
|
|
|
33 {
|
|
|
34 implementor => $class->ClassPropertyImplementor,
|
|
|
35 name => $propName,
|
|
|
36 class => scalar(caller),
|
|
|
37 }
|
|
|
38 );
|
|
|
39 }
|
|
|
40
|
|
|
41 sub CreateProperty {
|
|
|
42 my ($class,$propName,@attributes) = @_;
|
|
|
43
|
|
|
44 $class
|
|
|
45 ->ClassPropertyImplementor
|
|
|
46 ->Implement(
|
|
|
47 @attributes,
|
|
|
48 {
|
|
|
49 name => $propName,
|
|
|
50 class => $class,
|
|
|
51 }
|
|
|
52 );
|
|
|
53 };
|
|
|
54
|
|
|
55 1;
|
