[libnet-dbus-perl] 146/335: Rip out lamo-logic which tried to keep track of services & auto-update signals, because frankly it'll never work. A client will have to manage this manually, since there may be server side state it needs to worry about too
Intrigeri
intrigeri at moszumanska.debian.org
Sat Mar 21 01:07:40 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 b8fb6a448e7e38932aeeb0f08a28061fea362b57
Author: Daniel P. Berrange <dan at berrange.com>
Date: Sun Oct 23 15:34:12 2005 +0000
Rip out lamo-logic which tried to keep track of services & auto-update signals, because frankly it'll never work. A client will have to manage this manually, since there may be server side state it needs to worry about too
---
lib/Net/DBus.pm | 150 ++++++++++++------------------------------
lib/Net/DBus/Object.pm | 16 ++---
lib/Net/DBus/RemoteService.pm | 49 +++++++-------
3 files changed, 72 insertions(+), 143 deletions(-)
diff --git a/lib/Net/DBus.pm b/lib/Net/DBus.pm
index 3653a03..584ebf5 100644
--- a/lib/Net/DBus.pm
+++ b/lib/Net/DBus.pm
@@ -16,7 +16,7 @@
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
-# $Id: DBus.pm,v 1.18 2005/10/15 14:11:13 dan Exp $
+# $Id: DBus.pm,v 1.19 2005/10/23 16:34:12 dan Exp $
=pod
@@ -98,10 +98,11 @@ BEGIN {
}
use Net::DBus::Binding::Bus;
-use Net::DBus::Binding::Message;
use Net::DBus::Service;
use Net::DBus::RemoteService;
+use vars qw($bus_system $bus_session);
+
=pod
=item my $bus = Net::DBus->find(%params);
@@ -161,7 +162,10 @@ attached to the main L<Net::DBus::Reactor> event loop.
sub system {
my $class = shift;
- return $class->_new(Net::DBus::Binding::Bus->new(type => &Net::DBus::Binding::Bus::SYSTEM), @_);
+ unless ($bus_system) {
+ $bus_system = $class->_new(Net::DBus::Binding::Bus->new(type => &Net::DBus::Binding::Bus::SYSTEM), @_);
+ }
+ return $bus_system
}
=pod
@@ -178,7 +182,10 @@ attached to the main L<Net::DBus::Reactor> event loop.
sub session {
my $class = shift;
- return $class->_new(Net::DBus::Binding::Bus->new(type => &Net::DBus::Binding::Bus::SESSION), @_);
+ unless ($bus_session) {
+ $bus_session = $class->_new(Net::DBus::Binding::Bus->new(type => &Net::DBus::Binding::Bus::SESSION), @_);
+ }
+ return $bus_session;
}
=pod
@@ -224,79 +231,14 @@ sub _new {
}
$self->get_connection->add_filter(sub { $self->_signal_func(@_) });
-
- $self->_manage_names();
- return $self;
-}
-
-
-sub _manage_names {
- my $self = shift;
-
- $self->{services}->{"org.freedesktop.DBus"} = { online => 1 };
-
- my $bus = $self->get_bus_object;
-
- $bus->connect_to_signal("NameOwnerChanged", sub {
- my $name = shift;
- my $orig = shift;
- my $new = shift;
-
- if (exists $self->{services}->{$name}) {
- if ($self->{services}->{$name}->{instance}) {
- #warn "Already got an instance for $name, new owner is '$new'";
- $self->{services}->{$name}->{online} = $new ? 1 : 0;
- $self->{services}->{$name}->{owner} = $new;
- } else {
- if ($new) {
- #warn "Create new instance for $name with owner $new";
- $self->{services}->{$name}->{online} = 1;
- $self->{services}->{$name}->{owner} = $new;
- } else {
- #warn "Kill off instance $name";
- delete $self->{services}->{$name};
- }
- }
- } else {
- if ($new) {
- #warn "Got newservice $name";
- $self->{services}->{$name} = {
- online => 1,
- owner => $new
- };
- }
- }
- # Check for any signals we have against this service
- # because we'll need to update the match rule to reflect
- # the new client id
- foreach my $handler (@{$self->{signals}}) {
- if ($handler->[4] eq $name) {
- if ($orig) {
- # warn "Removing existing signal match " . $handler->[1];
- $self->{connection}->remove_match($handler->[1]);
- }
- if ($new) {
- my $rule = $self->_match_rule($handler->[2], $handler->[3], $handler->[4], $handler->[5]);
- $handler->[1] = $rule;
- # warn "Adding new signal match " . $handler->[1];
- $self->{connection}->add_match($handler->[1]);
- } else {
- # warn "Clearing signal match " . $handler->[1];
- $handler->[1] = undef;
- }
- }
- }
- });
-
- foreach (@{$bus->ListNames}) {
- $self->{services}->{$_} = { online => 1, owner => undef };
- }
-
+ # XXX is it ok to fix '1:0' as the owner of this ?
+ $self->{bus} = Net::DBus::RemoteService->new($self, ":1.0", "org.freedesktop.DBus");
return $self;
}
+
=pod
=item my $connection = $bus->connection;
@@ -328,35 +270,23 @@ sub get_service {
my $self = shift;
my $name = shift;
- if (!exists $self->{services}->{$name}) {
- $self->{services}->{$name} = { online => 0, owner => undef };
+ if ($name eq "org.freedesktop.DBus") {
+ return $self->{bus};
}
-
- if (!defined $self->{services}->{$name}->{instance}) {
- $self->{services}->{$name}->{instance} = Net::DBus::RemoteService->new($self, $name);
- }
-
- return $self->{services}->{$name}->{instance};
-}
-
-=pod
-
-=item my $bool = $bus->has_service($name);
-
-Returns a true value if the bus has an active service
-with a name of C<$name>. Returns a false value, if it
-does not. NB services can disappear from the bus at
-any time, so be prepared to handle failure at a later
-time, even if this method returns true.
-=cut
+ my $owner = $name;
+ if ($owner !~ /^:/) {
+ $owner = $self->get_service_owner($name);
+ if (!$owner) {
+ $self->get_bus_object->StartServiceByName($name, 0);
+ $owner = $self->get_service_owner($name);
+ }
+ }
-sub has_service {
- my $self = shift;
- my $name = shift;
-
- return exists $self->{services}->{$name} &&
- $self->{services}->{$name}->{online};
+ unless (exists $self->{services}->{$owner}) {
+ $self->{services}->{$owner} = Net::DBus::RemoteService->new($self, $owner, $name);
+ }
+ return $self->{services}->{$owner};
}
@@ -423,17 +353,19 @@ sub get_service_owner {
my $self = shift;
my $service = shift;
- if (!exists $self->{services}->{$service}) {
- $self->{services}->{$service} = { online => 0, owner => undef };
- }
-
- if (!defined $self->{services}->{$service}->{owner}) {
- my $bus = $self->get_bus_object;
- my $owner = $bus->GetNameOwner($service);
- $self->{services}->{$service}->{online} = 1;
- $self->{services}->{$service}->{owner} = $owner;
+ my $bus = $self->get_bus_object;
+ my $owner = eval {
+ $bus->GetNameOwner($service);
+ };
+ if ($@) {
+ if (UNIVERSAL::isa($@, "Net::DBus::Error") &&
+ $@->{name} eq "org.freedesktop.DBus.Error.NameHasNoOwner") {
+ $owner = undef;
+ } else {
+ die $@;
+ }
}
- return $self->{services}->{$service}->{owner};
+ return $owner;
}
@@ -581,7 +513,7 @@ Daniel Berrange <dan at berrange.com>
=head1 COPYRIGHT AND LICENSE
-Copyright 2004 by Daniel Berrange
+Copyright 2004-2005 by Daniel Berrange
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
diff --git a/lib/Net/DBus/Object.pm b/lib/Net/DBus/Object.pm
index c382f77..ada5ba9 100644
--- a/lib/Net/DBus/Object.pm
+++ b/lib/Net/DBus/Object.pm
@@ -16,7 +16,7 @@
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
-# $Id: Object.pm,v 1.17 2005/10/15 13:31:42 dan Exp $
+# $Id: Object.pm,v 1.18 2005/10/23 16:34:12 dan Exp $
=pod
@@ -348,14 +348,14 @@ sub _dispatch {
}
} elsif ($self->can($method_name)) {
my $ins = $self->_introspector;
- my @args;
- if ($ins) {
- @args = $ins->decode($message, "methods", $method_name, "params");
- } else {
- @args = $message->get_args_list;
- }
-
my @ret = eval {
+ my @args;
+ if ($ins) {
+ @args = $ins->decode($message, "methods", $method_name, "params");
+ } else {
+ @args = $message->get_args_list;
+ }
+
$self->$method_name(@args);
};
if ($@) {
diff --git a/lib/Net/DBus/RemoteService.pm b/lib/Net/DBus/RemoteService.pm
index 2de64f5..ff2f92c 100644
--- a/lib/Net/DBus/RemoteService.pm
+++ b/lib/Net/DBus/RemoteService.pm
@@ -16,7 +16,7 @@
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
-# $Id: RemoteService.pm,v 1.6 2005/10/15 13:31:42 dan Exp $
+# $Id: RemoteService.pm,v 1.7 2005/10/23 16:34:12 dan Exp $
=pod
@@ -29,11 +29,9 @@ Net::DBus::RemoteService - access services on the bus
my $bus = Net::DBus->find;
my $service = $bus->get_service("org.freedesktop.DBus");
- if ($service->is_online) {
- my $object = $service->get_object("/org/freedesktop/DBus");
- foreach (@{$object->ListNames}) {
- print "$_\n";
- }
+ my $object = $service->get_object("/org/freedesktop/DBus");
+ foreach (@{$object->ListNames}) {
+ print "$_\n";
}
=head1 DESCRIPTION
@@ -61,11 +59,12 @@ use Net::DBus::RemoteObject;
=pod
-=item my $service = Net::DBus::RemoteService->new($bus, $service_name);
+=item my $service = Net::DBus::RemoteService->new($bus, $owner, $service_name);
Creates a new handle for a remote service. The C<$bus> parameter is an
-instance of L<Net::DBus>, while C<$service_name> is the name of the
-service on the bus. Service names consist of two or more tokens, separated
+instance of L<Net::DBus>, C<$owner> is the name of the client providing the
+service, while C<$service_name> is the well known name of the service on
+the bus. Service names consist of two or more tokens, separated
by periods, while the tokens comprise the letters a-z, A-Z, 0-9 and _,
for example C<org.freedesktop.DBus>. There is generally no need to call
this constructor, instead the C<get_service> method on L<Net::DBus> should
@@ -79,6 +78,7 @@ sub new {
my $self = {};
$self->{bus} = shift;
+ $self->{owner_name} = shift;
$self->{service_name} = shift;
$self->{objects} = {};
@@ -90,23 +90,6 @@ sub new {
=pod
-=item my $boolean = $service->is_online
-
-Returns a true value if the service is currently attached to the
-the bus. If a false value is returned, then no client on the bus
-is currently provide this service, and the first method call
-made on a remote object will trigger the startup of the service.
-
-=cut
-
-sub is_online {
- my $self = shift;
-
- return $self->get_bus->has_service($self->get_service_name);
-}
-
-=pod
-
=item my $bus = $service->get_bus;
Retrieves a handle for the bus to which this service is attached.
@@ -136,6 +119,20 @@ sub get_service_name {
=pod
+=item my $owner_name = $service->get_owner_name;
+
+Retrieves the name of the client owning the service at the
+time it was connected to.
+
+=cut
+
+sub get_owner_name {
+ my $self = shift;
+ return $self->{owner_name};
+}
+
+=pod
+
=item my $object = $service->get_object($object_path[, $interface]);
Retrieves a handle to the remote object provided by the service with
--
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