[libnet-dbus-perl] 207/335: Remove use of Carp from modules, allowing calling code to turn Carp on/off interpreter wide
Intrigeri
intrigeri at moszumanska.debian.org
Sat Mar 21 01:07:58 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 7bc07005bb0b2997407a584d104fab256c1e1b35
Author: Daniel P. Berrange <berrange at redhat.com>
Date: Sun Jul 2 16:38:25 2006 -0400
Remove use of Carp from modules, allowing calling code to turn Carp on/off interpreter wide
---
lib/Net/DBus/Binding/Bus.pm | 7 +++----
lib/Net/DBus/Binding/Connection.pm | 5 ++---
lib/Net/DBus/Binding/Introspector.pm | 2 +-
lib/Net/DBus/Binding/Iterator.pm | 23 +++++++++++------------
lib/Net/DBus/Binding/Message.pm | 7 +++----
lib/Net/DBus/Binding/Message/Error.pm | 7 +++----
lib/Net/DBus/Binding/Message/MethodCall.pm | 9 ++++-----
lib/Net/DBus/Binding/Message/MethodReturn.pm | 3 +--
lib/Net/DBus/Binding/Message/Signal.pm | 7 +++----
lib/Net/DBus/Binding/PendingCall.pm | 3 +--
lib/Net/DBus/Binding/Server.pm | 3 +--
lib/Net/DBus/Binding/Watch.pm | 5 ++---
lib/Net/DBus/Callback.pm | 3 +--
lib/Net/DBus/Object.pm | 8 +++++---
lib/Net/DBus/Reactor.pm | 2 +-
lib/Net/DBus/RemoteObject.pm | 1 -
lib/Net/DBus/RemoteService.pm | 1 -
t/60-object-props.t | 2 +-
18 files changed, 43 insertions(+), 55 deletions(-)
diff --git a/lib/Net/DBus/Binding/Bus.pm b/lib/Net/DBus/Binding/Bus.pm
index 660314f..ebc708e 100644
--- a/lib/Net/DBus/Binding/Bus.pm
+++ b/lib/Net/DBus/Binding/Bus.pm
@@ -50,7 +50,6 @@ package Net::DBus::Binding::Bus;
use 5.006;
use strict;
use warnings;
-use Carp;
use Net::DBus;
@@ -78,7 +77,7 @@ sub new {
$connection = Net::DBus::Binding::Connection::_open($params{address});
$connection->dbus_bus_register();
} else {
- confess "either type or address parameter is required";
+ die "either type or address parameter is required";
}
my $self = $class->SUPER::new(%params, connection => $connection);
@@ -160,10 +159,10 @@ sub AUTOLOAD {
our $AUTOLOAD;
($constname = $AUTOLOAD) =~ s/.*:://;
- croak "&Net::DBus::Binding::Bus::constant not defined" if $constname eq '_constant';
+ die "&Net::DBus::Binding::Bus::constant not defined" if $constname eq '_constant';
if (!exists $Net::DBus::Binding::Bus::_constants{$constname}) {
- croak "no such method $constname, and no constant \$Net::DBus::Binding::Bus::$constname";
+ die "no such method $constname, and no constant \$Net::DBus::Binding::Bus::$constname";
}
{
diff --git a/lib/Net/DBus/Binding/Connection.pm b/lib/Net/DBus/Binding/Connection.pm
index c345622..ca852e9 100644
--- a/lib/Net/DBus/Binding/Connection.pm
+++ b/lib/Net/DBus/Binding/Connection.pm
@@ -74,7 +74,6 @@ package Net::DBus::Binding::Connection;
use 5.006;
use strict;
use warnings;
-use Carp;
use Net::DBus;
use Net::DBus::Binding::Message::MethodReturn;
@@ -93,7 +92,7 @@ sub new {
my %params = @_;
my $self = {};
- $self->{address} = exists $params{address} ? $params{address} : (exists $params{connection} ? "" : confess "address parameter is required");
+ $self->{address} = exists $params{address} ? $params{address} : (exists $params{connection} ? "" : die "address parameter is required");
$self->{connection} = exists $params{connection} ? $params{connection} : Net::DBus::Binding::Connection::_open($self->{address});
bless $self, $class;
@@ -207,7 +206,7 @@ sub send_with_reply_and_block {
return Net::DBus::Binding::Message::MethodReturn->new(call => $msg,
message => $reply);
} else {
- confess "unknown method reply type $type";
+ die "unknown method reply type $type";
}
}
diff --git a/lib/Net/DBus/Binding/Introspector.pm b/lib/Net/DBus/Binding/Introspector.pm
index fb66e1a..7d677da 100644
--- a/lib/Net/DBus/Binding/Introspector.pm
+++ b/lib/Net/DBus/Binding/Introspector.pm
@@ -55,7 +55,7 @@ package Net::DBus::Binding::Introspector;
use 5.006;
use strict;
use warnings;
-use Carp;
+
use XML::Twig;
use Net::DBus::Binding::Message;
diff --git a/lib/Net/DBus/Binding/Iterator.pm b/lib/Net/DBus/Binding/Iterator.pm
index 925e806..4b3c525 100644
--- a/lib/Net/DBus/Binding/Iterator.pm
+++ b/lib/Net/DBus/Binding/Iterator.pm
@@ -71,7 +71,6 @@ package Net::DBus::Binding::Iterator;
use 5.006;
use strict;
use warnings;
-use Carp qw(confess);
use Net::DBus;
@@ -188,25 +187,25 @@ from/to the message iterator
sub get_int64 {
my $self = shift;
- confess "Quads not supported on this platform\n" unless $have_quads;
+ die "Quads not supported on this platform\n" unless $have_quads;
return $self->_get_int64;
}
sub get_uint64 {
my $self = shift;
- confess "Quads not supported on this platform\n" unless $have_quads;
+ die "Quads not supported on this platform\n" unless $have_quads;
return $self->_get_uint64;
}
sub append_int64 {
my $self = shift;
- confess "Quads not supported on this platform\n" unless $have_quads;
+ die "Quads not supported on this platform\n" unless $have_quads;
$self->_append_int64(shift);
}
sub append_uint64 {
my $self = shift;
- confess "Quads not supported on this platform\n" unless $have_quads;
+ die "Quads not supported on this platform\n" unless $have_quads;
$self->_append_uint64(shift);
}
@@ -285,15 +284,15 @@ sub get {
} elsif ($type == &Net::DBus::Binding::Message::TYPE_VARIANT) {
return $self->get_variant();
} elsif ($type == &Net::DBus::Binding::Message::TYPE_DICT_ENTRY) {
- confess "dictionary can only occur as part of an array type";
+ die "dictionary can only occur as part of an array type";
} elsif ($type == &Net::DBus::Binding::Message::TYPE_INVALID) {
- confess "cannot handle Net::DBus::Binding::Message::TYPE_INVALID";
+ die "cannot handle Net::DBus::Binding::Message::TYPE_INVALID";
} elsif ($type == &Net::DBus::Binding::Message::TYPE_OBJECT_PATH) {
return $self->get_object_path();
} elsif ($type == &Net::DBus::Binding::Message::TYPE_SIGNATURE) {
return $self->get_signature();
} else {
- confess "unknown argument type '" . chr($type) . "' ($type)";
+ die "unknown argument type '" . chr($type) . "' ($type)";
}
}
@@ -313,7 +312,7 @@ sub get_dict {
while ($type == &Net::DBus::Binding::Message::TYPE_DICT_ENTRY) {
my $entry = $iter->get_struct();
if ($#{$entry} != 1) {
- confess "Dictionary entries must be structs of 2 elements. This entry has " . ($#{$entry}+1) ." elements";
+ die "Dictionary entries must be structs of 2 elements. This entry has " . ($#{$entry}+1) ." elements";
}
$dict->{$entry->[0]} = $entry->[1];
@@ -339,7 +338,7 @@ sub get_array {
my $array = [];
while ($type != &Net::DBus::Binding::Message::TYPE_INVALID) {
if ($type != $array_type) {
- confess "Element $type not of array type $array_type";
+ die "Element $type not of array type $array_type";
}
my $value = $iter->get($type);
@@ -435,7 +434,7 @@ sub append {
} elsif ($maintype == &Net::DBus::Binding::Message::TYPE_VARIANT) {
$self->append_variant($value, $subtype);
} else {
- confess "Unsupported compound type ", $maintype, " ('", chr($maintype), "')";
+ die "Unsupported compound type ", $maintype, " ('", chr($maintype), "')";
}
} else {
# XXX is this good idea or not
@@ -466,7 +465,7 @@ sub append {
} elsif ($type == &Net::DBus::Binding::Message::TYPE_SIGNATURE) {
$self->append_signature($value);
} else {
- confess "Unsupported scalar type ", $type, " ('", chr($type), "')";
+ die "Unsupported scalar type ", $type, " ('", chr($type), "')";
}
}
}
diff --git a/lib/Net/DBus/Binding/Message.pm b/lib/Net/DBus/Binding/Message.pm
index 0ecbdab..3e75bee 100644
--- a/lib/Net/DBus/Binding/Message.pm
+++ b/lib/Net/DBus/Binding/Message.pm
@@ -146,7 +146,6 @@ package Net::DBus::Binding::Message;
use 5.006;
use strict;
use warnings;
-use Carp;
use Net::DBus::Binding::Iterator;
use Net::DBus::Binding::Message::Signal;
@@ -170,7 +169,7 @@ sub new {
my $self = {};
$self->{message} = exists $params{message} ? $params{message} :
- (Net::DBus::Binding::Message::_create(exists $params{type} ? $params{type} : confess "type parameter is required"));
+ (Net::DBus::Binding::Message::_create(exists $params{type} ? $params{type} : die "type parameter is required"));
bless $self, $class;
@@ -431,10 +430,10 @@ sub AUTOLOAD {
our $AUTOLOAD;
($constname = $AUTOLOAD) =~ s/.*:://;
- croak "&Net::DBus::Binding::Message::constant not defined" if $constname eq '_constant';
+ die "&Net::DBus::Binding::Message::constant not defined" if $constname eq '_constant';
if (!exists $Net::DBus::Binding::Message::_constants{$constname}) {
- croak "no such constant \$Net::DBus::Binding::Message::$constname";
+ die "no such constant \$Net::DBus::Binding::Message::$constname";
}
{
diff --git a/lib/Net/DBus/Binding/Message/Error.pm b/lib/Net/DBus/Binding/Message/Error.pm
index 2030256..6de0752 100644
--- a/lib/Net/DBus/Binding/Message/Error.pm
+++ b/lib/Net/DBus/Binding/Message/Error.pm
@@ -56,7 +56,6 @@ package Net::DBus::Binding::Message::Error;
use 5.006;
use strict;
use warnings;
-use Carp;
use Net::DBus;
use base qw(Net::DBus::Binding::Message);
@@ -77,14 +76,14 @@ sub new {
my $class = ref($proto) || $proto;
my %params = @_;
- my $replyto = exists $params{replyto} ? $params{replyto} : confess "replyto parameter is required";
+ my $replyto = exists $params{replyto} ? $params{replyto} : die "replyto parameter is required";
my $msg = exists $params{message} ? $params{message} :
Net::DBus::Binding::Message::Error::_create
(
$replyto->{message},
- ($params{name} ? $params{name} : confess "name parameter is required"),
- ($params{description} ? $params{description} : confess "description parameter is required"));
+ ($params{name} ? $params{name} : die "name parameter is required"),
+ ($params{description} ? $params{description} : die "description parameter is required"));
my $self = $class->SUPER::new(message => $msg);
diff --git a/lib/Net/DBus/Binding/Message/MethodCall.pm b/lib/Net/DBus/Binding/Message/MethodCall.pm
index c7c6b05..5b5a0fd 100644
--- a/lib/Net/DBus/Binding/Message/MethodCall.pm
+++ b/lib/Net/DBus/Binding/Message/MethodCall.pm
@@ -47,7 +47,6 @@ package Net::DBus::Binding::Message::MethodCall;
use 5.006;
use strict;
use warnings;
-use Carp;
use Net::DBus;
use base qw(Exporter Net::DBus::Binding::Message);
@@ -72,10 +71,10 @@ sub new {
my $msg = exists $params{message} ? $params{message} :
Net::DBus::Binding::Message::MethodCall::_create
(
- ($params{service_name} ? $params{service_name} : confess "service_name parameter is required"),
- ($params{object_path} ? $params{object_path} : confess "object_path parameter is required"),
- ($params{interface} ? $params{interface} : confess "interface parameter is required"),
- ($params{method_name} ? $params{method_name} : confess "method_name parameter is required"));
+ ($params{service_name} ? $params{service_name} : die "service_name parameter is required"),
+ ($params{object_path} ? $params{object_path} : die "object_path parameter is required"),
+ ($params{interface} ? $params{interface} : die "interface parameter is required"),
+ ($params{method_name} ? $params{method_name} : die "method_name parameter is required"));
my $self = $class->SUPER::new(message => $msg);
diff --git a/lib/Net/DBus/Binding/Message/MethodReturn.pm b/lib/Net/DBus/Binding/Message/MethodReturn.pm
index 766cfb9..148aba7 100644
--- a/lib/Net/DBus/Binding/Message/MethodReturn.pm
+++ b/lib/Net/DBus/Binding/Message/MethodReturn.pm
@@ -45,7 +45,6 @@ package Net::DBus::Binding::Message::MethodReturn;
use 5.006;
use strict;
use warnings;
-use Carp;
use Net::DBus;
use base qw(Exporter Net::DBus::Binding::Message);
@@ -63,7 +62,7 @@ sub new {
my $class = ref($proto) || $proto;
my %params = @_;
- my $call = exists $params{call} ? $params{call} : confess "call parameter is required";
+ my $call = exists $params{call} ? $params{call} : die "call parameter is required";
my $msg = exists $params{message} ? $params{message} :
Net::DBus::Binding::Message::MethodReturn::_create($call->{message});
diff --git a/lib/Net/DBus/Binding/Message/Signal.pm b/lib/Net/DBus/Binding/Message/Signal.pm
index ce3c241..aa62381 100644
--- a/lib/Net/DBus/Binding/Message/Signal.pm
+++ b/lib/Net/DBus/Binding/Message/Signal.pm
@@ -56,7 +56,6 @@ package Net::DBus::Binding::Message::Signal;
use 5.006;
use strict;
use warnings;
-use Carp;
use Net::DBus;
use base qw(Net::DBus::Binding::Message);
@@ -81,9 +80,9 @@ sub new {
my $msg = exists $params{message} ? $params{message} :
Net::DBus::Binding::Message::Signal::_create
(
- ($params{object_path} ? $params{object_path} : confess "object_path parameter is required"),
- ($params{interface} ? $params{interface} : confess "interface parameter is required"),
- ($params{signal_name} ? $params{signal_name} : confess "signal_name parameter is required"));
+ ($params{object_path} ? $params{object_path} : die "object_path parameter is required"),
+ ($params{interface} ? $params{interface} : die "interface parameter is required"),
+ ($params{signal_name} ? $params{signal_name} : die "signal_name parameter is required"));
my $self = $class->SUPER::new(message => $msg);
diff --git a/lib/Net/DBus/Binding/PendingCall.pm b/lib/Net/DBus/Binding/PendingCall.pm
index 27a3759..673e4b5 100644
--- a/lib/Net/DBus/Binding/PendingCall.pm
+++ b/lib/Net/DBus/Binding/PendingCall.pm
@@ -52,7 +52,6 @@ package Net::DBus::Binding::PendingCall;
use 5.006;
use strict;
use warnings;
-use Carp;
use Net::DBus;
use Net::DBus::Binding::Message::MethodReturn;
@@ -141,7 +140,7 @@ sub get_reply {
return Net::DBus::Binding::Message::MethodReturn->new(call => $self->{method_call},
message => $reply);
} else {
- confess "unknown method reply type $type";
+ die "unknown method reply type $type";
}
}
diff --git a/lib/Net/DBus/Binding/Server.pm b/lib/Net/DBus/Binding/Server.pm
index c0ecd84..4008076 100644
--- a/lib/Net/DBus/Binding/Server.pm
+++ b/lib/Net/DBus/Binding/Server.pm
@@ -73,7 +73,6 @@ package Net::DBus::Binding::Server;
use 5.006;
use strict;
use warnings;
-use Carp;
use Net::DBus;
use Net::DBus::Binding::Connection;
@@ -91,7 +90,7 @@ sub new {
my %params = @_;
my $self = {};
- $self->{address} = exists $params{address} ? $params{address} : confess "address parameter is required";
+ $self->{address} = exists $params{address} ? $params{address} : die "address parameter is required";
$self->{server} = Net::DBus::Binding::Server::_open($self->{address});
bless $self, $class;
diff --git a/lib/Net/DBus/Binding/Watch.pm b/lib/Net/DBus/Binding/Watch.pm
index 387e86e..76bcd5b 100644
--- a/lib/Net/DBus/Binding/Watch.pm
+++ b/lib/Net/DBus/Binding/Watch.pm
@@ -31,7 +31,6 @@ package Net::DBus::Binding::Watch;
use 5.006;
use strict;
use warnings;
-use Carp;
use Net::DBus;
@@ -43,10 +42,10 @@ sub AUTOLOAD {
our $AUTOLOAD;
($constname = $AUTOLOAD) =~ s/.*:://;
- croak "&Net::DBus::Binding::Watch::constant not defined" if $constname eq '_constant';
+ die "&Net::DBus::Binding::Watch::constant not defined" if $constname eq '_constant';
if (!exists $Net::DBus::Binding::Watch::_constants{$constname}) {
- croak "no such constant \$Net::DBus::Binding::Watch::$constname";
+ die "no such constant \$Net::DBus::Binding::Watch::$constname";
}
{
diff --git a/lib/Net/DBus/Callback.pm b/lib/Net/DBus/Callback.pm
index 591e763..52a2a4a 100644
--- a/lib/Net/DBus/Callback.pm
+++ b/lib/Net/DBus/Callback.pm
@@ -62,7 +62,6 @@ package Net::DBus::Callback;
use 5.006;
use strict;
use warnings;
-use Carp qw(confess);
=item my $cb = Net::DBus::Callback->new(method => $name, [args => \@args])
@@ -88,7 +87,7 @@ sub new {
my $self = {};
$self->{object} = $params{object} ? $params{object} : undef;
- $self->{method} = $params{method} ? $params{method} : confess "method parameter is required";
+ $self->{method} = $params{method} ? $params{method} : die "method parameter is required";
$self->{args} = $params{args} ? $params{args} : [];
bless $self, $class;
diff --git a/lib/Net/DBus/Object.pm b/lib/Net/DBus/Object.pm
index 5269bd5..a0e78a7 100644
--- a/lib/Net/DBus/Object.pm
+++ b/lib/Net/DBus/Object.pm
@@ -117,7 +117,6 @@ package Net::DBus::Object;
use 5.006;
use strict;
use warnings;
-use Carp;
our $ENABLE_INTROSPECT;
@@ -482,9 +481,11 @@ sub _dispatch {
$self->$method_name(@args);
};
if ($@) {
+ my $name = UNIVERSAL::isa($@, "Net::DBus::Error") ? $@->name : "org.freedesktop.DBus.Error.Failed";
+ my $desc = UNIVERSAL::isa($@, "Net::DBus::Error") ? $@->message : $@;
$reply = Net::DBus::Binding::Message::Error->new(replyto => $message,
- name => "org.freedesktop.DBus.Error.Failed",
- description => $@);
+ name => $name,
+ description => $desc);
} else {
$reply = Net::DBus::Binding::Message::MethodReturn->new(call => $message);
if ($ins) {
@@ -602,6 +603,7 @@ sub _dispatch_prop_write {
}
}
+
sub _introspector {
my $self = shift;
diff --git a/lib/Net/DBus/Reactor.pm b/lib/Net/DBus/Reactor.pm
index cf01156..168bf06 100644
--- a/lib/Net/DBus/Reactor.pm
+++ b/lib/Net/DBus/Reactor.pm
@@ -118,7 +118,7 @@ package Net::DBus::Reactor;
use 5.006;
use strict;
use warnings;
-use Carp;
+
use Net::DBus::Binding::Watch;
use Net::DBus::Callback;
use Time::HiRes qw(gettimeofday);
diff --git a/lib/Net/DBus/RemoteObject.pm b/lib/Net/DBus/RemoteObject.pm
index 9f3375b..2ae9afa 100644
--- a/lib/Net/DBus/RemoteObject.pm
+++ b/lib/Net/DBus/RemoteObject.pm
@@ -54,7 +54,6 @@ package Net::DBus::RemoteObject;
use 5.006;
use strict;
use warnings;
-use Carp;
our $AUTOLOAD;
diff --git a/lib/Net/DBus/RemoteService.pm b/lib/Net/DBus/RemoteService.pm
index 365e1f4..390930d 100644
--- a/lib/Net/DBus/RemoteService.pm
+++ b/lib/Net/DBus/RemoteService.pm
@@ -53,7 +53,6 @@ package Net::DBus::RemoteService;
use 5.006;
use strict;
use warnings;
-use Carp;
use Net::DBus::RemoteObject;
diff --git a/t/60-object-props.t b/t/60-object-props.t
index d812883..1923147 100644
--- a/t/60-object-props.t
+++ b/t/60-object-props.t
@@ -43,7 +43,7 @@ dbus_property("age", "int32" ,"write");
package main;
my $bus = Net::DBus->test;
-my $service = $bus->export_service("/org/cpan/Net/Bus/test");
+my $service = $bus->export_service("org.cpan.Net.Bus.test");
my $object = MyObject->new($service, "/org/example/MyObject");
my $introspector = $object->_introspector;
--
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