The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!/usr/bin/perl

use strict;
use warnings;

use Gtk2::TestHelper tests => 20;

use Gtk2::Unique;

my $COMMAND_FOO = 1;
my $COMMAND_BAR = 2;
my $APP_NAME = 'org.example.UnitTets';


# The D-Bus backend doesn't seem to realize that an application is no longer
# running when created from the same Perl script. The second call to
# Gtk2::UniqueApp->new() will think that the application is already running when
# it isn't. This happens even if the original $app variable exists no longer.
#
# Besides the bacon backend is the only one guaranteed to exist.
#
local $ENV{UNIQUE_BACKEND} = 'bacon';


exit tests();


sub tests {
	tests_new();
	tests_new_with_commands();
	return 0;
}


sub tests_new {
	my $app = Gtk2::UniqueApp->new($APP_NAME, undef);
	isa_ok($app, 'Gtk2::UniqueApp');
	
	$app->add_command(foo => $COMMAND_FOO);
	$app->add_command(bar => $COMMAND_BAR);
	
	generic_test($app);
}


sub tests_new_with_commands {

	my @commands = (
		foo => $COMMAND_FOO,
		bar => $COMMAND_BAR,
	);

	my $app = Gtk2::UniqueApp->new_with_commands($APP_NAME, undef, @commands);
	isa_ok($app, 'Gtk2::UniqueApp');
	
	generic_test($app);

	my $pass;

	# Check that the constructor enforces ints for the command ID
	$app = undef;
	$pass = 1;
	eval {
		$app = Gtk2::UniqueApp->new_with_commands($APP_NAME, undef, foo => 'not-an-int');
		$pass = 0;
	};
	if (my $error = $@) {
		$pass = 1;
	}
	ok($pass, "new_with_command() checks for IDs as int");


	# Check that the constructor enforces the argument count
	$app = undef;
	$pass = 1;
	eval {
		$app = Gtk2::UniqueApp->new_with_commands($APP_NAME, undef, foo => 1, 'bar');
		$pass = 0;
	};
	if (my $error = $@) {
		$pass = 1;
	}
	ok($pass, "new_with_command() checks for argument count");

}


sub generic_test {
	my ($app) = @_;
	
	if (! $app->is_running()) {
		SKIP: {
			skip "No app is running; execute perl -Mblib t/unit-tests.pl", 8;
		}
		return;
	}
	my $response;

	$response = $app->send_message($COMMAND_FOO, data => "data in here");
	is($response, 'ok', "send_message(data)");

	$response = $app->send_message_by_name(foo => data => "data in here");
	is($response, 'ok', "send_message_by_name(data)");

	$response = $app->send_message($COMMAND_FOO, text => "hello");
	is($response, 'ok', "send_message(text)");

	$response = $app->send_message_by_name(foo => text => "hello");
	is($response, 'ok', "send_message_by_name(text)");


	$response = $app->send_message($COMMAND_BAR, filename => __FILE__);
	is($response, 'invalid', "send_message(filename)");

	$response = $app->send_message_by_name(bar => filename => __FILE__);
	is($response, 'invalid', "send_message_by_name(filename)");


	$response = $app->send_message($COMMAND_FOO, uris => [
		'http://live.gnome.org/LibUnique',
		'http://gtk2-perl.sourceforge.net/',
	]);
	is($response, 'ok', "send_message(uris)");

	$response = $app->send_message_by_name(foo =>, uris => [
		'http://live.gnome.org/LibUnique',
		'http://gtk2-perl.sourceforge.net/',
	]);
	is($response, 'ok', "send_message_by_name(uris)");

	
	my $window = Gtk2::Window->new();
	$app->watch_window($window);
}