annotate lib/IMPL/Object/Autofill.pm @ 408:5c80e33f1218 ref20150831

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