view release on metacpan or  search on metacpan

lib/Net/DBus/Test/MockConnection.pm  view on Meta::CPAN

=cut

sub register_object_path {
    my $self = shift;
    my $path = shift;
    my $code = shift;

    $self->{objects}->{$path} = $code;
}

=item $con->register_fallback($path, \&handler)

Registers a handler for messages whose path starts with
the prefix specified in the C<$path> parameter. The supplied
code reference will be invoked with two parameters, the
connection object on which the message was received,
and the message to be processed (an instance of the
C<Net::DBus::Binding::Message> class).

=cut

sub register_fallback {
    my $self = shift;
    my $path = shift;
    my $code = shift;

    $self->{objects}->{$path} = $code;
    $self->{objectTrees}->{$path} = $code;
}

=item $con->unregister_object_path($path)

Unregisters the handler associated with the object path C<$path>. The
handler would previously have been registered with the C<register_object_path>
or C<register_fallback> methods.

=cut

sub unregister_object_path {
    my $self = shift;
    my $path = shift;

    delete $self->{objects}->{$path};
}

sub _call_method {
    my $self = shift;
    my $msg = shift;

    if (exists $self->{objects}->{$msg->get_path}) {
	my $cb = $self->{objects}->{$msg->get_path};
	&$cb($self, $msg);
    } else {
	foreach my $path (reverse sort { $a cmp $b } keys %{$self->{objectTrees}}) {
	    if ((index $msg->get_path, $path) == 0) {
		my $cb = $self->{objects}->{$path};
		&$cb($self, $msg);
		return;
	    }
	}
	if ($msg->get_path eq "/org/freedesktop/DBus") {
	    if ($msg->get_member eq "GetNameOwner") {
		my $reply = $self->make_method_return_message($msg);
		my $iter = $reply->iterator(1);
		$iter->append(":1.1");
		$self->send($reply);
	    }
	}
    }
}

=item my $msg = $con->make_error_message($replyto, $name, $description)

Creates a new message, representing an error which occurred during
the handling of the method call object passed in as the C<$replyto>
parameter. The C<$name> parameter is the formal name of the error
condition, while the C<$description> is a short piece of text giving
more specific information on the error.

=cut

sub make_error_message {
    my $self = shift;
    my $replyto = shift;
    my $name = shift;
    my $description = shift;

    if (1) {
	return Net::DBus::Test::MockMessage->new_error(replyto => $replyto,
						       error_name => $name,
						       error_description => $description);
    } else {
	return Net::DBus::Binding::Message::Error->new(replyto => $replyto,
						       name => $name,
						       description => $description);
    }
}

=item my $call = $con->make_method_call_message(
  $service_name, $object_path, $interface, $method_name);

Create a message representing a call on the object located at
the path C<$object_path> within the client owning the well-known
name given by C<$service_name>. The method to be invoked has
the name C<$method_name> within the interface specified by the
C<$interface> parameter.

=cut

sub make_method_call_message {
    my $self = shift;
    my $service_name = shift;
    my $object_path = shift;
    my $interface = shift;
    my $method_name = shift;

    if (1) {
	return Net::DBus::Test::MockMessage->new_method_call(destination => $service_name,
							     path => $object_path,
							     interface => $interface,
							     member => $method_name);