package CelBot::Commands;

use strict;

use CelBot::CommandContext;

use Carp;

sub new
{
   my $class = shift;
   my ( $core ) = @_;

   my $self = bless {
      core => $core,
      irc  => $core->get_plugin( "irc" ),
   }, $class;

   return $self;
}

sub reconfigure
{
   my $self = shift;

   # First clear out all the existing ones
   $self->{commands} = {};

   my $core = $self->{core};
   $core->run_plugins( "register_commands", $self );
}

sub _check_cmdstruct
{
   my $self = shift;
   my ( $cmdstruct, $parent, $cmdname, $funcname ) = @_;

   $funcname = $cmdstruct->{funcname} if exists $cmdstruct->{funcname};
   $funcname = "command_$cmdname" if !defined $funcname;

   my $plugin = $cmdstruct->{plugin} ||
      $parent && ( $cmdstruct->{plugin} = $parent->{plugin} )
      or croak "Need a 'plugin' for $cmdname";

   $cmdstruct->{scope}
      or $parent and $cmdstruct->{scope} = $parent->{scope}
      or $cmdstruct->{scope} = "privmsg";

   $cmdstruct->{perm}
      or $parent and $cmdstruct->{perm} = $parent->{perm}
      or $cmdstruct->{perm} = "recognised";

   if( $cmdstruct->{args} and $cmdstruct->{subcmds} ) {
      $cmdstruct->{subcmds} and croak "Cannot have both 'args' and 'subcmds' for $cmdname";
   }

   elsif( my $args = $cmdstruct->{args} ) {
      ref $args eq "ARRAY" or croak "Expected 'args' to be ARRAY ref for $cmdname";
      if( not $cmdstruct->{function} ) {
         $plugin->can( $funcname ) or croak "Plugin $plugin cannot ->$funcname()";
         $cmdstruct->{function} = sub { $plugin->$funcname( @_ ) };
      }
   }

   elsif( my $subs = $cmdstruct->{subcmds} ) {
      ref $subs eq "HASH" or croak "Expected 'subcmds' to be HASH ref for $cmdname";
      foreach my $subcmd ( keys %$subs ) {
         $self->_check_cmdstruct( $subs->{$subcmd}, $cmdstruct, "${cmdname} ${subcmd}", "${funcname}_${subcmd}" );
      }
      if( defined $cmdstruct->{default} ) {
         exists $subs->{$cmdstruct->{default}} or croak "Default command for $cmdname does not exist";
      }
   }

   else {
      croak "Need either 'args' or 'subcmds' for $cmdname";
   }
}

sub register
{
   my $self = shift;
   my %args = @_;

   my $command = delete $args{command} or croak "Need a 'command'";

   exists $self->{commands}->{$command} and croak "Command '$command' already registered";

   $self->_check_cmdstruct( \%args, undef, $command );

   $self->{commands}->{$command} = \%args;
}

sub _parse_args
{
   my $self = shift;
   my ( $argspecs, $context ) = @_;

   return [] unless defined $argspecs and @$argspecs;

   my @args;

   foreach my $arg ( @$argspecs ) {
      last if $arg->trailing;

      if( $arg->eatall ) {
         push @args, $context->text;
         last;
      }
      else {
         eval { push @args, $arg->pull( $context ); };
         if( $@ ) {
            $context->respond_noise( $@ );
            return;
         }
      }
   }

   if( !$argspecs->[-1]->trailing and !$argspecs->[-1]->eatall ) {
      if( length $context->text ) {
         $context->respond_noise( "Extra arguments found: '" . $context->text . "'" );
         return;
      }
   }

   return \@args;
}

sub run_command
{
   my $self = shift;
   my ( $context ) = @_;

   my $cmdname = $context->pull_token;

   if( !exists $self->{commands}->{$cmdname} ) {
      my $response = "No such command '$cmdname'";

      $response .= ", and please don't shout" if( $cmdname eq uc $cmdname );

      $context->respond_noise( $response ) if $context->allows_nonpublic;
      return;
   }

   my $cmdstruct = $self->{commands}->{$cmdname};

   $self->run_cmdstruct( $cmdstruct, $context, $cmdname );
}

sub run_cmdstruct
{
   my $self = shift;
   my ( $cmdstruct, $context, $cmdname ) = @_;

   # Disallow non-recoginised users from running any command that isn't public
   return if( !$context->allows_nonpublic and $cmdstruct->{perm} ne "public" );

   my $core = $self->{core};

   unless( $context->allows_scope( $cmdstruct->{scope} ) ) {
      $context->respond_noise( "Not allowed in this scope" );
      return;
   }

   unless( $context->allows_perm( $cmdstruct->{perm} ) ) {
      $context->respond_noise( "$cmdname: You are not allowed" );
      return;
   }

   if( my $subs = $cmdstruct->{subcmds} ) {
      my $subcmd = $context->pull_token;
      $subcmd ||= $cmdstruct->{default};

      if( !defined $subcmd ) {
         $context->respond_noise( "$cmdname: Need a subcommand name" );
         return;
      }

      if( !exists $subs->{$subcmd} ) {
         $context->respond_noise( "$cmdname: Has no subcommand '$subcmd'" );
         return;
      }

      my $substruct = $subs->{$subcmd};

      if( my $checkfunc = $cmdstruct->{checkfunc} ) {
         return unless $checkfunc->( $context, $cmdstruct, $substruct );
      }

      $self->run_cmdstruct( $substruct, $context, "${cmdname} ${subcmd}" );
      return;
   }

   my ( $argsref ) = $self->_parse_args( $cmdstruct->{args}, $context );
   return unless $argsref;

   if( my $checkfunc = $cmdstruct->{checkfunc} ) {
      return unless $checkfunc->( $context, $cmdstruct, $argsref );
   }

   my $function = $cmdstruct->{function};
   my @response = $function->( $context, @$argsref );

   $context->respond( @response );
}

sub on_channel_privmsg
{
   my $self = shift;
   my ( $channel, $user, $text ) = @_;

   my $irc = $self->{irc};

   return 0 unless $text =~ m/^(\S+):\s+(.*)$/;
   return 0 unless $irc->is_me( $1 );
   $text = $2;

   my $nick = $user->nick;

   my $context = CelBot::CommandContext->new(
      core => $self->{core},

      scope   => "channel",
      cmduser => $user,
      text    => $text,

      max_spam => 3, # TODO: Per-channel lookup?

      channel => $channel,

      responder => sub {
         $channel->privmsg( "$nick: $_[0]" );
      },
   );

   $self->run_command( $context );

   return 1;
}

sub on_user_privmsg
{
   my $self = shift;
   my ( $user, $text ) = @_;

   my $context = CelBot::CommandContext->new(
      core => $self->{core},

      scope   => "privmsg",
      cmduser => $user,
      text    => $text,

      max_spam => 10, # TODO: Per-user lookup?
      allows_noise => 1,

      responder => sub {
         $user->privmsg( $_[0] );
      },
   );

   $self->run_command( $context );

   return 1;
}

sub on_console_line
{
   my $self = shift;
   my ( $tab, $text ) = @_;

   my $core = $self->{core};

   # Cheat
   my $cmdname = (split ' ', $text)[0];

   my $context = CelBot::CommandContext->new(
      core => $self->{core},

      scope => "console",
      text  => $text,

      max_spam => undef,
      allows_noise => 1,

      list_responder => sub {
         my @lines = @_;
         $tab->add_line( "$cmdname: $lines[0]" ); shift @lines;
         $tab->add_line( "          $_" ) for @lines;
      }
   );

   $self->run_command( $context );

   return 1;
}

sub permit_command_scope
{
   my $self = shift;
   my ( $scope, $context ) = @_;

   return 1 if $scope eq 'any';
   return 1 if grep { $context->scope eq $_ } split( m{\|}, $scope );

   return undef;
}

sub permit_command_perm
{
   my $self = shift;
   my ( $perm, $context ) = @_;

   return 1 if grep { $_ eq 'public' } split( m{\|}, $perm );

   return undef;
}

###
# Internal Commands
###

sub register_commands
{
   my $self = shift;
   my ( $commands_plugin ) = @_;

   $commands_plugin->register(
      plugin  => $self,
      command => "help",
      perm    => 'public',

      args => [
         CelBot::Commands::ArgSpec::Command->new( 'command', optional => 1, commands => $self->{commands} ),
         CelBot::Commands::ArgSpec->new( 'args', trailing => 1 ),
      ],

      summary => "Obtain help on available commands",
   );
}

sub command_help
{
   my $self = shift;
   my ( $context, $helpcmd ) = @_;

   if( !defined $helpcmd ) {
      my @ret;

      if( keys %{ $self->{commands} } ) {
         push @ret, "Commands (* denotes public):";

         my @commands;
         foreach my $command ( sort keys %{ $self->{commands} } ) {
            my $cmdstruct = $self->{commands}->{$command};

            next unless $context->allows_perm( $cmdstruct->{perm} );

            push @commands, ( $cmdstruct->{perm} eq "public" ? "*$command" : $command );
         }

         push @ret, join( "  ", @commands );
      }

      return @ret;
   }

   my $cmdstruct = $self->{commands}->{$helpcmd};
   $self->_do_help_cmdstruct( $cmdstruct, $context, $helpcmd );
}

sub _do_help_cmdstruct
{
   my $self = shift;
   my ( $cmdstruct, $context, $helpcmd ) = @_;

   if( !length $context->text ) {
      my @ret;

      push @ret, "Summary: $cmdstruct->{summary}" if defined $cmdstruct->{summary};

      if( $cmdstruct->{args} ) {
         push @ret, "Usage  : $helpcmd " . join( " ", map { $_->usage } @{ $cmdstruct->{args} } );
      }
      elsif( my $subs = $cmdstruct->{subcmds} ) {
         push @ret, "Subcommands: " . join( " ", sort keys %$subs );
      }

      if( $cmdstruct->{helpargs} ) {
         push @ret, "       : help $helpcmd " . join( " ", map { $_->usage } @{ $cmdstruct->{helpargs} } );
      }

      return @ret;
   }
   elsif( defined $cmdstruct->{helpargs} ) {
      my ( $helpargsref ) = $self->_parse_args( $cmdstruct->{helpargs}, $context );
      return unless $helpargsref;

      my $cmdplugin = $cmdstruct->{plugin};
      my $helpcmdmethod = "commandhelp_$helpcmd";
      my @response = $cmdplugin->$helpcmdmethod( $context, @$helpargsref );

      foreach my $line ( @response ) {
         # Protect against linefeeds in the line itself
         $context->respond( $_ ) foreach split( m/\n/, $line );
      }
   }
   elsif( my $subs = $cmdstruct->{subcmds} ) {
      my $subcmd = $context->pull_token;
      if( !defined $subcmd ) {
         return( "help $helpcmd: Need a subcommand name" );
      }

      if( !exists $subs->{$subcmd} ) {
         return( "'$helpcmd' has no subcommand '$subcmd'" );
      }

      $self->_do_help_cmdstruct( $subs->{$subcmd}, $context, "$helpcmd $subcmd" );
   }
   else {
      return ( "'$helpcmd' has no additional help" );
   }
}

# Keep perl happy, keep Britain tidy
1;


package CelBot::Commands::ArgSpec;

use strict;

sub new
{
   my $class = shift;
   my ( $name, %args ) = @_;

   $args{name} = $name;

   return bless \%args, $class;
}

sub name
{
   my $self = shift;
   return $self->{name};
}

sub optional
{
   my $self = shift;
   return $self->{optional};
}

sub trailing
{
   my $self = shift;
   return $self->{trailing};
}

sub eatall
{
   my $self = shift;
   return $self->{eatall};
}

sub usage
{
   my $self = shift;

   my $trailing = $self->trailing || $self->eatall ? "..." : "";

   if( $self->optional ) {
      return '[$' . $self->name . $trailing . "]";
   }
   else {
      return '$' . $self->name . $trailing;
   }
}

sub pull
{
   my $self = shift;
   die "ABSTRACT";
}

sub validate
{
   my $self = shift;
   my ( $val ) = @_;

   if( $self->{match} ) {
      die "Unrecognised value for '$self->{name}': $val\n" unless $val =~ $self->{match};
   }

   return $val;
}

1;

package CelBot::Commands::ArgSpec::Bareword;

use strict;
use base qw( CelBot::Commands::ArgSpec );

sub pull
{
   my $self = shift;
   my ( $context ) = @_;

   my $word = $context->pull_token;

   return undef if !defined $word and $self->{optional};

   die "Need to supply '$self->{name}'\n" if !defined $word;

   return $self->validate( $word );
}

1;

package CelBot::Commands::ArgSpec::Sugar;

use strict;
use base qw( CelBot::Commands::ArgSpec::Bareword );

sub usage
{
   my $self = shift;
   return $self->{name};
}

sub validate
{
   my $self = shift;
   my ( $word ) = @_;

   die "Expected '$self->{name}'" unless $word eq $self->{name};

   return (); # Empty list
}

1;

package CelBot::Commands::ArgSpec::HashKey;

use strict;
use base qw( CelBot::Commands::ArgSpec::Bareword );

sub validate
{
   my $self = shift;
   my ( $word ) = @_;

   die "'$word' is not a valid value of $self->{name}\n" unless exists $self->{hash}->{$word};
   
   return $word;
}

1;

package CelBot::Commands::ArgSpec::HashValue;

use strict;
use base qw( CelBot::Commands::ArgSpec::Bareword );

sub validate
{
   my $self = shift;
   my ( $word ) = @_;

   die "'$word' is not a valid value of $self->{name}\n" unless exists $self->{hash}->{$word};
   
   return $self->{hash}->{$word};
}

1;

package CelBot::Commands::ArgSpec::Options;

use strict;
use base qw( CelBot::Commands::ArgSpec );

sub new
{
   my $class = shift;
   my ( $opts, %args ) = @_;

   # Name doesn't matter since we override 'usage' not to print it
   return $class->SUPER::new( 'options', options => $opts, %args );
}

sub usage
{
   my $self = shift;

   my $options = $self->{options};

   return "[" . join( "|", map { "$_ " . $options->{$_}->usage } sort keys %$options ) . "]";
}

sub pull
{
   my $self = shift;
   my ( $context ) = @_;

   my $opts = $self->{options};
   my %optvalues;

   while(1) {
      my $optname = $context->peek_token;
      last unless defined $optname;

      last unless exists $opts->{$optname};

      die "Cannot supply '$optname' option more than once\n" if exists $optvalues{$optname};

      $context->pull_token; # Eat the optname token we peeked at

      my $opt = $opts->{$optname};

      $optvalues{$optname} = $opt->pull( $context );
   }

   return \%optvalues;
}

1;


package CelBot::Commands::ArgSpec::Command;

use strict;
use base qw( CelBot::Commands::ArgSpec::Bareword );

sub validate
{
   my $self = shift;
   my ( $cmdname ) = @_;

   die "No such command '$cmdname'\n" unless exists $self->{commands}->{$cmdname};

   return $cmdname;
}

1;