Mercurial > pub > Impl

comparison Lib/IMPL/Object/Autofill.pm @ 0:03e58a454b20

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Создан репозитарий
author Sergey
date Tue, 14 Jul 2009 12:54:37 +0400
parents
children 16ada169ca75
comparison
equal deleted inserted replaced
-1:000000000000 0:03e58a454b20
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
36 # äëÿ àâòîçàïîëíåíèÿ íóæåí ñâîé ìåòîä âåðõíåãî óðîâíÿ
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')) {
61 $text .= "\t\$this->$name(\$fields->{$name}) if exists \$fields->{$name};\n";
62 } else {
63 my $fld = $prop_info->Implementor->FieldName($prop_info);
64 if ($prop_info->Mutators & prop_list) {
65 $text .= "\t\$this->{$fld} = ref \$fields->{$name} ? \$fields->{$name} : [\$fields->{$name}] if exists \$fields->{$name};\n";
66 } else {
67 $text .= "\t\$this->{$fld} = \$fields->{$name} if exists \$fields->{$name};\n";
68 }
69 }
70 }
71 } else {
72 # meta not supported
73 #$text .= "\t".'$this->$_($fields->{$_}) foreach keys %$fields;'."\n";
74 }
75 $text .= "}\n\\&_impl_object_autofill;";
76 return eval $text;
77 }
78 }
79
80 1;
81
82 __END__
83
84 =pod
85 =head1 SYNOPSIS
86 package MyClass;
87 use base qw(IMPL::Object IMPL::Object::Autofill);
88
89 BEGIN {
90 private property PrivateData => prop_all;
91 public property PublicData => prop_get;
92 }
93
94 sub CTOR {
95 my $this = shift;
96 $this->superCTOR(@_);
97 # or eqvivalent
98 # $this->supercall::CTOR(@_);
99
100 print $this->PrivateData,"\n";
101 print $this->PublicData,"\n";
102 }
103
104 my $obj = new MyClass(PrivateData => 'private', PublicData => 'public', Other => 'some data');
105
106 will print
107 private
108 public
109
110 =cut