# -*- perl -*-
#
# Copyright (C) 2004-2011 Daniel P. Berrange
#
# This program is free software; You can redistribute it and/or modify
# it under the same terms as Perl itself. Either:
#
# a) the GNU General Public License as published by the Free
# Software Foundation; either version 2, or (at your option) any
# later version,
#
# or
#
# b) the "Artistic License"
#
# The file "COPYING" distributed along with this file provides full
# details of the terms and conditions of the two licenses.
=pod
=head1 NAME
Net::DBus::Binding::Server - A server to accept incoming connections
=head1 SYNOPSIS
Creating a new server and accepting client connections
use Net::DBus::Binding::Server;
my $server = Net::DBus::Binding::Server->new(address => "unix:path=/path/to/socket");
$server->connection_callback(\&new_connection);
sub new_connection {
my $connection = shift;
.. work with new connection...
}
Managing the server and new connections in an event loop
my $reactor = Net::DBus::Binding::Reactor->new();
$reactor->manage($server);
$reactor->run();
sub new_connection {
my $connection = shift;
$reactor->manage($connection);
}
=head1 DESCRIPTION
A server for receiving connection from client programs.
The methods defined on this module have a close
correspondence to the dbus_server_XXX methods in the C API,
so for further details on their behaviour, the C API documentation
may be of use.
=head1 METHODS
=over
=cut
package Net::DBus::Binding::Server;
use 5.006;
use strict;
use warnings;
use Net::DBus;
use Net::DBus::Binding::Connection;
=item my $server = Net::DBus::Binding::Server->new(address => "unix:path=/path/to/socket");
Creates a new server binding it to the socket specified by the
C<address> parameter.
=cut
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my %params = @_;
my $self = {};
$self->{address} = exists $params{address} ? $params{address} : die "address parameter is required";
$self->{server} = Net::DBus::Binding::Server::_open($self->{address});
bless $self, $class;
$self->{server}->_set_owner($self);
$self->{_callback} = sub {
my $server = shift;
my $rawcon = shift;
my $con = Net::DBus::Binding::Connection->new(connection => $rawcon);
if ($server->{connection_callback}) {
&{$server->{connection_callback}}($server, $con);
}
};
return $self;
}
=item $status = $server->is_connected();
Returns zero if the server has been disconnected,
otherwise a positive value is returned.
=cut
sub is_connected {
my $self = shift;
return $self->{server}->dbus_server_get_is_connected();
}
=item $server->disconnect()
Closes this server to the remote host. This method
is called automatically during garbage collection (ie
in the DESTROY method) if the programmer forgets to
explicitly disconnect.
=cut
sub disconnect {
my $self = shift;
return $self->{server}->dbus_server_disconnect();
}
=item $server->set_watch_callbacks(\&add_watch, \&remove_watch, \&toggle_watch);
Register a set of callbacks for adding, removing & updating
watches in the application's event loop. Each parameter
should be a code reference, which on each invocation, will be
supplied with two parameters, the server object and the
watch object. If you are using a C<Net::DBus::Binding::Reactor> object
as the application event loop, then the 'manage' method on
that object will call this on your behalf.
=cut
sub set_watch_callbacks {
my $self = shift;
my $add = shift;
my $remove = shift;
my $toggled = shift;
$self->{add_watch} = $add;
$self->{remove_watch} = $remove;
$self->{toggled_watch} = $toggled;
$self->{server}->_set_watch_callbacks();
}
=item $server->set_timeout_callbacks(\&add_timeout, \&remove_timeout, \&toggle_timeout);
Register a set of callbacks for adding, removing & updating
timeouts in the application's event loop. Each parameter
should be a code reference, which on each invocation, will be
supplied with two parameters, the server object and the
timeout object. If you are using a C<Net::DBus::Binding::Reactor> object
as the application event loop, then the 'manage' method on
that object will call this on your behalf.
=cut
sub set_timeout_callbacks {
my $self = shift;
my $add = shift;
my $remove = shift;
my $toggled = shift;
$self->{add_timeout} = $add;
$self->{remove_timeout} = $remove;
$self->{toggled_timeout} = $toggled;
$self->{server}->_set_timeout_callbacks();
}
=item $server->set_connection_callback(\&handler)
Registers the handler to use for dealing with
new incoming connections from clients. The code
reference will be invoked each time a new client
connects and supplied with a single parameter
which is the C<Net::DBus::Binding::Connection> object representing
the client.
=cut
sub set_connection_callback {
my $self = shift;
my $callback = shift;
$self->{connection_callback} = $callback;
$self->{server}->_set_connection_callback();
}
1;
=pod
=back
=head1 AUTHOR
Daniel P. Berrange
=head1 COPYRIGHT
Copyright (C) 2004-2011 Daniel P. Berrange
=head1 SEE ALSO
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>
=cut