home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / lib / perl5 / Net / DBus / Binding / Bus.pm next >
Encoding:
Perl POD Document  |  2006-02-19  |  4.4 KB  |  195 lines
  1. # -*- perl -*-
  2. #
  3. # Copyright (C) 2004-2005 Daniel P. Berrange
  4. #
  5. # This program is free software; you can redistribute it and/or modify
  6. # it under the terms of the GNU General Public License as published by
  7. # the Free Software Foundation; either version 2 of the License, or
  8. # (at your option) any later version.
  9. #
  10. # This program is distributed in the hope that it will be useful,
  11. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13. # GNU General Public License for more details.
  14. #
  15. # You should have received a copy of the GNU General Public License
  16. # along with this program; if not, write to the Free Software
  17. # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18. #
  19. # $Id: Bus.pm,v 1.11 2006/01/27 15:34:24 dan Exp $
  20.  
  21. =pod
  22.  
  23. =head1 NAME
  24.  
  25. Net::DBus::Binding::Bus - Handle to a well-known message bus instance
  26.  
  27. =head1 SYNOPSIS
  28.  
  29.   use Net::DBus::Binding::Bus;
  30.  
  31.   # Get a handle to the system bus
  32.   my $bus = Net::DBus::Binding::Bus->new(type => &Net::DBus::Binding::Bus::SYSTEM);
  33.  
  34. =head1 DESCRIPTION
  35.  
  36. This is a specialization of the L<Net::DBus::Binding::Connection>
  37. module providing convenience constructor for connecting to one of
  38. the well-known bus types. There is no reason to use this module
  39. directly, instead get a handle to the bus with the C<session> or
  40. C<system> methods in L<Net::DBus>.
  41.  
  42. =head1 METHODS
  43.  
  44. =over 4
  45.  
  46. =cut
  47.  
  48. package Net::DBus::Binding::Bus;
  49.  
  50. use 5.006;
  51. use strict;
  52. use warnings;
  53. use Carp;
  54.  
  55. use Net::DBus;
  56.  
  57. use base qw(Net::DBus::Binding::Connection);
  58.  
  59. =item my $bus = Net::DBus::Binding::Bus->new(type => $type);
  60.  
  61. =item my $bus = Net::DBus::Binding::Bus->new(address => $addr);
  62.  
  63. Open a connection to a message bus, either a well known bus type
  64. specified using the C<type> parameter, or an arbitrary bus specified
  65. using the C<address> parameter.
  66.  
  67. =cut
  68.  
  69. sub new {
  70.     my $proto = shift;
  71.     my $class = ref($proto) || $proto;
  72.     my %params = @_;
  73.     
  74.     my $connection;
  75.     if (defined $params{type}) {
  76.     $connection = Net::DBus::Binding::Bus::_open($params{type});
  77.     } elsif (defined $params{address}) {
  78.     $connection = Net::DBus::Binding::Connection::_open($params{address});
  79.     $connection->dbus_bus_register();
  80.     } else {
  81.     confess "either type or address parameter is required";
  82.     }
  83.       
  84.     my $self = $class->SUPER::new(%params, connection => $connection);
  85.  
  86.     bless $self, $class;
  87.  
  88.     return $self;
  89. }
  90.  
  91.  
  92. =item $bus->request_name($service_name)
  93.  
  94. Send a request to the bus registering the well known name 
  95. specified in the C<$service_name> parameter. If another client
  96. already owns the name, registration will be queued up, pending
  97. the exit of the other client.
  98.  
  99. =cut
  100.  
  101. sub request_name {
  102.     my $self = shift;
  103.     my $service_name = shift;
  104.     
  105.     $self->{connection}->dbus_bus_request_name($service_name);
  106. }
  107.  
  108. =item my $name = $bus->get_unique_name
  109.  
  110. Returns the unique name by which this processes' connection to
  111. the bus is known. Unique names are never re-used for the entire
  112. lifetime of the bus daemon.
  113.  
  114. =cut
  115.  
  116. sub get_unique_name {
  117.     my $self = shift;
  118.  
  119.     $self->{connection}->dbus_bus_get_unique_name;
  120. }
  121.  
  122.  
  123. =item $bus->add_match($rule)
  124.  
  125. Register a signal match rule with the bus controller, allowing
  126. matching broadcast signals to routed to this client.
  127.  
  128. =cut
  129.  
  130. sub add_match {
  131.     my $self = shift;
  132.     my $rule = shift;
  133.     
  134.     $self->{connection}->dbus_bus_add_match($rule);
  135. }
  136.  
  137. =item $bus->remove_match($rule)
  138.  
  139. Unregister a signal match rule with the bus controller, preventing
  140. further broadcast signals being routed to this client
  141.  
  142. =cut
  143.  
  144. sub remove_match {
  145.     my $self = shift;
  146.     my $rule = shift;
  147.     
  148.     $self->{connection}->dbus_bus_remove_match($rule);
  149. }
  150.  
  151. sub DESTROY {
  152.     # Keep autoloader quiet
  153. }
  154.  
  155. sub AUTOLOAD {
  156.     # This AUTOLOAD is used to 'autoload' constants from the constant()
  157.     # XS function.
  158.  
  159.     my $constname;
  160.     our $AUTOLOAD;
  161.     ($constname = $AUTOLOAD) =~ s/.*:://;
  162.  
  163.     croak "&Net::DBus::Binding::Bus::constant not defined" if $constname eq '_constant';
  164.  
  165.     if (!exists $Net::DBus::Binding::Bus::_constants{$constname}) {
  166.         croak "no such method $constname, and no constant \$Net::DBus::Binding::Bus::$constname";
  167.     }
  168.  
  169.     {
  170.     no strict 'refs';
  171.     *$AUTOLOAD = sub { $Net::DBus::Binding::Bus::_constants{$constname} };
  172.     }
  173.     goto &$AUTOLOAD;
  174. }
  175.  
  176. 1;
  177.  
  178. =pod
  179.  
  180. =back
  181.  
  182. =head1 SEE ALSO
  183.  
  184. L<Net::DBus::Binding::Connection>, L<Net::DBus>
  185.  
  186. =head1 AUTHOR
  187.  
  188. Daniel Berrange E<lt>dan@berrange.comE<gt>
  189.  
  190. =head1 COPYRIGHT
  191.  
  192. Copyright 2004-2005 by Daniel Berrange
  193.  
  194. =cut
  195.