Mercurial > pub > Impl

comparison lib/IMPL/Object/Autofill.pm @ 407:c6e90e02dd17 ref20150831

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
comparison
equal deleted inserted replaced
406:f23fcb19d3c1 407:c6e90e02dd17
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