Volity::Server - A Volity game parlor.

 use Volity::Server;

 # Create a new parlor
 my $server = Volity::Server->new(
				 {
				  user=>'bob_the_game',
				  password=>'secret',
				  host=>'volity.net',
				  resource=>'server',
				  alias=>'volity',
				  game_class=>'MyGame::Class',
				}
				);

 # And there you go.
 $server->start;

 # ... elsewhere ...

 $server->stop;

 $ volityd -J bob_the_game@volity.net/server -G MyGame::Class -p secret

package Volity::Server;

############################################################################
# LICENSE INFORMATION - PLEASE READ
############################################################################
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
############################################################################

use warnings;
use strict;

use base qw(Volity::Jabber);
use fields qw(referee_class game_class bookkeeper_jid referees referee_host referee_user referee_password muc_host bot_configs contact_email contact_jid volity_version visible referee_count startup_time admins in_graceful_shutdown volityd_command volityd_cwd volityd_argv reconnection_alarm_id);

use POE qw(
	   Wheel::SocketFactory
	   Wheel::ReadWrite
	   Filter::Line
	   Driver::SysRW
	   Component::Jabber;
	  );

use RPC::XML::Parser;
use Volity::Referee;
use Carp qw(croak carp);

# Set some magic numbers.
our $RECONNECTION_TIMEOUT = 5;

sub initialize {
  my $self = shift;
  $self->SUPER::initialize(@_);

  # We deal with a lot of classes for games, referees, and bots.
  # Make sure that they all compile!
  if (my $referee_class = $self->referee_class) {
      eval "require $referee_class";
      if ($@) {
	  die "Failed to require referee class $referee_class: $@";
      }
  }
  if (my $game_class = $self->game_class) {
      eval "require $game_class";
      if ($@) {
	  die "Failed to require game class $game_class: $@";
      }
  }

  $self->{referees} = [];
  $self->startup_time(time);
  $self->{admins} ||= [];
  $self->referee_count(0);
  return $self;
}

# require_bot_configs: Called by volityd as a volidation step.
# It simply require()s each Bot class, and dies on compilation errors.
sub require_bot_configs {
  my $self = shift;
  for my $bot_config ($self->bot_configs) {
      eval "require $$bot_config{class}";
      if ($@) {
	  die "Failed to require bot class $$bot_config{class}: $@";
      }
  }
}

sub init_finish {
    my $self = shift;
    $self->kernel->alarm_remove($self->reconnection_alarm_id) if defined($self->reconnection_alarm_id);
    $self->reconnection_alarm_id(undef);

    return $self->SUPER::init_finish;
}

# This presence handler takes care of auto-approving all subscription
# requests. Volity servers are very social like that.
sub jabber_presence {
  my $self = shift;
  my ($presence) = @_;		# POE::Filter::XML::Node object
  if ($presence->attr('type') and $presence->attr('type') eq 'subscribe') {
    # A subscription request! Shoot back approval.
    $self->send_presence(
			 {
			  to=>$presence->attr('from'),
			  type=>'subscribed',
			 }
			);
  }
}

# We override Volity::Jabber's send_presence in order to attach some
# additional JEP-0115 information.
sub send_presence {
    my $self = shift;
    my ($config) = @_;
    $config ||= {};
    $$config{caps} = {
	node => "http://volity.org/protocol/caps",
	ext => "parlor",
	ver => "1.0",
    };
    return $self->SUPER::send_presence($config);
}

sub new_table {
  my $self = shift;
  # Start a new session to play this game.

  my ($from_jid, $id, @args) = @_;

  my $resource = $self->new_referee_resource;
  
  my $referee_class = $self->referee_class || "Volity::Referee";

  my $ref = $referee_class->new(
				      {
				       starting_request_jid=>$from_jid,
				       starting_request_id=>$id,
				       user=>$self->user,
				       password=>$self->password,
				       resource=>$resource,
				       host=>$self->host,
				       jid_host=>$self->jid_host,
				       muc_host=>$self->muc_host,
				       game_class=>$self->game_class,
				       alias=>$resource,
				       bookkeeper_jid=>$self->bookkeeper_jid,
				       bot_configs=>$self->{bot_configs},
				       port=>$self->port,
				      }
				     );

  $self->add_referee($ref);
  $ref->server($self);

  $self->logger->info("New referee (" . $ref->jid . ") initialized, based on table-creation request from $from_jid.");
  $self->referee_count($self->referee_count + 1);
}

# start: run the kernel.
sub start {
  my $self = shift;
  $self->logger->info("Server started.");
  $self->kernel->run;
}

sub stop {
  my $self = shift;
  $self->logger->info("Server stopped.");
  $self->kernel->post($self->alias, 'shutdown_socket', 0);
  foreach (grep (defined($_), $self->referees)) {
    $_->stop;
  }
}

sub handle_rpc_request {
  my $self = shift;
  my ($rpc_info) = @_;
  eval {
      my $ok = 0;
      if ($$rpc_info{'method'} eq 'volity.new_table') {
	  $self->new_table($$rpc_info{from}, $$rpc_info{id}, @{$$rpc_info{args}});
	  $ok = 1;
      } elsif (my ($admin_method) = $$rpc_info{'method'} =~ /^admin\.(.*)$/) {
	  # Check that the sender is allowed to make this call.
	  my ($basic_sender_jid) = $$rpc_info{from} =~ /^(.*)\//;
	  if (grep($_ eq $basic_sender_jid, $self->admins)) {
	      my $local_method = "admin_rpc_$admin_method";
	      if ($self->can($local_method)) {
		  $self->$local_method($$rpc_info{from}, $$rpc_info{id}, @{$$rpc_info{args}});
		  $ok = 1;
	      } else {
		  $ok = 0;
	      }
	  } else {
	      $self->logger->warn("$basic_sender_jid (as $$rpc_info{from}) attempted to call $$rpc_info{method}. But I don't recognize that JID as an admin, so I'm rejecting it.");
	      $self->send_rpc_fault($$rpc_info{from},
				    $$rpc_info{id},
				    607,
				    "You are not allowed to make admin calls on this parlor.",
				    );
	      return;
	  }
      } else {
	  $ok = 0;
      }
      unless ($ok) {
	  $self->logger->warn("Got weird rpc request $$rpc_info{method} from $$rpc_info{from}.");
	  $self->send_rpc_fault($$rpc_info{from},
				$$rpc_info{id},
				603,
				"Unknown methodName: '$$rpc_info{method}'",
				);
      }
  };
  if ($@) {
      $self->report_rpc_error(@_);
      return;
  }
}

sub add_referee {
  my $self = shift;
  my ($referee) = @_;
  croak("You must provide a referee object with the add_referee() method") unless $referee->isa("Volity::Referee");
  push (@{$self->{referees}}, $referee);
  return $referee;
}

sub remove_referee {
  my $self = shift;
  my ($referee) = @_;
  my @new_referees;
  for (my $i = 0; $i <= $self->referees - 1; $i++) {
      if ($self->{referees}->[$i] eq $referee) {
	  splice(@{$self->{referees}}, $i, 1);
	  # If we're admidst a graceful shutdown, and this was the last
	  # referee, then we stop too.
	  $self->graceful_shutdown_check;
	  return;
      }
  }   
  $self->logger->error("I was asked to remove the referee with jid " . $referee->jid . " but I can't find it!!");
}

sub graceful_shutdown_check {
    my $self = shift;
    if ($self->in_graceful_shutdown and not(scalar(@{$self->{referees}}))) {
	$self->logger->info("No referees left, and we're in graceful-shutdown mode, so I'm going away now.");
	exit;
    }
}

sub new_referee_resource {
  my $self = shift;
  return $$ . "_" . time;
}

sub wall {
    my $self = shift;
    my ($message) = @_;
    for my $referee ($self->referees) {
	$referee->groupchat("Server message: $message");
    }
}

sub graceful_stop {
    my $self = shift;
    $self->kernel->post($self->alias, 'shutdown_socket', 0);
}

sub exec_volityd {
    my $self = shift;
    chdir($self->volityd_cwd) or die "Can't chdir to " . $self->volityd_cwd . ": $!";
    exec { $self->volityd_command } ($self->volityd_command, $self->volityd_argv);
}

sub react_to_disconnection_error {
    my $self = shift;
    $self->logger->debug("Attempting to reconnect to the server...\n");
    $self->attempt_reconnection;
}

sub attempt_reconnection {
    my $self = shift;
    $self->kernel->state("reconnection_timeout", $self);
    my $alarm_id = $self->kernel->delay_set("reconnection_timeout", $RECONNECTION_TIMEOUT);
    $self->reconnection_alarm_id($alarm_id);
    $self->alias("volity" . time);
    $self->logger->warn("Trying to reconnect..." . $self->host . $self->port);
    $self->start_jabber_client;
}

sub reconnection_timeout {
    my $self = shift;
    $self->logger->warn("Reconnection timeout!");
    $self->logger->warn("I'll try again.");
    $self->attempt_reconnection;
}

####################
# Service Discovery
####################

sub handle_disco_info_request {
    my $self = shift;
    my ($iq) = @_;
    my $query = $iq->get_tag('query');
    $self->logger->debug("I got a disco info request from " . $iq->attr('from'));
    # Build the list of disco items to return.
    my @items;
    my $identity = Volity::Jabber::Disco::Identity->new({category=>'volity',
							 type=>'parlor',
						     });
    my $game_class = $self->game_class;
    my $node = $query->attr('node');
    if (not(defined($node))) {
	eval "\$identity->name($game_class->name);";
    }
    push (@items, $identity);
    push (@items, Volity::Jabber::Disco::Feature->new({var=>'http://jabber.org/protocol/disco#info'}));
    my $items_feature = Volity::Jabber::Disco::Feature->new({var=>'http://jabber.org/protocol/disco#items'});
    push (@items, $items_feature);

    # Prepare JEP-0128 data form fields!
    my @fields;
    # We must perform these two separate loops since some info is found
    # on the server object, and some on the loaded game module class.
    foreach (qw(description ruleset ruleset_version website volity-role)) {
	my $field_name;
	my $value;
	if ($_ eq 'ruleset') {
	    $value = $game_class->uri;
	} else {
	    if ($_ eq 'volity-role') {
		$value = 'parlor';
	    } else {
		$value = $game_class->$_;
	    }
	}
	$field_name = $_;
	$field_name =~ s/_/-/g;
	my @values = (ref($value) and ref($value) eq 'ARRAY')?
	    @$value : ($value);
	my $field = Volity::Jabber::Form::Field->new({var=>$field_name});
	$field->values(@values);
	push (@fields, $field);
    }
    foreach (qw(contact_email contact_jid volity_version visible)) {
	my $field_name;
	my $value;
	$value = $self->$_;
	$field_name = $_;
	$field_name =~ s/_/-/g;
	my @values = (ref($value) and ref($value) eq 'ARRAY')?
	    @$value : ($value);
	my $field = Volity::Jabber::Form::Field->new({var=>$field_name});
	$field->values(@values);
	push (@fields, $field);
    }

    # Send them off.
    $self->send_disco_info({
	to=>$iq->attr('from'),
	id=>$iq->attr('id'),
	items=>\@items,
	fields=>\@fields,
    });
}

sub handle_disco_items_request {
    my $self = shift;
    my ($iq) = @_;
    $self->logger->debug("I got a disco items request.");
    my $query = $iq->get_tag('query');
    my @nodes;
    if (defined($query->attr('node'))) {
	@nodes = split(/\//, $query->attr('node'));
    }
    
    my @items;			# Disco items to return to the requester.

    my $game_class = $self->game_class;

    if (defined($nodes[0])) {
	if( $nodes[0] eq 'ruleset') {
	    # Return a pointer to the bookeeper's info about this ruleset.
	    # The JID reveals our bookkeeper, while the node reveals our
	    # ruleset URI.
	    my $uri;
	    $uri = $self->game_class->uri; 
	    push (@items, Volity::Jabber::Disco::Item->new({
		jid=>$self->bookkeeper_jid,
		node=>$uri,
		name=>"ruleset information (URI: $uri )",
	    }));
	}
	elsif ( $nodes[0] eq 'open_games' ) {
	    $self->logger->debug("It's an open_games request.");
	    # Get a list of referees with open games, and return
	    # pointers to them.
	    my @open_referees = grep(
				     $_->isa("Volity::Referee") && not($_->is_hidden),
				     @{$self->{referees}},
	    );
	    $self->logger->debug("I am returning " . @open_referees . " referee nodes.");
	    foreach (@open_referees) {
		push (@items, Volity::Jabber::Disco::Item->new({
		    jid=>$_->jid,
		    name=>$_->name,
		}));
	    } 
	}
	elsif ( $nodes[0] eq 'bots' ) {
	    $self->logger->debug("It's a bots request.");
	    # Get a list of bots, and return pointers to them.
	    for my $bot_config ($self->bot_configs) {
		my $item = Volity::Jabber::Disco::Item->new({
		    jid=>$self->jid,
		});
		$item->name($bot_config->{class}->name) if $bot_config->{class}->name;
		$item->node($bot_config->{class}->algorithm) if $bot_config->{class}->algorithm;
		push (@items, $item);
	    }
	}
    } else {
	# Just return the two nodes we support.
	foreach (qw(ruleset open_games)) {
	    push (@items,
		  Volity::Jabber::Disco::Item->new({
		      jid=>$self->jid,
		      node=>$_,
		  })
		  );
	}
    }

    $self->send_disco_items(
			    {
				to=>$iq->attr('from'),
				id=>$iq->attr('id'),
				items=>\@items,
			    }
			    );
	
	
}

##########################
# Admin RPC stuff
##########################

# These are all dispatched to from the handle_rpc_request method.

sub admin_rpc_status {
    my $self = shift;
    my ($from_jid, $rpc_id) = @_;
    my %status = (
		  online         => 1,
		  tables_running => scalar(@{$self->{referees}}),
		  tables_started => $self->referee_count,
		  startup_time   => scalar(localtime($self->startup_time)),
		  );
    my $latest_time = '0';
    for my $referee_startup_time (map($_->startup_time, $self->referees)) {
	$latest_time = $referee_startup_time if $referee_startup_time > $latest_time;
    }
    if ($latest_time) {
	$status{last_new_table} = scalar(localtime($latest_time));
    }
		  
    $self->send_rpc_response($from_jid, $rpc_id, ["volity.ok", \%status]);
}

sub admin_rpc_list_tables {
    my $self = shift;
    my ($from_jid, $rpc_id) = @_;
    my @jids = map($_->jid, $self->referees);
    $self->send_rpc_response($from_jid, $rpc_id, ["volity.ok", \@jids]);
}

sub admin_rpc_list_bots {
    my $self = shift;
    my ($from_jid, $rpc_id) = @_;
    my @jids = map($_->jid, map($_->active_bots, $self->referees));
    $self->send_rpc_response($from_jid, $rpc_id, ["volity.ok", \@jids]);
}

sub admin_rpc_shutdown {
    my $self = shift;
    my ($from_jid, $rpc_id) = @_;
    $self->logger->info("Server shut down via RPC, by $from_jid.");
    $self->wall("This parlor is shutting down NOW. Goodbye!");
    $self->send_rpc_response($from_jid, $rpc_id, ["volity.ok"]);
    exit;
}

sub admin_rpc_announce {
    my $self = shift;
    my ($from_jid, $rpc_id, $message) = @_;
    $self->wall($message);
    $self->send_rpc_response($from_jid, $rpc_id, ["volity.ok"]);
}

sub admin_rpc_graceful_shutdown {
    my $self = shift;
    my ($from_jid, $rpc_id) = @_;
    $self->logger->info("Graceful shut down via RPC, by $from_jid.");
    $self->graceful_stop;
    $self->send_rpc_response($from_jid, $rpc_id, ["volity.ok"]);
}

sub admin_rpc_restart {
    my $self = shift;
    my ($from_jid, $rpc_id) = @_;
    $self->logger->info("Graceful restart via RPC, by $from_jid.");
    $self->logger->info("Making system call to launch new process: $0");
    $self->wall("This parlor is shutting down NOW. Goodbye!");
    $self->send_rpc_response($from_jid, $rpc_id, ["volity.ok"]);
    $self->exec_volityd;
}

sub admin_rpc_graceful_restart {
    my $self = shift;
    my ($from_jid, $rpc_id) = @_;
    $self->logger->info("Graceful restart via RPC, by $from_jid.");
    $self->logger->debug("Making system call to launch new process: $0");
    $self->in_graceful_shutdown(1);
    $self->graceful_stop;
    $self->send_rpc_response($from_jid, $rpc_id, ["volity.ok"]);
    if (fork) {
	# I'm the parent.
	$self->graceful_shutdown_check;
    } else {
	# I'm the child. Restart!
	$self->exec_volityd;
    }
}

1;