use feature ':5.10';

BEGIN {
 my $quote = quoted_string('"');
 $quote = qr/^($quote) *(?:[^\s\w\d] *(.*))?$/;
 my $slash = quoted_string('/');
 $slash = qr/^($slash) *(?:[^\s\w\d] *(.*))?$/;

 sub parse_player_name {
  return undef if $_[0] =~ /^\s*$/;
  my @result;
  given (substr $_[0], 0, 1) {
   # When the argument starts with ', assume that player name is quoted with ':
   # kick 'player', reason
   when ("'") { 
    @result = $_[0] =~ /^'(.*)' *(?:[^\s\w\d] *(.*))?/ 
   };
   # When the argument starts with ", assume that player name is quoted with ".
   # If a player name has quote characters in it, they can be escaped:
   # kick "player with \" in its name", reason
   when ('"') {
    @result = $_[0] =~ $quote;
    $result[0] =~ s/\\"/"/g;
    $result[0] = substr($result[0], 1, length($result[0])-2);
   };
   # When the argument starts with /, assume that the regular expression to
   # match a player name is implied.
   # The following kicks a player with a nasty character inside his name:
   # kick /pl.yer/, reason
   when ('/') {
    @result = $_[0] =~ $slash;
    $result[0] =~ s!\\/!/!g;
    $result[0] = substr($result[0], 1, length($result[0])-2);
    $result[0] = qr/$result[0]/;
   };
   default {
    # When the argument is a number assume client id:
    # kick 1, reason
    # (be careful when kicking players whose names is a number!)
    if ($_[0] =~ /^(\d+) *(?:[^\s\w\d] *(.*))?$/) {
     @result = ($1, $2);
    # When the argument starts with some letters, assume they are a part of
    # the player name.
    # The following kicks '(1)Jini', '&Jinii', etc as long as a single player
    # name matches qr/Jini/i:
    # kick Jini, reason
    } elsif ($_[0] =~ /^([\w\d]+) *(?:[^\s\w\d] *(.*))?$/) {
     @result = (qr/$1/i, $2);
    } else {
     die "player_name: ambigious quotation\n";
    }
   };
  };
  return @result if wantarray;
  return $result[0];
 };
};

# Performs standard check whether caller has permissions 
# to do something nasty to the player.
sub inferior_player_cid {
 my ($caller_cid, $args) = @_;
 my ($id, $rest) = parse_player_name $args;
 $id = player_cid $id;
 die "No such player\n" unless defined $id;
 die sprintf "You are not allowed to mess with %s\n", client_name($id)
   if $caller_cid >= 0 && client_gid($id) > client_gid($caller_cid);
 return ($id, $rest) if wantarray;
 return $id;
}

# Provides manuals. 
# When called without arguments, prints the list of available topics (keys %man)
# When the argument is command name, prints its 'man' hash entry.
# When the argument is the topic, prints it.
sub man {
 if (!$_[0]) {
  more keys %man;
  return;
 };

 my $gid = client_gid($RCON_CID);
 my $cmd = $commands{$_[0]};
 if ($cmd) {
  die "Why bother? You have no permissions to execute it anyway\n"
    unless $gid & ($cmd->{'gid'} | $cmd->{'vgid'});

  more $cmd->{'man'};
  return;
 };

 $cmd = $man{$_[0]};
 die "No such topic\n" unless defined $cmd;

 more $cmd;
};

sub do_mute {
 my $action = $_[1] ? 'muted' : 'unmuted';
 given ($_[0]) {
  when ('team')   { 
   $mute[$MAX_CLIENTS]   = $_[1];
   chat "Team chat has been $action";
  };
  when ('public') { 
   $mute[$MAX_CLIENTS+1] = $_[1];
   chat "Public chat has been $action";
  };
  when ('all') { 
   $mute[$MAX_CLIENTS]   = $mute[$MAX_CLIENTS+1] = $_[1];
   chat "Chat has been $action";
  };
  default {
   my $cid = player_cid parse_player_name $_[0];
   die "No such player\n" unless defined $cid;
   $mute[$cid] = $_[1];
   chat $cid, "You have been $action";
  };
 };
};

# Mute player $_[0]
sub mute {
 do_mute player_cid($_[0]), 1;
};

# Unmute player $_[0]
sub unmute {
 do_mute player_cid($_[0]), 0;
};

# The following two are default stubs for commands{'map'}; they are redefined in
# random_maps.pl if it is included
sub set_map {
 sv_map $_[0];
};

sub list_maps {
 return @maps;
};

# Defaults
sv_max_clients $MAX_CLIENTS;
sv_max_clients_per_ip 2;
sv_anticamper 0;
sv_inactivity_kick 0;
sv_inactivity_kick_spect 1;
sv_killingspree_tag 0;
sv_register 0;
sv_spawnprotect_time 0;
sv_teambalance 1;
sv_tournament_mode 1;
sv_warmup 20;

# Chroot target directory
$root = '/srv/teeworlds';

# Group ids
$g_user = 1;
$g_admin = $g_user << 1;

# Groups
%groups = (
 root => {
  gid => $g_root,
  password => '',
 },
 admin => {
  gid => $g_admin,
  password => '',
 },
 user => {
  gid => $g_user,
  password => '.'
 }
);

# man topics
%man = (
 time => <<END
You may specify time in the following manner:
 1h 45m --- one hour, 45 minutes
 6300s  --- the same
 6300   --- the same
The following time units are supported:
s: second
m: minute
h: hour
d: day
w: week
M: month
y: year
i: infinity
END
 ,
 player_name => <<END
You may specify player name in the following manner:
'player name' --- a player whose name exactly matches string 'player name'. No apostrophes allowed inside it.
"player name with \\" and \\\\ characters" --- a player whose name exactly matches string 'player name with " and \\ characters'.
/regular expression/ --- a player whose name matches regular expression. An error will occur if several names match.
word --- a player whose name matches regular expression /word/. An error will occur if several names match.
number --- player client id. Be careful when kicking players whose name is the number!
END
 ,
 server => <<END
This server is based on ~{MS}~ Tom's modifications. Flagball mod was developed by datag, upgraded to teeworlds-0.5 by Oy and merged with Tom's sources by ~{MS}~ Jini. Rcon interface was implemented by Jini. See http://jini-zh.org/teeworlds-perl.html for sources and documentation.

Thanks to teeworlds development team for an awesome game.
END
);

# Command list
%commands = (
 ban => {
  gid  => $g_admin,
  help => 'Bans the player',
  man  => <<END
Usage: ban player_name time
    or ban ip time
See man player_name for how to specify a player name
See man time for how to specify time
END
  ,
  sub  => sub { ban inferior_player_cid $RCON_CID, $_[0] }
 },
 bans => {
  gid  => $g_admin,
  help => 'Prints the list of active bans',
  man  => 'Usage: bans',
  sub  => \&bans
 },
 broadcast => {
  gid  => $g_admin,
  help => 'Send broadcast message to all players',
  man  => 'Usage: broadcast message',
  sub  => sub { broadcast $_[0] }
 },
 'broadcastp' => {
  gid  => $g_admin,
  help => 'Send broadcast message to specific player',
  man  => <<END
Usage: broadcastp player_name, message
See man player_name for how to specify a player name.
END
  ,
  sub  => sub { broadcast inferior_player_cid -1, $_[0] }
 },
 help => {
  gid  => $g_all,
  help => 'Provides short commands description. See also help man',
  man  => 'Usage: help [command]. When no command provided, prints list of available commands',
  sub  => \&help
 },
 kick => {
  gid    => $g_admin,
  help   => 'Kicks the player from the server',
  man    => 'Usage: kick player_name [: reason]. See man player_name for how to specify a player name',
  sub    => sub { kick inferior_player_cid $RCON_CID, $_[0] },
  vgid   => $g_all,
  vcheck => sub { 
   # just perform the check
   inferior_player_cid $_[0], $_[2];
   return 'kick ' . client_name($_[2]);
  } 
 },
 man => {
  gid    => $g_all,
  help   => "Provides additional information. Type `man man' for usage",
  man    => <<END
Usage: man topic
    or man command
    or man
Prints list of topics if no arguments supplied.
END
  ,
  sub => \&man
 },
 map => {
  gid    => $g_all,
  help   => 'Change the map or list available maps',
  man    => 'Usage: map [map_name]. Lists maps if invoked without arguments',
  sub    => sub {
   if ($_[0]) { 
    die "You have no permissions to execute this command\n"
      if !$_[1] && $RCON_CID >= 0 && !(client_gid($RCON_CID) & $g_admin);

    # sv_map won't like spaces
    $_[0] =~ s/^ +//;
    $_[0] =~ s/ +$//;

    set_map $_[0] 
   } else { more list_maps() };
  },
  vgid   => $g_all,
  vcheck => sub {
   die "No such map\n" unless $_[2] ~~ [ list_maps() ];
   die "Useless vote\n" if $_[2] eq sv_map();
  }
 },
 mute => {
  gid  => $g_admin,
  help => 'Mute the chat',
  man  => <<END
Usage: mute team
    or mute public
    or mute all
    or mute player_name
See man player_name for how to specify player name.
END
  ,
  sub => sub {
   # Note: double check. Redesign
   mute(
    $_[0] ~~ ('team', 'public', 'all') 
    ? $_[0] 
    : inferior_player_cid $RCON_CID, $_[0]
   );
  }
 },
 pause => {
  gid    => $g_admin,
  help   => 'Pause the game',
  man    => 'Usage: pause. Execute pause again to unpause the game',
  sub    => sub { pause },
  vgid   => $g_all
 },
 status => {
  gid  => $g_admin,
  help => 'Shows players information',
  man  => 'Usage: status',
  sub  => \&status
 },
 restart => {
  gid  => $g_admin,
  help => 'Restarts current map',
  man  => 'Usage: restart [warmup]. warmup is the warmup time in seconds. Default is zero',
  sub  => \&restart,
  vgid => $g_all
 },
 start_vote => {
  gid  => $g_all,
  help => 'Start a vote',
  man  => 'Usage: start_vote command',
  sub  => \&start_cmd_vote
 },
 su => {
  gid => $g_all,
  help => 'Grants more rights',
  man  => <<END
Usage: su password
You may log into several groups by invoking su several times with different passwords
END
 ,
  sub  => \&su
 },
 sv_playerlimit => {
  gid    => $g_admin,
  help   => 'Set the limit of player slots',
  man    => 'Usage: sv_playerlimit number',
  sub    => sub {
   if ($_[0] ne '') { sv_playerlimit @_ }
   else { reply sv_playerlimit }
  },
  vgid   => $g_all,
  vcheck => sub {
   die "Incorrect value, expected even number between 2 and $MAX_CLIENTS\n"
     unless $_[2] % 2 == 0 && $_[2] >= 2 && $_[2] <= $MAX_CLIENTS;
   die "Useless vote\n" if $_[2] == sv_playerlimit();
  }
 },
 team => {
  gid  => $g_admin,
  help => 'Move player to another team',
  man  => <<END
Usage: team player_name, team
See man player_name for how to specify player name.
team can be one of: red, blue, spec
END
  ,
  sub  => sub { team inferior_player_cid $RCON_CID, $_[0] },
  vgid => $g_all,
  vcheck => sub {
   my ($id, $team) = inferior_player_cid $_[0], $_[2];
   die "Useless vote\n" if client_team($id) == $team;
  }
 },
 unban => {
  gid  => $g_admin,
  help => 'Removes the ban',
  man  => 'Usage: unban ip',
  sub  => \&unban
 },
 unmute => {
  gid  => $g_admin,
  help => 'Unmute the chat',
  man  => <<END
Usage: unmute team
    or unmute public
    or unmute all
    or unmute player_name
END
  ,
  sub => \&unmute
 },
 vote  => {
  gid  => $g_admin,
  help => 'Forces the vote',
  man  => <<END
Usage: vote yes
    or vote no
    or vote 1
    or vote 0
END
  ,
  'sub'=> \&vote
 }
);

# Make the basic settings available to admin
foreach (
 'sv_anticamper',
 'sv_anticamper_range',
 'sv_anticamper_time',
 'sv_killingspree_award',
 'sv_killingspree_award_lasers',
 'sv_killingspree_award_lasers_split',
 'sv_killingspree_award_reload',
 'sv_laser_gothroughplayers',
 'sv_laserjumps',
 'sv_laser_reload',
 'sv_lasers',
 'sv_lasers_split',
 'sv_scorelimit',
 'sv_spectator_slots',
 'sv_teambalance',
 'sv_teambalance_time',
 'sv_teamdamage',
 'sv_timelimit',
 'sv_vote_kick',
 'sv_warmup',
) {
 $commands{$_} = {
  gid  => $g_admin,
  help => $config{$_}->help(),
  man  => "Usage: $_ " . (ref $config{$_} eq 'config::int' ? 'integer' : 'string'),
  sub  => sub {
   my $c = $config{$_};
   return sub {
    if ($_[0] ne '') { $c->set(@_) }
    else { reply $c->get() };
   };
  }->()
 };
};

# Make these settings votable
foreach (
 'sv_killingspree_award',
 'sv_laser_gothroughplayers',
 'sv_laserjumps',
 'sv_teamdamage',
 'sv_timelimit',
 'sv_scorelimit',
 'sv_spectator_slots'
) {
 $commands{$_}{'vgid'}   = $g_all;
 $commands{$_}{'vcheck'} = sub {
  my $c = $config{$_};
  return sub {
   die sprintf "Expected value between %d and %d\n", $c->min(), $c->max()
     if $_[2] < $c->min() || $_[2] > $c->max();
   die "Useless vote\n" if $_[2] == $c->get();
  };
 }->();
};

sub on_client_disconnect {
 $mute[$_[0]] = 0;
};

sub on_client_enter {
 chat $_[0], 
      sprintf 'Welcome, %s. Rcon password is "%s"',
              client_name($_[0]),
	      $groups{'user'}{'password'};
};

sub on_client_auth {
 reply sprintf 'Welcome, %s. You have logged in with %s rights' 
               . ($_[1] ne 'root' ? '. Type help for help' : ''),
	       client_name($_[0]), $_[1];
};

sub server_send_chat {
 send_chat @_[0..2] 
  unless $_[0] >= 0 && (
   $_[3]                                   # ban binds
   || $mute[$_[0]]                         # ban jerks
   || $mute[$MAX_CLIENTS] && $_[1] != -3   # with an exception for spectators...
      && $_[1]+2 == client_team($_[0])     # ...ban team chat
   || $mute[$MAX_CLIENTS+1] && $_[1] == -4 # ban public chat
  );
};

1;
