1package Gtk2::Ex::FormFactory::Proxy;
2
3use strict;
4use Carp;
5
6my $NAME_CNT = 0;
7
8sub get_context			{ shift->{context}			}
9sub get_name			{ shift->{name}				}
10sub get_aggregated_by		{ shift->{aggregated_by}		}
11sub get_set_prefix		{ shift->{set_prefix}			}
12sub get_get_prefix		{ shift->{get_prefix}			}
13sub get_attr_activity_href	{ shift->{attr_activity_href}		}
14sub get_attr_accessors_href	{ shift->{attr_accessors_href}		}
15sub get_attr_aggregate_href	{ shift->{attr_aggregate_href}		}
16sub get_accessor		{ shift->{accessor}			}
17sub get_changes_attr_filter     { shift->{changes_attr_filter}          }
18
19sub get_buffered		{ 0 }
20
21sub get_object_changed          { shift->{object_changed}               }
22sub set_object_changed          { shift->{object_changed}       = $_[1] }
23
24sub new {
25	my $class = shift;
26	my %par = @_;
27	my  ($context, $object, $name, $set_prefix, $get_prefix) =
28	@par{'context','object','name','set_prefix','get_prefix'};
29	my  ($attr_accessors_href, $attr_activity_href, $aggregated_by) =
30	@par{'attr_accessors_href','attr_activity_href','aggregated_by'};
31	my  ($accessor, $changes_attr_filter) =
32	@par{'accessor','changes_attr_filter'};
33
34	$attr_accessors_href ||= {},
35	$attr_activity_href  ||= {};
36	$name                ||= "object_".$NAME_CNT++;
37
38	my $self = bless {
39		context			=> $context,
40		object			=> $object,
41		name			=> $name,
42		aggregated_by		=> $aggregated_by,
43		set_prefix		=> $set_prefix,
44		get_prefix		=> $get_prefix,
45		attr_activity_href	=> $attr_activity_href,
46		attr_accessors_href	=> $attr_accessors_href,
47		accessor		=> $accessor,
48                changes_attr_filter     => $changes_attr_filter,
49		attr_aggregate_href	=> {},
50	}, $class;
51
52	return $self;
53}
54
55sub get_object {
56	my $self = shift;
57	my $object = $self->{object};
58	ref $object eq 'CODE' ? &$object() : $object;
59}
60
61sub update_by_aggregation {
62	my $self = shift;
63
64	my $aggregated_by = $self->get_aggregated_by;
65
66	my $object = $self->get_attr($aggregated_by);
67
68	$self->set_object($object);
69
70	1;
71}
72
73sub set_object {
74	my $self = shift;
75	my ($object) = @_;
76
77	#-- nothing to do if it's the same object
78	#-- (eval{} is for catching Class::DBI exceptions if
79	#-- $self->{object} was deleted in the meantime)
80	return if eval { $object eq $self->{object} };
81
82        #-- reset changed status
83        $self->set_object_changed(0);
84
85        #-- set object
86	$self->{object} = $object;
87
88        #-- Update all object widgets
89	my $context = $self->get_context;
90	$context->update_object_widgets ($self->get_name);
91
92        #-- Update aggregated objects
93	my $attr_aggregate_href = $self->get_attr_aggregate_href;
94	my ($attr, $child_object_name, $child_object);
95
96	while ( ($attr, $child_object_name) = each %{$attr_aggregate_href} ) {
97		$child_object = $self->get_attr($attr);
98		$context->set_object($child_object_name, $child_object);
99	}
100
101	return $object;
102}
103
104sub get_attr {
105	my $self = shift;
106	my ($attr_name) = @_;
107
108	if ( $attr_name =~ /^([^.]+)\.(.*)$/ ) {
109		$self      = $self->get_context->get_proxy($1);
110		$attr_name = $2;
111	}
112
113	my $accessor = $self->get_accessor;
114	my $object   = $self->get_object;
115
116	return &$accessor($object, $attr_name) if $accessor;
117
118	my $method = $self->get_get_prefix.$attr_name;
119	$accessor  = $self->get_attr_accessors_href->{$method};
120
121	return if not $object;
122	return &$accessor($object) if $accessor;
123	return $object->$method();
124}
125
126sub set_attr {
127	my $self = shift;
128	my ($attr_name, $attr_value, $no_widget_update) = @_;
129
130	if ( $attr_name =~ /^([^.]+)\.(.*)$/ ) {
131		$self      = $self->get_context->get_proxy($1);
132		$attr_name = $2;
133	}
134
135        $self->object_changed($attr_name);
136
137	my $accessor = $self->get_accessor;
138	my $object   = $self->get_object;
139	my $name     = $self->get_name;
140
141	my $rc;
142	if ( $accessor ) {
143		$rc = &$accessor($object, $attr_name, $attr_value);
144	} else {
145		my $set_prefix = $self->get_set_prefix;
146		my $method     = $set_prefix.$attr_name;
147		$accessor      = $self->get_attr_accessors_href->{$method};
148		$rc = $accessor ?
149			&$accessor($object, $attr_value) :
150			$object->$method($attr_value);
151	}
152
153	return $rc if $no_widget_update;
154
155	$self->get_context
156	     ->update_object_attr_widgets($name, $attr_name, $object);
157
158	my $child_object_name = $self->get_attr_aggregate_href->{$attr_name};
159
160	$self->get_context->set_object($child_object_name, $attr_value)
161		if $child_object_name;
162
163	return $rc;
164}
165
166sub set_attrs {
167	my $self = shift;
168	my ($attrs_href, $no_widget_update) = @_;
169
170	my $set_prefix  = $self->get_set_prefix;
171	my $object      = $self->get_object;
172	my $name        = $self->get_name;
173	my $context     = $self->get_context;
174	my $accessors   = $self->get_attr_accessors_href;
175
176	my ($method, $attr_name, $attr_value, $accessor, $child_object_name);
177
178	$accessor = $self->get_accessor;
179
180	while ( ($attr_name, $attr_value) = each %{$attrs_href} ) {
181                $self->object_changed($attr_name);
182		if ( $accessor ) {
183			&$accessor($object, $attr_name, $attr_value);
184		} else {
185			$method = $set_prefix.$attr_name;
186			$accessor = $accessors->{$method};
187			$accessor ?
188				&$accessor($object, $attr_value) :
189				$object->$method($attr_value);
190		}
191		$accessor = undef;
192		next if $no_widget_update;
193		$context->update_object_attr_widgets(
194			$name, $attr_name, $object
195		);
196		$child_object_name = $self->get_attr_aggregate_href->{$attr_name};
197		$context->set_object($child_object_name, $attr_value)
198			if $child_object_name;
199	}
200
201	1;
202}
203
204sub get_attr_presets {
205	my $self = shift;
206	my ($attr_name) = @_;
207
208	my $method  = $self->get_get_prefix.$attr_name."_presets";
209	my $object  = $self->get_object;
210	my $accessor = $self->get_attr_accessors_href->{$method};
211
212	return &$accessor($object) if ref $accessor eq 'CODE';
213	return $accessor if $accessor;
214	return $object->$method();
215}
216
217sub get_attr_rows {
218	my $self = shift;
219	my ($attr_name) = @_;
220
221	my $method  = $self->get_get_prefix.$attr_name."_rows";
222	my $object  = $self->get_object;
223	my $accessor = $self->get_attr_accessors_href->{$method};
224
225	return &$accessor($object) if ref $accessor eq 'CODE';
226	return $accessor if $accessor;
227	return $object->$method();
228}
229
230sub get_attr_list {
231	my $self = shift;
232	my ($attr_name, $widget_name) = @_;
233
234	my $method  = $self->get_get_prefix.$attr_name."_list";
235	my $object  = $self->get_object;
236	my $accessor = $self->get_attr_accessors_href->{$method};
237
238	return &$accessor($object, $widget_name) if ref $accessor eq 'CODE';
239	return $accessor if $accessor;
240	return $object->$method($widget_name);
241}
242
243sub get_attr_presets_static {
244	my $self = shift;
245	my ($attr_name) = @_;
246
247	my $method  = $self->get_get_prefix.$attr_name."_presets_static";
248	my $object  = $self->get_object;
249	my $accessor = $self->get_attr_accessors_href->{$method};
250
251	return &$accessor($object) if ref $accessor eq 'CODE';
252	return $accessor if $accessor;
253	return 1 if not $object->can($method);
254	return $object->$method();
255}
256
257sub get_attr_rows_static {
258	my $self = shift;
259	my ($attr_name) = @_;
260
261	my $method  = $self->get_get_prefix.$attr_name."_rows_static";
262	my $object  = $self->get_object;
263	my $accessor = $self->get_attr_accessors_href->{$method};
264
265	return &$accessor($object) if ref $accessor eq 'CODE';
266	return $accessor if $accessor;
267	return 1 if not $object->can($method);
268	return $object->$method();
269}
270
271sub get_attr_list_static {
272	my $self = shift;
273	my ($attr_name) = @_;
274
275	my $method  = $self->get_get_prefix.$attr_name."_list_static";
276	my $object  = $self->get_object;
277
278	return 1 if not $object->can($method);
279	return $object->$method();
280}
281
282sub get_attr_activity {
283	my $self = shift;
284	my ($attr_name) = @_;
285
286	$Gtk2::Ex::FormFactory::DEBUG &&
287	    print "    proxy->get_attr_activity($attr_name)\n";
288
289	my $object = $self->get_object;
290	return 0 if not defined $object;
291
292	my $attr_activity_href = $self->get_attr_activity_href;
293
294	return 1 if not $attr_activity_href or
295		    not exists $attr_activity_href->{$attr_name};
296
297	my $attr_activity = $attr_activity_href->{$attr_name};
298
299	return $attr_activity if not ref $attr_activity eq 'CODE';
300	return &$attr_activity($object);
301}
302
303sub object_changed {
304        my $self = shift;
305        my ($attr_name) = @_;
306
307        my $changes_attr_filter = $self->get_changes_attr_filter;
308
309        if ( !$changes_attr_filter ||
310             $attr_name !~ $changes_attr_filter ) {
311            $self->set_object_changed(1);
312            my $aggregated_by = $self->get_aggregated_by;
313            if ( $aggregated_by ) {
314                my $context = $self->get_context;
315                my ($object, $attr) = $context->norm_object_attr($aggregated_by);
316                $context->get_proxy($object)->object_changed($attr);
317            }
318        }
319
320        1;
321}
322
3231;
324
325__END__
326
327=head1 NAME
328
329Gtk2::Ex::FormFactory::Proxy - Proxy class for application objects
330
331=head1 SYNOPSIS
332
333  #-- Proxies are always created through
334  #-- Gtk2::Ex::FormFactory::Context, never
335  #-- directly by the application.
336
337  Gtk2::Ex::FormFactory::Proxy->new (
338    context              => Gtk2::Ex::FormFactory::Context,
339    object               => Object instance or CODEREF,
340    name                 => Name of this proxy,
341    set_prefix           => Method prefix for write accessors,
342    get_prefix           => Method prefix for read accessors,
343    attr_accessors_href  => Hashref with accessor callbacks,
344    attr_activity_href   => Hashref with activity callbacks,
345    aggregated_by        => Fully qualified attribute of the parent,
346    changes_attr_filter  => Regex for attributes which should not trigger
347                            the object's 'changed' status
348  );
349
350=head1 DESCRIPTION
351
352This class implements a generic proxy mechanism for accessing
353application objects and their attributes. It defines attributes
354of the associated object are accessed. You never instantiate
355objects of this class by yourself; they're created internally by
356Gtk2::Ex::FormFactory::Context when adding objects with the
357Context->add_object() method.
358
359But you may use the proxy objects e.g. for updates which affect the
360application object and the GUI as well.
361
362You can receive Proxy objects using the Gtk2::Ex::FormFactory::Context->get_proxy()
363method.
364
365=head1 OBJECT HIERARCHY
366
367  Gtk2::Ex::FormFactory::Proxy
368
369=head1 ATTRIBUTES
370
371Attributes are handled through the common get_ATTR(), set_ATTR()
372style accessors.
373
374=over 4
375
376=item B<context> = Gtk2::Ex::FormFactory::Context [mandatory]
377
378The Context this proxy belongs to.
379
380=item B<object> = Object instance | CODEREF
381
382The application object itself or a code reference, which returns
383the object instance.
384
385=item B<name> = SCALAR [mandatory]
386
387The Context wide unique name of this Proxy.
388
389=item B<set_prefix> = SCALAR [optional]
390
391This is the method prefix for write accessors. Defaults to B<set_>.
392
393=item B<get_prefix> = SCALAR [optional]
394
395This is the method prefix for read accessors. Defaults to B<get_>.
396
397=item B<attr_accessors_href> = HASHREF [optional]
398
399With this hash you can override specific accessors with a code
400reference, which is called instead of the object's own accessor.
401
402Refer to Gtk2::Ex::FormFactory::Context->add_object for details.
403
404=item B<attr_activity_href> = HASHREF [optional]
405
406This hash defines callbacks for attributes which return the
407activity state of the corresonding attribute.
408
409Refer to Gtk2::Ex::FormFactory::Context->add_object for details.
410
411=item B<aggregated_by> = "object.attr" [optional]
412
413Fully qualified attribute of the parent aggregating this object
414
415Refer to Gtk2::Ex::FormFactory::Context->add_object for details.
416
417=item B<changes_attr_filter> = REGEX [optional]
418
419Refer to Gtk2::Ex::FormFactory::Context->add_object for details.
420
421=item B<object_changed> = BOOLEAN
422
423This flag indicates whether the object represented by this Proxy
424was changed. You may set this attribute to reset the object's
425changed state.
426
427=back
428
429=head1 METHODS
430
431=over 4
432
433=item $app_object = $proxy->B<get_object> ()
434
435This returns the actual application object of this Proxy,
436either the statical assigned instance or a dynamicly retrieved
437instance.
438
439=item $proxy->B<set_object> ($object)
440
441Changes the application object instance in this Proxy. All dependend
442Widgets on the GUI are updated accordingly.
443
444=item $app_object_attr_value = $proxy->B<get_attr> ($attr)
445
446Returns the application object's attribute B<$attr> of this Proxy.
447
448If $attr has the form "object.attr" the attribute of the
449correspondent object is retreived, instead of the object associated
450with this proxy.
451
452=item $proxy->B<set_attr> ($attr => $value)
453
454Changes the application object's attribute B<$attr> to B<$value> and
455updates all dependend Widgets on the GUI accordingly.
456
457If $attr has the form "object.attr" the correspondent object
458will be updated, instead of the object associated with this proxy.
459
460=item $proxy->B<set_attrs> ( { $attr => $value, ... } )
461
462Changes a bunch of application object's attributes, which is passed
463as a hash reference with B<$attr =&gt; $value> pairs and
464updates all dependend Widgets on the GUI accordingly.
465
466=item $activity = $proxy->B<get_attr_activity> ($attr)
467
468Returns the current activity state of B<$attr>.
469
470=item
471
472=back
473
474=head1 AUTHORS
475
476 J�rn Reder <joern at zyn dot de>
477
478=head1 COPYRIGHT AND LICENSE
479
480Copyright 2004-2006 by J�rn Reder.
481
482This library is free software; you can redistribute it and/or modify
483it under the terms of the GNU Library General Public License as
484published by the Free Software Foundation; either version 2.1 of the
485License, or (at your option) any later version.
486
487This library is distributed in the hope that it will be useful, but
488WITHOUT ANY WARRANTY; without even the implied warranty of
489MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
490Library General Public License for more details.
491
492You should have received a copy of the GNU Library General Public
493License along with this library; if not, write to the Free Software
494Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307
495USA.
496
497=cut
498