The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# -*- perl -*-
use Test::More tests => 6;

use strict;
use warnings;

BEGIN {
    use_ok('Net::DBus');
    use_ok('Net::DBus::Error');
    use_ok('Net::DBus::Object');
};

package MyError;

use base qw(Net::DBus::Error);

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(name => "org.example.music.UnknownFormat",
				  message => "Unknown track encoding format");
}


package MyObject;

use base qw(Net::DBus::Object);
use Net::DBus::Exporter qw(org.example.MyObject);

dbus_method("play", ["string"], ["string"]);
sub play {
    my $self = shift;
    my $url = shift;
    
    if ($url =~ /\.(mp3|ogg)$/) {
	return $url;
    } else {
	die MyError->new();
    }
}

package main;

my $bus = Net::DBus->test;
my $service = $bus->export_service("org.cpan.Net.Bus.test");
my $object = MyObject->new($service, "/org/example/MyObject");

my $rservice = $bus->get_service("org.cpan.Net.Bus.test");
my $robject = $rservice->get_object("/org/example/MyObject");

eval {
    $robject->play("foo.flac");
};
my $error = $@;
isa_ok($error, "Net::DBus::Error");
is($error->name, "org.example.music.UnknownFormat", "error name is set");
is($error->message, "Unknown track encoding format", "error description is set");