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 <berra...@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

_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits

Reply via email to