annotate Lib/IMPL/Object/Autofill.pm @ 4:e59f44f75f20

DOM - в разработке Testing - по мелочи Property - изменен механизм выбора имплементора
author Sergey
date Wed, 12 Aug 2009 17:36:07 +0400
parents 03e58a454b20
children 16ada169ca75
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
1 package IMPL::Object::Autofill;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
2 use strict;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
3 use IMPL::Class::Property;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
4
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
5 sub CTOR {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
6 my $this = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
7 no strict 'refs';
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
8
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
9 my $fields = @_ == 1 ? $_[0] : {@_};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
10
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
11 $this->_fill(ref $this,$fields);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
12 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
13
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
14 sub _fill {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
15 my ($this,$class,$fields) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
16
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
17 $class->_autofill_method->($this,$fields);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
18
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
19 no strict 'refs';
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
20 $this->_fill($_,$fields) foreach grep $_->isa('IMPL::Object::Autofill'), @{"${class}::ISA"};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
21 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
22
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
23 sub DisableAutofill {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
24 my $self = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
25
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
26 my $class = ref $self || $self;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
27
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
28 *{"${class}::_impl_object_autofill"} = sub {};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
29 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
30
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
31 sub _autofill_method {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
32 my ($class) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
33
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
34 $class = ref $class if ref $class;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
35
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
36 # äëÿ àâòîçàïîëíåíèÿ íóæåí ñâîé ìåòîä âåðõíåãî óðîâíÿ
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
37 my $method;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
38 {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
39 no strict 'refs';
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
40 $method = ${$class.'::'}{_impl_object_autofill};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
41 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
42
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
43 if ($method) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
44 return $method;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
45 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
46 my $text = <<HEADER;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
47 package $class;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
48 sub _impl_object_autofill {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
49 my (\$this,\$fields) = \@_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
50 HEADER
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
51
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
52
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
53 if ($class->can('get_meta')) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
54 # meta supported
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
55 foreach my $prop_info (grep {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
56 my $mutators = $_->Mutators;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
57 ref $mutators ? (exists $mutators->{set}) : ($mutators & prop_set || $_->Implementor->isa('IMPL::Class::Property::Direct'));
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
58 } $class->get_meta('IMPL::Class::PropertyInfo')) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
59 my $name = $prop_info->Name;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
60 if (ref $prop_info->Mutators || !$prop_info->Implementor->isa('IMPL::Class::Property::Direct')) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
61 $text .= "\t\$this->$name(\$fields->{$name}) if exists \$fields->{$name};\n";
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
62 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
63 my $fld = $prop_info->Implementor->FieldName($prop_info);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
64 if ($prop_info->Mutators & prop_list) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
65 $text .= "\t\$this->{$fld} = ref \$fields->{$name} ? \$fields->{$name} : [\$fields->{$name}] if exists \$fields->{$name};\n";
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
66 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
67 $text .= "\t\$this->{$fld} = \$fields->{$name} if exists \$fields->{$name};\n";
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
68 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
69 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
70 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
71 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
72 # meta not supported
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
73 #$text .= "\t".'$this->$_($fields->{$_}) foreach keys %$fields;'."\n";
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
74 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
75 $text .= "}\n\\&_impl_object_autofill;";
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
76 return eval $text;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
77 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
78 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
79
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
80 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
81
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
82 __END__
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
83
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
84 =pod
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
85 =head1 SYNOPSIS
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
86 package MyClass;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
87 use base qw(IMPL::Object IMPL::Object::Autofill);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
88
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
89 BEGIN {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
90 private property PrivateData => prop_all;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
91 public property PublicData => prop_get;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
92 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
93
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
94 sub CTOR {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
95 my $this = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
96 $this->superCTOR(@_);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
97 # or eqvivalent
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
98 # $this->supercall::CTOR(@_);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
99
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
100 print $this->PrivateData,"\n";
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
101 print $this->PublicData,"\n";
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
102 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
103
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
104 my $obj = new MyClass(PrivateData => 'private', PublicData => 'public', Other => 'some data');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
105
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
106 will print
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
107 private
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
108 public
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
109
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
110 =cut