|
49
|
1 package IMPL::Object::Autofill;
|
|
|
2 use strict;
|
|
|
3 use IMPL::Class::Property;
|
|
|
4
|
|
|
5 sub CTOR {
|
|
|
6 my $this = shift;
|
|
|
7 no strict 'refs';
|
|
|
8
|
|
|
9 my $fields = @_ == 1 ? $_[0] : {@_};
|
|
|
10
|
|
|
11 $this->_fill(ref $this,$fields);
|
|
|
12 }
|
|
|
13
|
|
|
14 sub _fill {
|
|
|
15 my ($this,$class,$fields) = @_;
|
|
|
16
|
|
|
17 $class->_autofill_method->($this,$fields);
|
|
|
18
|
|
|
19 no strict 'refs';
|
|
|
20 $this->_fill($_,$fields) foreach grep $_->isa('IMPL::Object::Autofill'), @{"${class}::ISA"};
|
|
|
21 }
|
|
|
22
|
|
|
23 sub DisableAutofill {
|
|
|
24 my $self = shift;
|
|
|
25
|
|
|
26 my $class = ref $self || $self;
|
|
|
27
|
|
|
28 *{"${class}::_impl_object_autofill"} = sub {};
|
|
|
29 }
|
|
|
30
|
|
|
31 sub _autofill_method {
|
|
|
32 my ($class) = @_;
|
|
|
33
|
|
|
34 $class = ref $class if ref $class;
|
|
|
35
|
|
180
|
36 # для автозаполнения нужен свой метод верхнего уровня
|
|
49
|
37 my $method;
|
|
|
38 {
|
|
|
39 no strict 'refs';
|
|
|
40 $method = ${$class.'::'}{_impl_object_autofill};
|
|
|
41 }
|
|
|
42
|
|
|
43 if ($method) {
|
|
|
44 return $method;
|
|
|
45 } else {
|
|
|
46 my $text = <<HEADER;
|
|
|
47 package $class;
|
|
|
48 sub _impl_object_autofill {
|
|
|
49 my (\$this,\$fields) = \@_;
|
|
|
50 HEADER
|
|
|
51
|
|
|
52
|
|
|
53 if ($class->can('get_meta')) {
|
|
|
54 # meta supported
|
|
|
55 foreach my $prop_info (grep {
|
|
|
56 my $mutators = $_->Mutators;
|
|
|
57 ref $mutators ? (exists $mutators->{set}) : ($mutators & prop_set || $_->Implementor->isa('IMPL::Class::Property::Direct'));
|
|
|
58 } $class->get_meta('IMPL::Class::PropertyInfo')) {
|
|
|
59 my $name = $prop_info->Name;
|
|
|
60 if (ref $prop_info->Mutators || !$prop_info->Implementor->isa('IMPL::Class::Property::Direct')) {
|
|
206
|
61 $text .= " \$this->$name(\$fields->{$name}) if exists \$fields->{$name};\n";
|
|
49
|
62 } else {
|
|
|
63 my $fld = $prop_info->Implementor->FieldName($prop_info);
|
|
|
64 if ($prop_info->Mutators & prop_list) {
|
|
206
|
65 $text .= " \$this->{$fld} = IMPL::Object::List->new ( ref \$fields->{$name} ? \$fields->{$name} : [\$fields->{$name}] ) if exists \$fields->{$name};\n";
|
|
49
|
66 } else {
|
|
206
|
67 $text .= " \$this->{$fld} = \$fields->{$name} if exists \$fields->{$name};\n";
|
|
49
|
68 }
|
|
|
69 }
|
|
|
70 }
|
|
|
71 } else {
|
|
|
72 # meta not supported
|
|
206
|
73 #$text .= " ".'$this->$_($fields->{$_}) foreach keys %$fields;'."\n";
|
|
49
|
74 }
|
|
|
75 $text .= "}\n\\&_impl_object_autofill;";
|
|
|
76 return eval $text;
|
|
|
77 }
|
|
|
78 }
|
|
|
79
|
|
|
80 1;
|
|
|
81
|
|
|
82 __END__
|
|
|
83
|
|
|
84 =pod
|
|
198
|
85
|
|
|
86 =head1 NAME
|
|
|
87
|
|
|
88 C<IMPL::Object::Autofill> - автозаполнение объектов
|
|
|
89
|
|
49
|
90 =head1 SYNOPSIS
|
|
198
|
91
|
|
|
92 =begin code
|
|
|
93
|
|
49
|
94 package MyClass;
|
|
198
|
95 use IMPL::declare {
|
|
|
96 base => {
|
|
|
97 'IMPL::Object' => undef,
|
|
|
98 'IMPL::Object::Autofill' => '@_'
|
|
|
99 }
|
|
|
100 };
|
|
49
|
101
|
|
|
102 BEGIN {
|
|
|
103 private property PrivateData => prop_all;
|
|
|
104 public property PublicData => prop_get;
|
|
|
105 }
|
|
|
106
|
|
|
107 sub CTOR {
|
|
|
108 my $this = shift;
|
|
198
|
109
|
|
49
|
110 print $this->PrivateData,"\n";
|
|
|
111 print $this->PublicData,"\n";
|
|
|
112 }
|
|
|
113
|
|
|
114 my $obj = new MyClass(PrivateData => 'private', PublicData => 'public', Other => 'some data');
|
|
|
115
|
|
198
|
116 #will print
|
|
|
117 #private
|
|
|
118 #public
|
|
|
119
|
|
|
120 =end code
|
|
49
|
121
|
|
|
122 =cut
|
