Net::DBus::Test::MockMessage - Fake a message object when unit testing

  my $msg = new Net::DBus::Test::MockMessage;
  my $iterator = $msg->iterator;

  $iterator->append_byte(132);
  $iterator->append_int32(14241);

  $connection->send($msg);

# -*- perl -*-
#
# Copyright (C) 2006 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.

package Net::DBus::Test::MockMessage;

use 5.006;
use strict;
use warnings;

use vars qw($SERIAL);

BEGIN {
    $SERIAL = 1;
}

use Net::DBus::Binding::Message;
use Net::DBus::Test::MockIterator;

sub new_method_call {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = $class->_new(type => &Net::DBus::Binding::Message::MESSAGE_TYPE_METHOD_CALL, @_);

    bless $self, $class;

    return $self;
}

sub new_method_return {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = $class->_new(type => &Net::DBus::Binding::Message::MESSAGE_TYPE_METHOD_RETURN, @_);

    bless $self, $class;

    return $self;
}

sub new_signal {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = $class->_new(type => &Net::DBus::Binding::Message::MESSAGE_TYPE_SIGNAL, @_);

    bless $self, $class;

    return $self;
}

sub new_error {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = $class->_new(type => &Net::DBus::Binding::Message::MESSAGE_TYPE_ERROR, @_);

    bless $self, $class;

    return $self;
}

sub _new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my %params = @_;
    my $self = {};

    $self->{type} = exists $params{type} ? $params{type} : die "type parameter is required";
    $self->{interface} = exists $params{interface} ? $params{interface} : undef;
    $self->{path} = exists $params{path} ? $params{path} : undef;
    $self->{destination} = exists $params{destination} ? $params{destination} : undef;
    $self->{sender} = exists $params{sender} ? $params{sender} : undef;
    $self->{member} = exists $params{member} ? $params{member} : undef;
    $self->{error_name} = exists $params{error_name} ? $params{error_name} : undef;
    $self->{data} = [];
    $self->{no_reply} = 0;
    $self->{serial} = $SERIAL++;
    $self->{replyserial} = exists $params{replyto} ? $params{replyto}->get_serial : 0;

    bless $self, $class;

    if ($self->{type} == &Net::DBus::Binding::Message::MESSAGE_TYPE_ERROR) {
	my $desc = exists $params{error_description} ? $params{error_description} : "";
	my $iter = $self->iterator(1);
	$iter->append_string($desc);
    }

    return $self;
}

sub get_type {
    my $self = shift;

    return $self->{type};
}

sub get_error_name {
    my $self = shift;
    return $self->{error_name};
}

sub get_interface {
    my $self = shift;
    
    return $self->{interface};
}

sub get_path {
    my $self = shift;
    
    return $self->{path};
}

sub get_destination {
    my $self = shift;
    
    return $self->{destination};
}

sub get_sender {
    my $self = shift;
    
    return $self->{sender};
}

sub get_serial {
    my $self = shift;
    
    return $self->{serial};
}

sub get_member {
    my $self = shift;
    
    return $self->{member};
}

sub set_sender {
    my $self = shift;

    $self->{sender} = shift;
}

sub set_destination {
    my $self = shift;
    $self->{destination} = shift;
}

sub iterator {
    my $self = shift;
    my $append = @_ ? shift : 0;
    
    return Net::DBus::Test::MockIterator->_new(data => $self->{data},
					       append => $append);
}

sub get_no_reply {
    my $self = shift;
    
    return $self->{no_reply};
}

sub set_no_reply {
    my $self = shift;
    
    $self->{no_reply} = shift;
}

sub get_args_list {
    my $self = shift;
    
    my @ret;    
    my $iter = $self->iterator;
    if ($iter->get_arg_type() != &Net::DBus::Binding::Message::TYPE_INVALID) {
	do {
	    push @ret, $iter->get();
	} while ($iter->next);
    }

    return @ret;
}

sub append_args_list {
    my $self = shift;
    my @args = @_;
    
    my $iter = $self->iterator(1);
    foreach my $arg (@args) {
	$iter->append($arg);
    }
}

sub get_signature {
    my $self = shift;

    my @bits = map { $self->_do_get_signature($_) } @{$self->{data}};
    return join ("", @bits);
}

sub _do_get_signature {
    my $self = shift;
    my $element = shift;

    if ($element->[0] == &Net::DBus::Binding::Message::TYPE_ARRAY) {
	return chr(&Net::DBus::Binding::Message::TYPE_ARRAY) . $element->[2];
    } elsif ($element->[0] == &Net::DBus::Binding::Message::TYPE_STRUCT) {
	my @bits = map { $self->_do_get_signature($_) } @{$element->[1]};
	return "{" . join("", @bits) . "}";
    } elsif ($element->[0] == &Net::DBus::Binding::Message::TYPE_VARIANT) {
	return chr(&Net::DBus::Binding::Message::TYPE_VARIANT);
    } else {
	return chr($element->[0]);
    }
}

1;