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