lib/Net/DBus/RemoteService.pm

   1 # -*- perl -*-
   2 #
   3 # Copyright (C) 2004-2011 Daniel P. Berrange
   4 #
   5 # This program is free software; You can redistribute it and/or modify
   6 # it under the same terms as Perl itself. Either:
   7 #
   8 # a) the GNU General Public License as published by the Free
   9 #   Software Foundation; either version 2, or (at your option) any
  10 #   later version,
  11 #
  12 # or
  13 #
  14 # b) the "Artistic License"
  15 #
  16 # The file "COPYING" distributed along with this file provides full
  17 # details of the terms and conditions of the two licenses.
  18
  19 =pod
  20
  21 =head1 NAME
  22
  23 Net::DBus::RemoteService - Access services provided on the bus
  24
  25 =head1 SYNOPSIS
  26
  27   my $bus = Net::DBus->find;
  28   my $service = $bus->get_service("org.freedesktop.DBus");
  29
  30   my $object = $service->get_object("/org/freedesktop/DBus");
  31   foreach (@{$object->ListNames}) {
  32     print "$_\n";
  33   }
  34
  35 =head1 DESCRIPTION
  36
  37 This object provides a handle to a remote service on the
  38 bus. From this handle it is possible to access objects
  39 associated with the service. If a service is not running,
  40 an attempt will be made to activate it the first time a
  41 method is called against one of its objects.
  42
  43 =head1 METHODS
  44
  45 =over 4
  46
  47 =cut
  48
  49 package Net::DBus::RemoteService;
  50
  51 use 5.006;
  52 use strict;
  53 use warnings;
  54
  55 use Net::DBus::RemoteObject;
  56
  57 =item my $service = Net::DBus::RemoteService->new($bus, $owner, $service_name);
  58
  59 Creates a new handle for a remote service. The C<$bus> parameter is an
  60 instance of L<Net::DBus>, C<$owner> is the name of the client providing the
  61 service, while C<$service_name> is the well known name of the  service on
  62 the bus. Service names consist of two or more tokens, separated
  63 by periods, while the tokens comprise the letters a-z, A-Z, 0-9 and _,
  64 for example C<org.freedesktop.DBus>. There is generally no need to call
  65 this constructor, instead the C<get_service> method on L<Net::DBus> should
  66 be used. This caches handles to remote services, eliminating repeated
  67 retrieval of introspection data.
  68
  69 =cut
  70
  71 sub new {
  72     my $class = shift;
  73     my $self = {};
  74
  75     $self->{bus} = shift;
  76     $self->{owner_name} = shift;
  77     $self->{service_name} = shift;
  78     $self->{objects} = {};
  79
  80     bless $self, $class;
  81
  82     return $self;
  83 }
  84
  85
  86 =item my $bus = $service->get_bus;
  87
  88 Retrieves a handle for the bus to which this service is attached.
  89 The returned object will be an instance of L<Net::DBus>.
  90
  91 =cut
  92
  93 sub get_bus {
  94     my $self = shift;
  95
  96     return $self->{bus};
  97 }
  98
  99
 100 =item my $service_name = $service->get_service_name
 101
 102 Retrieves the name of the remote service as known to the bus.
 103
 104 =cut
 105
 106 sub get_service_name {
 107     my $self = shift;
 108     return $self->{service_name};
 109 }
 110
 111 =item my $owner_name = $service->get_owner_name;
 112
 113 Retrieves the name of the client owning the service at the
 114 time it was connected to.
 115
 116 =cut
 117
 118 sub get_owner_name {
 119     my $self = shift;
 120     return $self->{owner_name};
 121 }
 122
 123 =item my $object = $service->get_object($object_path[, $interface]);
 124
 125 Retrieves a handle to the remote object provided by the service  with
 126 the name of C<$object_path>. If the optional C<$interface> parameter is
 127 provided, the object will immediately be cast to the designated
 128 interface. NB, it is only neccessary to cast an object to a specific
 129 interface if there are multiple interfaces on the object providing
 130 methods with the same name, or the remote object does support
 131 introspection. The returned object will be an instance of L<Net::DBus::RemoteObject>.
 132
 133 =cut
 134
 135 sub get_object {
 136     my $self = shift;
 137     my $object_path = shift;
 138
 139     unless (defined $self->{objects}->{$object_path}) {
 140         $self->{objects}->{$object_path} = Net::DBus::RemoteObject->new($self,
 141                                                                         $object_path);
 142     }
 143
 144     if (@_) {
 145         my $interface = shift;
 146         return $self->{objects}->{$object_path}->as_interface($interface);
 147     } else {
 148         return $self->{objects}->{$object_path};
 149     }
 150 }
 151
 152 1;
 153
 154
 155 =pod
 156
 157 =back
 158
 159 =head1 AUTHOR
 160
 161 Daniel Berrange <dan@berrange.com>
 162
 163 =head1 COPYRIGHT
 164
 165 Copright (C) 2004-2011, Daniel Berrange.
 166
 167 =head1 SEE ALSO
 168
 169 L<Net::DBus::RemoteObject>, L<Net::DBus::Service>, L<Net::DBus>
 170
 171 =cut