package Bot::Cobalt::IRC::Role::AdminCmds;
our $VERSION = '0.014';

use 5.12.1;
use Moo::Role;

use Bot::Cobalt;
use Bot::Cobalt::Common;

use strictures 1;

sub Bot_public_cmd_server {
  my ($self, $core) = splice @_, 0, 2;
  
  my $msg = ${ $_[0] };
  
  my $context  = $msg->context;
  my $src_nick = $msg->src_nick;
  
  my $auth_flags = $core->auth->flags($context, $src_nick);
  
  return PLUGIN_EAT_ALL unless $auth_flags->{SUPERUSER};
  
  my $cmd = lc($msg->message_array->[0] || 'list');
  
  my $meth = '_cmd_'.$cmd;
  
  unless ( $self->can($meth) ) {
    broadcast( 'message',
      $msg->context,
      $msg->channel,
      "Unknown command; try one of: list, current, connect, disconnect"
    );
  
    return PLUGIN_EAT_ALL
  }
  
  logger->debug("Dispatching $cmd for $src_nick");
  
  $self->$meth($msg)
}

sub _cmd_list {
  my ($self, $msg) = @_;
  
  my @contexts = keys %{ core->Servers };
  
  my $pcfg = plugin_cfg($self);
  ## FIXME look for contexts that are conf'd but not active
  
  broadcast( 'message',
    $msg->context,
    $msg->channel,
    "Active contexts: ".join ' ', @contexts
  );
  
  return PLUGIN_EAT_ALL
}

sub _cmd_current {
  my ($self, $msg) = @_;

  broadcast( 'message',
    $msg->context,
    $msg->channel,
    "Currently on context ".$msg->context
  );

  return PLUGIN_EAT_ALL
}

sub _cmd_connect {
  my ($self, $msg) = @_;
  
  my $pcfg = plugin_cfg($self);
  
  unless (ref $pcfg eq 'HASH' && keys %$pcfg) {
    broadcast( 'message',
      "Could not locate any network configuration."
    );
    
    logger->error("_cmd_connect could not find an IRC network cfg");
    
    return PLUGIN_EAT_ALL
  }
  
  my $target_ctxt = $msg->message_array->[1];
  
  unless (defined $target_ctxt) {
    broadcast( 'message',
      $msg->context,
      $msg->channel,
      "No context specified."
    );
    
    return PLUGIN_EAT_ALL
  }
  
  unless ($pcfg->{Networks}->{$target_ctxt}) {
    broadcast( 'message',
      $msg->context,
      $msg->channel,
      "Could not locate configuration for context $target_ctxt"
    );
  
    return PLUGIN_EAT_ALL
  }
  
  ## Do we already have this context?
  if (my $ctxt_obj = irc_context($target_ctxt) ) {

    if ($ctxt_obj->connected) {
      broadcast( 'message',
        $msg->context,
        $msg->channel,
        "Attempting reconnect for context $target_ctxt"
      );
    }

    logger->info("Attempting reconnect for context $target_ctxt");

    broadcast( 'ircplug_disconnect', $target_ctxt );
    broadcast( 'ircplug_connect', $target_ctxt );
      
    broadcast( 'ircplug_timer_serv_retry',
        {
          context => $target_ctxt,
          delay   => 300,
        },
      );
      
    return PLUGIN_EAT_ALL
  }

  broadcast( 'message',
    $msg->context,
    $msg->channel,
    "Issuing connect for context $target_ctxt"
  );
  
  my $src_nick = $msg->src_nick;
  my $auth_usr = core->auth->user($msg->context, $src_nick);
  
  logger->info(
   "Issuing connect for context $target_ctxt",
   "(Issued by $src_nick [$auth_usr])"
  );
    
  broadcast( 'ircplug_connect', $target_ctxt );
  
  return PLUGIN_EAT_ALL  
}

sub _cmd_disconnect {
  my ($self, $msg) = @_;
  
  my $target_ctxt = $msg->message_array->[1];
  
  unless (defined $target_ctxt) {
    broadcast( 'message',
      $msg->context,
      $msg->channel,
      "No context specified."
    );
  
    return PLUGIN_EAT_ALL
  }
  
  my $ctxt_obj;
  unless ($ctxt_obj = irc_context($target_ctxt) ) {
    broadcast( 'message',
      $msg->context,
      $msg->channel,
      "Could not find context object for $target_ctxt"
    );
  
    return PLUGIN_EAT_ALL
  }

  unless (keys %{ core->Servers } > 1) {
    broadcast( 'message',
      $msg->context,
      $msg->channel,
      "Refusing disconnect; have no other active contexts."
    );
  
    return PLUGIN_EAT_ALL
  }
  
  broadcast( 'message',
    $msg->context,
    $msg->channel,
    "Attempting to disconnect from $target_ctxt"
  );

  my $src_nick = $msg->src_nick;
  my $auth_usr = core->auth->user($msg->context, $src_nick);
  
  logger->info(
   "Issuing connect for context $target_ctxt",
   "(Issued by $src_nick [$auth_usr])"
  );
  
  broadcast( 'ircplug_disconnect', $target_ctxt );
  
  return PLUGIN_EAT_ALL
}


sub Bot_ircplug_timer_serv_retry {
  my ($self, $core) = splice @_, 0, 2;
  my $hints = ${ $_[0] };
    
  my $context = $hints->{context};
  my $delay   = $hints->{delay} || 300;

  logger->debug("ircplug_timer_serv_retry called for $context");

  my $ctxt_obj;
  unless ($ctxt_obj = irc_context($context) && $ctxt_obj->connected) {
    logger->info("Attempting reconnect to $context . . .");
    
    broadcast( 'ircplug_connect', $context );
    
    core->timer_set( $delay,
      {
        Event => 'ircplug_timer_serv_retry',
        Args  => [ { context => $context, delay => $delay } ],
      },
    );
  }
  
  return PLUGIN_EAT_ALL
}

1;
__END__

=pod

=head1 NAME

Bot::Cobalt::IRC::Role::AdminCmds - IRC-specific admin commands

=head1 SYNOPSIS

  ## Check current context name:
  !server current

  ## List contexts:
  !server list  

  ## Issue a (re)connect:
  !server connect Main
  
  ## Issue a disconnect:
  !server disconnect Alpha

=head1 DESCRIPTION

This is a L<Moo::Role> consumed by the default IRC plugin 
(L<Bot::Cobalt::IRC>). It provides basic administrative commands 
specific to IRC connection control.

As a failsafe you cannot disconnect from all contexts. See the C<die> 
command provided by L<Bot::Cobalt::Plugin::Master> instead.
However, Issuing a connect for a currently-connected context will 
attempt a reconnection (note that it's possible to 'lose' bots this way, 
particularly if the configuration or the remote server has changed in 
some way).

See the L</SYNOPSIS> for basic usage information.

=head1 AUTHOR

Jon Portnoy <avenj@cobaltirc.org>

=cut