#!/opt/bin/perl

# this script checks, fixes and simplifies @match expressions in a map

use Crossfire::Map;

sub fix($) {
   my ($msg) = @_;

   local $_ = $msg;

   # fx pretty common error of having "* First line of response"
   my $response = s/^\* (.*)/*/ ? "\n$1" : "";

   warn "$path ($_) unexpected characters in match \n" if !/^[a-zA-Z\[\]\|\*\!\' 0-9\-\?]+$/;

   s/\[(.)(.)\]/(lc $1) eq (lc $2) ? lc $1 : "[$1$2]"/ge;

   my %alt;

   for my $kw (split /\|/) {
      $kw =~ s/^\s+//;
      $kw =~ s/\s+$//;

      $alt{lc $kw} = $kw;
   }

   $_ = join "|", sort keys %alt;

   $_ .= $response;

   warn "$path <$msg><$_>\n" if $_ ne $msg;
   warn "$path ($_) unexpected characters in match\n" if /[\[\]]/;

   $_
}

sub patch_perl {
  my ($arch) = @_;
  my $patched = 0;

  my @appendinv;

  for (@{$arch->{inventory} || []}) {
     if ($_->{slaying} eq '/python/IPO/send.py') {
        $_->{title} = 'perl';
        $_->{slaying} = 'ipo';
        $patched++
     } elsif ($_->{slaying} eq '/python/IPO/receive.py') {
        $_->{title} = 'perl';
        $_->{slaying} = 'ipo';
        $patched++
     } elsif ($_->{slaying} eq '/python/IPO/board.py') {
        push @appendinv, { _name => 'event_apply', title => 'perl', slaying => 'board' };
        $arch->{msg} = '@match *'."\n".'@eval board::command $who, $msg, $npc'."\n";
        $patched++
     } elsif ($_->{slaying} eq '/python/IPO/say.py') {
        $arch->{msg} = '@match *'."\n".'@eval ipo::command $who, $msg, $npc'."\n";
        $patched++
     } elsif ($_->{slaying} eq '/python/IPO/banksay.py') {
        $arch->{msg} = '@match *'."\n".'@eval bank::command $who, $msg, $npc'."\n";
        $patched++
     }
  }

  if ($arch->{inventory}) {
     my @oinv =
        grep {
           $_->{slaying} ne '/python/IPO/board.py'
           and $_->{slaying} ne '/python/IPO/say.py'
        } @{$arch->{inventory}};
     $patched++ if @oinv < @{$arch->{inventory}};
     @{$arch->{inventory}} = @oinv;
  }

  if (@appendinv) {
     $arch->{inventory} = [@{$arch->{inventory} || []}, @appendinv];
     $patched++
  }

  $patched
}

for $path (@ARGV) {
   eval {
      open my $fh, "<:raw:perlio:utf8", $path
         or die "$path: $!\n";

      <$fh> =~ /^arch map$/
         or die "$path: not a crossfire map file\n";

      my $map = new_from_file Crossfire::Map $path
         or die "$path: file load error\n";

      my $dirty;

      for my $a (map @$_, grep $_, map @$_, grep $_, @{ $map->{map} }) {
         if ($a->{inventory} and patch_perl ($a)) {
            $dirty = 1;
            next;
         }

         next unless $a->{msg} =~ /^\@match /;

         my $old = $a->{msg};

         $a->{msg} =~ s/^(\@match\s+)(.*)$/$1 . fix $2/gme;

         $dirty ||= $old ne $a->{msg};
      }

      $map->write_file ($path)
         if $dirty;

      1
   } or $@ =~ /not a crossfire map/ or warn $@;
}