[libnet-dbus-perl] 303/335: Refactor dispatching of properties to be overridable

[Intrigeri]

This is an automated email from the git hooks/post-receive script.

intrigeri pushed a commit to branch experimental
in repository libnet-dbus-perl.

commit 24ef5d13f3dea8423cb176238e6570db7081559b
Author: Daniel P. Berrange <dan at berrange.com>
Date:   Sun Nov 6 14:21:41 2011 +0000

    Refactor dispatching of properties to be overridable
---
 lib/Net/DBus/BaseObject.pm  | 70 ++++++++++++++++++++++++++-------------------
 lib/Net/DBus/Object.pm      | 12 ++++++++
 lib/Net/DBus/ProxyObject.pm | 12 ++++++++
 3 files changed, 64 insertions(+), 30 deletions(-)

diff --git a/lib/Net/DBus/BaseObject.pm b/lib/Net/DBus/BaseObject.pm
index 9815f60..e3b5dda 100644
--- a/lib/Net/DBus/BaseObject.pm
+++ b/lib/Net/DBus/BaseObject.pm
@@ -492,6 +492,28 @@ sub _dispatch_object {
     return 0;
 }
 
+
+=item $currvalue = $object->_dispatch_property($name);
+=item $object->_dispatch_property($name, $newvalue);
+
+The C<_dispatch_property> method is to be used to handle dispatch
+of property reads and writes. The C<$name> parameter is the name
+of the property being accessed. If C<$newvalue> is supplied then
+the property is to be updated, otherwise the current value is to
+be returned. The default implementation will simply raise an
+error, so must be overriden in subclasses.
+
+=cut
+
+sub _dispatch_property {
+    my $self = shift;
+    my $name = shift;
+    my $value = shift;
+
+    die "No method for property $name";
+}
+
+
 sub _dispatch_prop_read {
     my $self = shift;
     my $connection = shift;
@@ -519,24 +541,18 @@ sub _dispatch_prop_read {
 					       "property '$pname' in interface '$pinterface' is not readable");
     }
 
-    if ($self->can($pname)) {
-	my $value = eval {
-	    $self->$pname;
-	};
-	if ($@) {
-	    return $connection->make_error_message($message,
-						   "org.freedesktop.DBus.Error.Failed",
-						   "error reading '$pname' in interface '$pinterface': $@");
-	} else {
-	    my $reply = $connection->make_method_return_message($message);
-
-	    $self->_introspector->encode($reply, "methods", "Get", "returns", $value);
-	    return $reply;
-	}
-    } else {
+    my $value = eval {
+	$self->_dispatch_property($pname);
+    };
+    if ($@) {
 	return $connection->make_error_message($message,
 					       "org.freedesktop.DBus.Error.Failed",
-					       "no method to read property '$pname' in interface '$pinterface'");
+					       "error reading '$pname' in interface '$pinterface': $@");
+    } else {
+	my $reply = $connection->make_method_return_message($message);
+	
+	$self->_introspector->encode($reply, "methods", "Get", "returns", $value);
+	return $reply;
     }
 }
 
@@ -562,7 +578,7 @@ sub _dispatch_all_prop_read {
 	}
 
 	$values{$pname} = eval {
-	    $self->$pname;
+	    $self->_dispatch_property($pname);
 	};
 	if ($@) {
 	    return $connection->make_error_message($message,
@@ -604,21 +620,15 @@ sub _dispatch_prop_write {
 					       "property '$pname' in interface '$pinterface' is not writable");
     }
 
-    if ($self->can($pname)) {
-	eval {
-	    $self->$pname($pvalue);
-	};
-	if ($@) {
-	    return $connection->make_error_message($message,
-						   "org.freedesktop.DBus.Error.Failed",
-						   "error writing '$pname' in interface '$pinterface': $@");
-	} else {
-	    return $connection->make_method_return_message($message);
-	}
-    } else {
+    eval {
+	$self->_dispatch_property($pname, $pvalue);
+    };
+    if ($@) {
 	return $connection->make_error_message($message,
 					       "org.freedesktop.DBus.Error.Failed",
-					       "no method to write property '$pname' in interface '$pinterface'");
+					       "error writing '$pname' in interface '$pinterface': $@");
+    } else {
+	return $connection->make_method_return_message($message);
     }
 }
 
diff --git a/lib/Net/DBus/Object.pm b/lib/Net/DBus/Object.pm
index 7d06db7..2e97260 100644
--- a/lib/Net/DBus/Object.pm
+++ b/lib/Net/DBus/Object.pm
@@ -183,6 +183,18 @@ sub _dispatch_object {
 }
 
 
+sub _dispatch_property {
+    my $self = shift;
+    my $name = shift;
+
+    if (!$self->can($name)) {
+	die "no method to for property '$name'";
+    }
+
+    return $self->$name(@_);
+}
+
+
 sub _is_method_allowed {
     my $self = shift;
     my $method = shift;
diff --git a/lib/Net/DBus/ProxyObject.pm b/lib/Net/DBus/ProxyObject.pm
index dde83f3..cc94236 100644
--- a/lib/Net/DBus/ProxyObject.pm
+++ b/lib/Net/DBus/ProxyObject.pm
@@ -224,6 +224,18 @@ sub _dispatch_object {
 }
 
 
+sub _dispatch_property {
+    my $self = shift;
+    my $name = shift;
+
+    if (!$self->{impl}->can($name)) {
+	die "no method to for property '$name'";
+    }
+
+    return $self->{impl}->$name(@_);
+}
+
+
 sub _is_method_allowed {
     my $self = shift;
     my $method = shift;

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libnet-dbus-perl.git