soundswarm-jsonrpc-stuff.pl

{
	package SoundSwarm::Syntax;
	no thanks;
	use Syntax::Collector -collect => q/
		use Carp 0 qw( confess );
		use Scalar::Util 0 qw( blessed );
		use MooX::Types::MooseLike::Base 0 qw( :all );
	/;
}

{
	package SoundSwarm::Role::Logging::StdErr;
	use SoundSwarm::Syntax;
	use MooX::Role;
	
	sub log {
		my ($self, $fmt, @args) = @_;
		printf STDERR "$fmt\n", @args;
	}
}

{
	package SoundSwarm::Role::Daemon::TCP;
	use SoundSwarm::Syntax;
	use MooX::Role;
	use constant {
		END_CLIENT  => \(1),
		END_DAEMON  => \(2),
	};
	
	requires 'log';
	requires 'host', 'port';
	requires 'handle_line';
	
	has socket => (
		is      => 'lazy',
		isa     => InstanceOf[ 'IO::Socket' ],
	);
	
	sub _build_socket
	{
		require IO::Socket::INET;
		my $self = shift;
		'IO::Socket::INET'->new(
			Listen     => 5,
			LocalAddr  => $self->host,
			LocalPort  => $self->port,
			Proto      => 'tcp',
		);
	}
	
	sub daemonize
	{
		my ($self) = @_;
		my $sock = $self->socket;
		
		$self->log("Listening on %s:%d", $sock->sockhost, $sock->sockport);
		
		CLIENT: while (1)
		{
			my $client = $sock->accept;
			$self->log("Connection from %s:%d", $client->peerhost, $client->peerport);
			
			LINE: while (defined(my $line = <$client>))
			{
				for my $response ($self->handle_line($line))
				{
					if (ref $response and $response == END_CLIENT) {
						$client->close;
						last LINE;
					}
					elsif (ref $response and $response == END_DAEMON) {
						$client->close;
						$sock->close;
						last CLIENT;
					}
					print {$client} $response;
				}
			}
		}
	}
}

{
	package SoundSwarm::Role::LineHandling::JSONRPC;
	use Moo::Role;
	use JSON qw( to_json from_json );
	use SoundSwarm::Syntax;
	
	requires 'is_valid_method';
	
	sub handle_line
	{
		my ($self, $line) = @_;
		my $in = eval { from_json($line) }
			or return $self->_jsonrpc_error("Invalid JSON.");
		
		my $method = $in->{method}
			or return $self->_jsonrpc_error("Invalid JSON-RPC.", $in->{id});
		
		if ($method eq 'quit' and $self->DOES('SoundSwarm::Role::Daemon::TCP'))
		{
			return (
				$self->_jsonrpc_result({ status => 'OK' }, $in->{id}),
				SoundSwarm::Role::Daemon::TCP->END_CLIENT,
			);
		}
		
		$self->can($method) && $self->is_valid_method($method)
			or return $self->_jsonrpc_error("No such method '$method'.", $in->{id});
		
		my @params = @{ $in->{params} || [] };
		my $result = $self->$method(@params);
		
		return $self->_jsonrpc_result($result, $in->{id});
	}
	
	sub _jsonrpc_result
	{
		my ($self, $result, $id) = @_;
		to_json({
			id      => $id || 0,
			error   => undef,
			result  => $result,
		})."\n";
	}
	
	sub _jsonrpc_error
	{
		my ($self, $error, $id) = @_;
		
		my $E = to_json({
			id      => $id,
			error   => $error,
			result  => undef,
		})."\n";
		
		return ($E, SoundSwarm::Role::Daemon::TCP->END_CLIENT)
			if $self->DOES('SoundSwarm::Role::Daemon::TCP');
		
		return $E;
	}
}

{
	package SoundSwarm::Test::Daemon;
	use Moo;
	use SoundSwarm::Syntax;
	
	has port => (
		is      => 'lazy',
		isa     => Int,
		default => sub { 4242 },
	);
	
	has host => (
		is      => 'lazy',
		isa     => Str,
		default => sub { '127.0.0.1' },
	);
	
	with qw(
		SoundSwarm::Role::Logging::StdErr
		SoundSwarm::Role::LineHandling::JSONRPC
		SoundSwarm::Role::Daemon::TCP
	);
	
	sub is_valid_method
	{
		my ($self, $method) = @_;
		$method eq 'foo' or $method eq 'bar';
	}
	
	sub foo
	{
		+{ xyz => 'foo' }
	}

	sub bar
	{
		+{ xyz => 'bar' }
	}

	sub baz
	{
		+{ xyz => 'baz' }
	}
}

SoundSwarm::Test::Daemon->new->daemonize;