#! perl

# miscellaneous commands

sub rename_to($$$) {
   my ($ob, $from, $to) = @_;

   $to =~ /^[a-zA-Z0-9.,=#\/%$!^]*$/
      or return $ob->message ("rename: name must consist only of letters, digits, spaces and a few other things.");

   127 >= length $to
      or return $ob->message ("rename: new name must be <= 127 characters.");

   my $item;

   if (length $from) {
      $item = $ob->find_best_object_match ($from)
         or return $ob->message ("rename: could not find a matching item to rename.");
   } else {
      $item = $ob->find_marked_object ()
         or return $ob->message ("rename: no from name and no marked item found to rename.");
   }

  $item->custom_name (length $to ? $to : undef);

  if (length $to) {
     $item->custom_name ($to);
     $ob->message ("Your " . $item->base_name . " will now be called $to.");
  } else {
     $item->custom_name (undef);
     $ob->message ("You stop calling your " . $item->base_name . " with weird names.");
  }

  $ob->esrv_update_item (cf::UPD_NAME, $item);

  return 1;
}

sub who_listing(;$) {
   my ($privileged) = @_;

   my ($numwiz, $numafk) = (0, 0);
   my @pl;

   foreach my $pl (cf::player::list) {
      my $ob = $pl->ob;

      next unless $ob->map
               && ($privileged || !$pl->hidden);

      $numwiz++ if $ob->flag (cf::FLAG_WIZ);
      $numafk++ if $ob->flag (cf::FLAG_AFK);

      push @pl, $pl;
   }

   (
      "Total Players in The World. (" . (scalar @pl) . ") -- WIZ($numwiz) AFK($numafk) BOT(0)",
      map {
         my ($pl, $ob) = ($_, $_->ob);
 
         "* " . $ob->name . "/" . $ob->level . " " . (length $pl->own_title ? $pl->own_title : "the " . $pl->title)
         . ($pl->peaceful ? " [peaceful]" : " [HOSTILE]")
         . ($ob->flag (cf::FLAG_AFK) ? " [AFK]" : "")
         . ($ob->flag (cf::FLAG_WIZ) ? " [WIZ]" : "")
         . " [" . $pl->client . "]"
         . " [" . ($pl->peaceful ? $ob->map->path : $ob->map->region ? $ob->map->region->name : "the unknown") . "]"
         . ($privileged ? " " . $pl->host : "")
      } sort { $a->ob->name cmp $b->ob->name } @pl
   )
}

cf::register_command who => $cf::TICK, sub {
   my ($ob, $arg) = @_;

   $ob->reply (undef, (join "x\n", who_listing $ob->flag (cf::FLAG_WIZ)), cf::NDI_UNIQUE | cf::NDI_GOLD);
};

cf::register_command rename => $cf::TICK, sub {
   my ($ob, $arg) = @_;

   if ($arg =~ /^\s* (?: <([^>]+)> \s+)? to \s+ <([^>]+)> \s*$/x) {
      # compatibility syntax
      rename_to $ob, $1, $2;
   } elsif ($arg =~ /
               ^\s*
               (?:
                  (?: "((?:[^"]+|\\.)*)" | (\S+) )
               \s+)?
               to \s+
               (?: "((?:[^"]+|\\.)*)" | (\S+) )
               \s*$
            /x) {
      # does not unquote $1 or $3
      rename_to $ob, $2||$1, $4||$3;
   } else {
      $ob->reply (undef, 'Syntax error. Rename usage: rename ["oldname"] to "newname"');
   }
};