[libnet-dbus-perl] 206/335: Allow subclassing of Net::DBus::Error for strong error handling
Intrigeri
intrigeri at moszumanska.debian.org
Sat Mar 21 01:07:57 UTC 2015
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 5bd2bcb62c287f4acfc4ecf94b6a7a5b8dd2f609
Author: Daniel P. Berrange <berrange at redhat.com>
Date: Sun Jul 2 16:37:49 2006 -0400
Allow subclassing of Net::DBus::Error for strong error handling
---
CHANGES | 8 +++
lib/Net/DBus.pm | 18 ------
lib/Net/DBus/Error.pm | 172 ++++++++++++++++++++++++++++++++++++++++++++++++++
t/70-errors.t | 57 +++++++++++++++++
4 files changed, 237 insertions(+), 18 deletions(-)
diff --git a/CHANGES b/CHANGES
index 45ba4bf..dbfcb34 100644
--- a/CHANGES
+++ b/CHANGES
@@ -11,6 +11,14 @@ Changes since 0.33.2
- Made all Perl scripts / modules / tests use 'strict' and
'warnings' pragmas
+ - Turn Net::DBus::Error into fully fledged object which services
+ can sub-class to allow explicit error handling by clients.
+
+ - In _dispatch method of Net::DBus::Object ensure that any
+ instances of Net::DBus::Error thrown by the method call
+ are explicitly serialized into DBus errors, rather than
+ a generic 'org.freedesktop.DBus.Failed'.
+
Changes since 0.33.1
- Fixed handling of variants in introspection data
diff --git a/lib/Net/DBus.pm b/lib/Net/DBus.pm
index bad07ad..3c79017 100644
--- a/lib/Net/DBus.pm
+++ b/lib/Net/DBus.pm
@@ -87,9 +87,6 @@ package Net::DBus;
use 5.006;
use strict;
use warnings;
-use Carp;
-
-
BEGIN {
our $VERSION = '0.33.3';
@@ -742,18 +739,3 @@ Copyright 2004-2005 by Daniel Berrange
=cut
1;
-
-package Net::DBus::Error;
-
-use strict;
-use warnings;
-use overload ('""' => 'stringify');
-
-sub stringify {
- my $self = shift;
-
- return $self->{name} . ": " . $self->{message} . ($self->{message} =~ /\n$/ ? "" : "\n");
-}
-
-
-1;
diff --git a/lib/Net/DBus/Error.pm b/lib/Net/DBus/Error.pm
new file mode 100644
index 0000000..df2179a
--- /dev/null
+++ b/lib/Net/DBus/Error.pm
@@ -0,0 +1,172 @@
+# -*- perl -*-
+#
+# Copyright (C) 2004-2006 Daniel P. Berrange
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# $Id: Error.pm,v 1.23 2006/02/03 13:30:14 dan Exp $
+
+=pod
+
+=head1 NAME
+
+Net::DBus::Error - Error details for remote method invocation
+
+=head1 SYNOPSIS
+
+ package Music::Player::UnknownFormat;
+
+ use base qw(Net::DBus::Error);
+
+ # Define an error type for unknown track encoding type
+ # for a music player service
+ sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = $class->SUPER::new(name => "org.example.music.UnknownFormat",
+ message => "Unknown track encoding format");
+ }
+
+
+ package Music::Player::Engine;
+
+ ...snip...
+
+ # Play either mp3 or ogg music tracks, otherwise
+ # thrown an error
+ sub play {
+ my $self = shift;
+ my $url = shift;
+
+ if ($url =~ /\.(mp3|ogg)$/) {
+ ...play the track
+ } else {
+ die Music::Player::UnknownFormat->new();
+ }
+ }
+
+
+=head1 DESCRIPTION
+
+This objects provides for strongly typed error handling. Normally
+a service would simply call
+
+ die "some message text"
+
+When returning the error condition to the calling DBus client, the
+message is associated with a generic error code or "org.freedesktop.DBus.Failed".
+While this suffices for many applications, occasionally it is desirable
+to be able to catch and handle specific error conditions. For such
+scenarios the service should create subclasses of the C<Net::DBus::Error>
+object providing in a custom error name. This error name is then sent back
+to the client instead of the genreic "org.freedesktop.DBus.Failed" code.
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Net::DBus::Error;
+
+use strict;
+use warnings;
+
+
+use overload ('""' => 'stringify');
+
+=item my $error = Net::DBus::Error->new(name => $error_name,
+ message => $description);
+
+Creates a new error object whose name is given by the C<name>
+parameter, and long descriptive text is provided by the
+C<message> parameter. The C<name> parameter has certain
+formatting rules which must be adhered to. It must only contain
+the letters 'a'-'Z', '0'-'9', '-', '_' and '.'. There must be
+at least two components separated by a '.', For example a valid
+name is 'org.example.Music.UnknownFormat'.
+
+=cut
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+ my %params = @_;
+
+ $self->{name} = $params{name} ? $params{name} : die "name parameter is required";
+ $self->{message} = $params{message} ? $params{message} : die "message parameter is required";
+
+ bless $self, $class;
+
+ return $self;
+}
+
+=item $error->name
+
+Returns the DBus error name associated with the object.
+
+=cut
+
+sub name {
+ my $self = shift;
+ return $self->{name};
+}
+
+=item $error->message
+
+Returns the descriptive text/message associated with the
+error condition.
+
+=cut
+
+sub message {
+ my $self = shift;
+ return $self->{message};
+}
+
+=item $error->stringify
+
+Formats the error as a string in a manner suitable for
+printing out / logging / displaying to the user, etc.
+
+=cut
+
+sub stringify {
+ my $self = shift;
+
+ return $self->{name} . ": " . $self->{message} . ($self->{message} =~ /\n$/ ? "" : "\n");
+}
+
+
+1;
+
+=pod
+
+=back
+
+=head1 AUTHORS
+
+Daniel P. Berrange
+
+=head1 COPYRIGHT
+
+Copyright (C) 2005-2006 Daniel P. Berrange
+
+=head1 SEE ALSO
+
+L<Net::DBus>, L<Net::DBus::Object>
+
+=cut
diff --git a/t/70-errors.t b/t/70-errors.t
new file mode 100644
index 0000000..3552591
--- /dev/null
+++ b/t/70-errors.t
@@ -0,0 +1,57 @@
+# -*- perl -*-
+use Test::More tests => 6;
+
+use strict;
+use warnings;
+
+BEGIN {
+ use_ok('Net::DBus');
+ use_ok('Net::DBus::Error');
+ use_ok('Net::DBus::Object');
+};
+
+package MyError;
+
+use base qw(Net::DBus::Error);
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = $class->SUPER::new(name => "org.example.music.UnknownFormat",
+ message => "Unknown track encoding format");
+}
+
+
+package MyObject;
+
+use base qw(Net::DBus::Object);
+use Net::DBus::Exporter qw(org.example.MyObject);
+
+dbus_method("play", ["string"], ["string"]);
+sub play {
+ my $self = shift;
+ my $url = shift;
+
+ if ($url =~ /\.(mp3|ogg)$/) {
+ return $url;
+ } else {
+ die MyError->new();
+ }
+}
+
+package main;
+
+my $bus = Net::DBus->test;
+my $service = $bus->export_service("org.cpan.Net.Bus.test");
+my $object = MyObject->new($service, "/org/example/MyObject");
+
+my $rservice = $bus->get_service("org.cpan.Net.Bus.test");
+my $robject = $rservice->get_object("/org/example/MyObject");
+
+eval {
+ $robject->play("foo.flac");
+};
+my $error = $@;
+isa_ok($error, "Net::DBus::Error");
+is($error->name, "org.example.music.UnknownFormat");
+is($error->message, "Unknown track encoding format");
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libnet-dbus-perl.git
More information about the Pkg-perl-cvs-commits
mailing list