The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# -*- 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::Service - Provide a service to the bus for clients to use

=head1 SYNOPSIS

  package main;

  use Net::DBus;

  # Attach to the bus
  my $bus = Net::DBus->find;

  # Acquire a service 'org.demo.Hello'
  my $service = $bus->export_service("org.demo.Hello");

  # Export our object within the service
  my $object = Demo::HelloWorld->new($service);

  ....rest of program...

=head1 DESCRIPTION

This module represents a service which is exported to the message
bus. Once a service has been exported, it is possible to create
and export objects to the bus.

=head1 METHODS

=over 4

=cut


package Net::DBus::Service;

use 5.006;
use strict;
use warnings;

=item my $service = Net::DBus::Service->new($bus, $name);

Create a new service, attaching to the bus provided in
the C<$bus> parameter, which should be an instance of
the L<Net::DBus> object. The C<$name> parameter is the
qualified service name. It is not usually neccessary to
use this constructor, since services can be created via
the C<export_service> method on the L<Net::DBus> object.

=cut

sub new {
    my $class = shift;
    my $self = {};

    $self->{bus} = shift;
    $self->{service_name} = shift;
    $self->{objects} = {};

    bless $self, $class;

    $self->get_bus->get_connection->request_name($self->get_service_name);

    return $self;
}

=item my $bus = $service->get_bus;

Retrieves the L<Net::DBus> object to which this service is
attached.

=cut

sub get_bus {
    my $self = shift;
    return $self->{bus};
}

=item my $name = $service->get_service_name

Retrieves the qualified name by which this service is
known on the bus.

=cut

sub get_service_name {
    my $self = shift;
    return $self->{service_name};
}


sub _register_object {
    my $self = shift;
    my $object = shift;
    #my $wildcard = shift || 0;

#    if ($wildcard) {
#	$self->get_bus->get_connection->
#	    register_fallback($object->get_object_path,
#			      sub {
#				  $object->_dispatch(@_);
#			      });
#    } else {
	$self->get_bus->get_connection->
	    register_object_path($object->get_object_path,
				 sub {
				     $object->_dispatch(@_);
				 });
#    }
}


sub _unregister_object {
    my $self = shift;
    my $object = shift;

    $self->get_bus->get_connection->
	unregister_object_path($object->get_object_path);
}

1;

=pod

=back

=head1 AUTHOR

Daniel P. Berrange

=head1 COPYRIGHT

Copyright (C) 2005-2011 Daniel P. Berrange

=head1 SEE ALSO

L<Net::DBus>, L<Net::DBus::Object>, L<Net::DBus::RemoteService>

=cut