From cdae7275d29c9c370ec7e714dd71af2a1076c0d0 Mon Sep 17 00:00:00 2001
From: David Phillips <david@yeah.nah.nz>
Date: Sat, 4 Apr 2020 14:25:27 +1300
Subject: WIP: Add Mock::CommandRegistry for testing commands

---
 Mock/CommandRegistry.pm | 53 +++++++++++++++++++++++++++++++++++++++++++++----
 test/TODO.md            |  5 +----
 test/test_echo.t        | 41 +++++++++++++++++---------------------
 test/test_ping.t        | 46 +++++++++++++++++++-----------------------
 4 files changed, 88 insertions(+), 57 deletions(-)

diff --git a/Mock/CommandRegistry.pm b/Mock/CommandRegistry.pm
index 166879d..72c84cf 100644
--- a/Mock/CommandRegistry.pm
+++ b/Mock/CommandRegistry.pm
@@ -3,13 +3,58 @@ package Mock::CommandRegistry;
 use strict;
 use warnings;
 
-use fields qw/commands/;
+use fields qw/_commands/;
 
 sub new {
-	my ($class) = @_;
-	bless {}, $class;
+	my Mock::CommandRegistry $self = shift;
+	unless ($self) {
+		$self = fields::new($self);
+		$self->{_commands} = {};
+	}
+	bless {}, $self;
 }
 
-sub register {
+sub run {
+	my ($self, $command, %ctx) = @_;
+	# XXX should run all commands matching? Only first?
 	...
 }
+
+sub run_owned {
+	my ($self, $owner, $command, %ctx) = @_;
+	die "$owner::$command not registered\n"
+		unless $self->is_registered_to_owner($owner, $command);
+
+	# XXX plugins need to eventually use the ctx hash directly. Much more
+	# readable than remembering the long chain of magic positional args each
+	# time you write a new cmd plugin
+	my @args = (
+		$ctx{irc},
+		$ctx{logger},
+		$ctx{who},
+		$ctx{where},
+		$ctx{ided},
+		$ctx{rest},
+		$ctx{no_reenter},
+		$ctx{args}
+	);
+
+	$self->{_commands}->{$owner}->{$command}->(@args);
+}
+
+sub is_registered {
+	my ($self, $command) = @_;
+	# XXX should tell if any owner registers a given command
+	...
+}
+
+sub is_registered_to_owner {
+	my ($self, $owner, $command) = @_;
+	defined $self->{_commands}->{$owner}->{$command};
+}
+
+sub register {
+	my ($self, $owner, $command, $coderef) = @_;
+	$self->{_commands}->{$owner}->{$command} = $coderef;
+}
+1;
diff --git a/test/TODO.md b/test/TODO.md
index e235325..4c4f14a 100644
--- a/test/TODO.md
+++ b/test/TODO.md
@@ -1,9 +1,6 @@
 # To Do
 
-* **Refactor command registration tests.** There should be a Mock::Misc utility
-  method which forms a dict mapping commands to their sub refs. Checking if
-  a command was registers then becomes checking keys, and checking return
-  values under different conditions becomes more feasible, and globals go away.
+* ...
 
 ### The following need tests written at all:
 
diff --git a/test/test_echo.t b/test/test_echo.t
index 73ff0e8..d8c1b69 100755
--- a/test/test_echo.t
+++ b/test/test_echo.t
@@ -2,33 +2,28 @@
 
 use strict;
 use warnings;
-
 use Test::Simple tests => 2;
+use Mock::CommandRegistry;
 
 use Plugin::Echo;
 
-my $expected = " Ping pong do the echo thing!";
-our $registered;
-our $response;
-
-sub register_cmd {
-	my ($module, $name, $run) = @_;
-
-	$registered = 1;
+my $cr = new Mock::CommandRegistry;
+my $register = sub { $cr->register(@_); };
 
-	$response = $run->(
-		undef, # irc
-		undef, # logger
-		undef, # who
-		undef, # where
-		undef, # ided
-		$expected,
-		undef, # no reenter
-		undef, # arguments
-	);
-}
+Plugin::Echo->configure($register, undef, undef, undef);
+ok($cr->is_registered_to_owner("Plugin::Echo", "echo"), "registered command");
 
-Plugin::Echo->configure(\&register_cmd, undef, undef, undef);
-
-ok($registered, "plugin registered command");
+my $expected = " Ping pong do the echo thing!";
+my %ctx = (
+	irc => undef,
+	logger => undef,
+	who => undef,
+	where => undef,
+	ided => undef,
+	rest => $expected,
+	no_reenter => undef,
+	args => undef
+);
+my $response = $cr->run_owned("Plugin::Echo", "echo", %ctx);
 ok($response eq $expected, "echo expectation met");
+
diff --git a/test/test_ping.t b/test/test_ping.t
index f7ae60f..c31c538 100755
--- a/test/test_ping.t
+++ b/test/test_ping.t
@@ -2,33 +2,27 @@
 
 use strict;
 use warnings;
-
 use Test::Simple tests => 2;
+use Mock::CommandRegistry;
 
 use Plugin::Ping;
 
-our $registered;
-our $response;
-my $expected = "user: pong";
-
-sub register_cmd {
-	my ($module, $name, $run) = @_;
-
-	$registered = 1;
-
-	$response = $run->(
-		undef, # irc
-		undef, # logger
-		'user!who@example.com',
-		undef, # where
-		undef, # ided
-		undef, # rest
-		undef, # no reenter
-		undef, # arguments
-	);
-}
-
-Plugin::Ping->configure(\&register_cmd, undef, undef, undef);
-
-ok($registered, "plugin registered command");
-ok($response eq $expected, "echo expectation met");
+my $cr = new Mock::CommandRegistry;
+my $register = sub { $cr->register(@_); };
+Plugin::Ping->configure($register, undef, undef, undef);
+ok($cr->is_registered_to_owner("Plugin::Ping", "ping"), "registered command");
+
+my $pinger = "somelad";
+my %ctx = (
+	irc => undef,
+	logger => undef,
+	who => "$pinger!who\@example.com",
+	where => undef,
+	ided => undef,
+	rest => undef,
+	no_reenter => undef,
+	args => undef
+);
+my $expected = "$pinger: pong";
+my $response = $cr->run_owned("Plugin::Ping", "ping", %ctx);
+ok($response eq $expected, "pong format correct");
-- 
cgit v1.1