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 / Server.pm < prev    next >
Encoding:
Perl POD Document  |  2006-02-19  |  5.7 KB  |  236 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: Server.pm,v 1.5 2006/01/27 15:34:24 dan Exp $
  20.  
  21. =pod
  22.  
  23. =head1 NAME
  24.  
  25. Net::DBus::Binding::Server - A server to accept incoming connections
  26.  
  27. =head1 SYNOPSIS
  28.  
  29. Creating a new server and accepting client connections
  30.  
  31.   use Net::DBus::Binding::Server;
  32.  
  33.   my $server = Net::DBus::Binding::Server->new(address => "unix:path=/path/to/socket");
  34.  
  35.   $server->connection_callback(\&new_connection);
  36.  
  37.   sub new_connection {
  38.       my $connection = shift;
  39.  
  40.       .. work with new connection...
  41.   }
  42.  
  43. Managing the server and new connections in an event loop
  44.  
  45.   my $reactor = Net::DBus::Binding::Reactor->new();
  46.  
  47.   $reactor->manage($server);
  48.   $reactor->run();
  49.  
  50.   sub new_connection {
  51.       my $connection = shift;
  52.  
  53.       $reactor->manage($connection);
  54.   }
  55.  
  56.  
  57. =head1 DESCRIPTION
  58.  
  59. A server for receiving connection from client programs.
  60. The methods defined on this module have a close
  61. correspondance to the dbus_server_XXX methods in the C API,
  62. so for further details on their behaviour, the C API documentation
  63. may be of use.
  64.  
  65. =head1 METHODS
  66.  
  67. =over 
  68.  
  69. =cut
  70.  
  71. package Net::DBus::Binding::Server;
  72.  
  73. use 5.006;
  74. use strict;
  75. use warnings;
  76. use Carp;
  77.  
  78. use Net::DBus;
  79. use Net::DBus::Binding::Connection;
  80.  
  81. =item my $server = Net::DBus::Binding::Server->new(address => "unix:path=/path/to/socket");
  82.  
  83. Creates a new server binding it to the socket specified by the
  84. C<address> parameter.
  85.  
  86. =cut
  87.  
  88. sub new {
  89.     my $proto = shift;
  90.     my $class = ref($proto) || $proto;
  91.     my %params = @_;
  92.     my $self = {};
  93.  
  94.     $self->{address} = exists $params{address} ? $params{address} : confess "address parameter is required";
  95.     $self->{server} = Net::DBus::Binding::Server::_open($self->{address});
  96.  
  97.     bless $self, $class;
  98.  
  99.     $self->{server}->_set_owner($self);
  100.  
  101.     $self->{_callback} = sub {
  102.     my $server = shift;
  103.     my $rawcon = shift;
  104.     my $con = Net::DBus::Binding::Connection->new(connection => $rawcon);
  105.  
  106.     if ($server->{connection_callback}) {
  107.         &{$server->{connection_callback}}($server, $con);
  108.     }
  109.     };
  110.  
  111.     return $self;
  112. }
  113.  
  114. =item $status = $server->is_connected();
  115.  
  116. Returns zero if the server has been disconnected,
  117. otherwise a positive value is returned.
  118.  
  119. =cut
  120.  
  121.  
  122. sub is_connected {
  123.     my $self = shift;
  124.     
  125.     return $self->{server}->dbus_server_get_is_connected();
  126. }
  127.  
  128. =item $server->disconnect()
  129.  
  130. Closes this server to the remote host. This method
  131. is called automatically during garbage collection (ie
  132. in the DESTROY method) if the programmer forgets to
  133. explicitly disconnect.
  134.  
  135. =cut
  136.  
  137. sub disconnect {
  138.     my $self = shift;
  139.     
  140.     return $self->{server}->dbus_server_disconnect();
  141. }
  142.  
  143.  
  144. =item $server->set_watch_callbacks(\&add_watch, \&remove_watch, \&toggle_watch);
  145.  
  146. Register a set of callbacks for adding, removing & updating 
  147. watches in the application's event loop. Each parameter
  148. should be a code reference, which on each invocation, will be
  149. supplied with two parameters, the server object and the
  150. watch object. If you are using a C<Net::DBus::Binding::Reactor> object
  151. as the application event loop, then the 'manage' method on
  152. that object will call this on your behalf.
  153.  
  154. =cut
  155.  
  156.  
  157. sub set_watch_callbacks {
  158.     my $self = shift;
  159.     my $add = shift;
  160.     my $remove = shift;
  161.     my $toggled = shift;
  162.  
  163.     $self->{add_watch} = $add;
  164.     $self->{remove_watch} = $remove;
  165.     $self->{toggled_watch} = $toggled;
  166.  
  167.     $self->{server}->_set_watch_callbacks();
  168. }
  169.  
  170. =item $server->set_timeout_callbacks(\&add_timeout, \&remove_timeout, \&toggle_timeout);
  171.  
  172. Register a set of callbacks for adding, removing & updating 
  173. timeouts in the application's event loop. Each parameter
  174. should be a code reference, which on each invocation, will be
  175. supplied with two parameters, the server object and the
  176. timeout object. If you are using a C<Net::DBus::Binding::Reactor> object
  177. as the application event loop, then the 'manage' method on
  178. that object will call this on your behalf.
  179.  
  180. =cut
  181.  
  182. sub set_timeout_callbacks {
  183.     my $self = shift;
  184.     my $add = shift;
  185.     my $remove = shift;
  186.     my $toggled = shift;
  187.  
  188.     $self->{add_timeout} = $add;
  189.     $self->{remove_timeout} = $remove;
  190.     $self->{toggled_timeout} = $toggled;
  191.  
  192.     $self->{server}->_set_timeout_callbacks();
  193. }
  194.  
  195. =item $server->set_connection_callback(\&handler)
  196.  
  197. Registers the handler to use for dealing with
  198. new incoming connections from clients. The code
  199. reference will be invoked each time a new client
  200. connects and supplied with a single parameter
  201. which is the C<Net::DBus::Binding::Connection> object representing
  202. the client.
  203.  
  204. =cut
  205.  
  206. sub set_connection_callback {
  207.     my $self = shift;
  208.     my $callback = shift;
  209.  
  210.     $self->{connection_callback} = $callback;
  211.  
  212.     $self->{server}->_set_connection_callback();
  213. }
  214.  
  215.  
  216. 1;
  217.  
  218.  
  219. =pod
  220.  
  221. =back
  222.  
  223. =head1 SEE ALSO
  224.  
  225. L<Net::DBus::Binding::Connection>, L<Net::DBus::Binding::Bus>, L<Net::DBus::Binding::Message::Signal>, L<Net::DBus::Binding::Message::MethodCall>, L<Net::DBus::Binding::Message::MethodReturn>, L<Net::DBus::Binding::Message::Error>
  226.  
  227. =head1 AUTHOR
  228.  
  229. Daniel Berrange E<lt>dan@berrange.comE<gt>
  230.  
  231. =head1 COPYRIGHT
  232.  
  233. Copyright 2004 by Daniel Berrange
  234.  
  235. =cut
  236.