view release on metacpan or  search on metacpan

lib/POE/Component/Server/JSONUnix.pm  view on Meta::CPAN

C<commands> -- hash reference of C<< name => \&handler >> pairs to register. See
L</"COMMAND HANDLERS">.

=item *

C<socket_mode> -- if set (e.g. C<0600>), C<chmod> the socket to these
permissions after binding. Unix socket permissions govern who may connect, so
setting this is recommended.

=item *

C<alias> -- POE session alias. Defaults to C<json_unix_server>. Set this if you
run more than one server in a single process.

=item *

C<unlink_existing> -- whether to remove a stale (not-in-use) socket file on
startup. Defaults to true.

=item *

C<on_error> -- code reference called as
C<< $cb->($operation, $errnum, $errstr [, $wheel_id]) >> on listen and
connection I/O errors. Normal client disconnects are not reported.

=back

=cut

sub spawn {
	my ( $class, %args ) = @_;

	my $path = delete $args{socket_path}
		or croak "spawn() requires a 'socket_path' argument";

	my $self = bless {
		socket_path     => $path,
		alias           => ( delete $args{alias} ) // 'json_unix_server',
		socket_mode     => delete $args{socket_mode},                       # e.g. 0600
		unlink_existing => ( delete $args{unlink_existing} ) // 1,
		on_error        => delete $args{on_error},                          # coderef (optional)
		commands        => {},
		clients         => {},
		json            => JSON::MaybeXS->new(
			utf8         => 1,
			canonical    => 1,
			allow_nonref => 0,
		),
	}, $class;

	# Precedence (later overrides earlier): built-ins < cmd_* methods < arg.
	$self->_register_builtins;
	$self->_register_cmd_methods;

	if ( defined( my $cmds = delete $args{commands} ) ) {
		croak "'commands' must be a hash reference"
			unless ref $cmds eq 'HASH';
		$self->register(%$cmds);
	}

	# Fail fast and synchronously on a busy or unusable socket path, so the
	# caller of spawn() gets the error rather than a dead session later.
	$self->_prepare_socket_path;

	POE::Session->create(
		object_states => [
			$self => {
				_start           => '_poe_start',
				_stop            => '_poe_stop',
				shutdown         => '_poe_shutdown',
				register_command => '_poe_register_command',
				got_connection   => '_poe_got_connection',
				listen_error     => '_poe_listen_error',
				client_input     => '_poe_client_input',
				client_error     => '_poe_client_error',
				client_flushed   => '_poe_client_flushed',
			},
		],
	);

	return $self;
} ## end sub spawn

#--- command registration --------------------------------------------------

=head1 METHODS

=head2 register

    $server->register(name => \&handler, ...);

Add or replace commands. Returns the server object. Croaks if a handler is not a
code reference.

=cut

# register(name => \&handler, ...) — add or replace commands at any time.
sub register {
	my ( $self, %cmds ) = @_;
	for my $name ( sort keys %cmds ) {
		my $code = $cmds{$name};
		croak "Handler for command '$name' must be a code reference"
			unless ref $code eq 'CODE';
		$self->{commands}{$name} = $code;
	}
	return $self;
} ## end sub register

=head2 command_names

    my $names = $server->command_names;   # array reference, sorted

The names of all currently registered commands. (Also available to clients as
the built-in C<commands> command.)

=cut

sub command_names { return [ sort keys %{ $_[0]->{commands} } ] }

sub _register_builtins {
	my ($self) = @_;