#!/usr/local/bin/perl5
# -*-perl-*-
# movefilter
# This program accepts email on its stdin
# The email should be a properly formatted Riverworld move
# It sends the move on to the mailing list and creates customized
# versions of the move for each player to reflect language knowledge.
# It mails these out to the players
#

require "/home/alansz/rw/rw-lib.ph";

$arg = shift(@ARGV);
$debug = 1, $arg = shift(@ARGV) if $arg eq "-d";
if ($arg) {
  $arg =~ tr/A-Z/a-z/;
  $groups = $groups{$arg};
}
@players = grep($groups =~ /$_/i,@players) if $groups;

# Scan out the headers first 
while (<STDIN>) {
  last if /^$/;
	    if (/^(?:From|Reply-To):\s+(.*)/) {
		$sender = $1;
		unless ($sender =~ /@/) {
		  if ($sender =~ /(.*)\>(.*)/) {
		    $sender = $1 . '@mellers1.psych.berkeley.edu>' . $2;
		  } else {
		    $sender .= '@mellers1.psych.berkeley.edu';
		  }
		}
            } elsif (/^Subject:\s+\[\s*(.*)\s*\]\s*(.*)/) {
		$speaker = &getspeaker($1);
		$subject = $2;
	    }
}
&bounce_and_die if (!$speaker || $speaker eq "Unknown");

foreach (@players) {
    if ($debug) {
	open($_,">$_");
    } else {
	open($_,"|/usr/lib/sendmail $emails{$_}");
    }
    select($_);
    print "From: $sender\n";
    print "To: $mailing_list\n";
    print "Subject: [$speaker] $subject\n";
    print "X-RW-Movefilter: $_\n";
    print "X-RW-Arg: $arg\n\n";
}

$lang = "all";

INPUTLINE:
while (<STDIN>) {
    next if $last eq $_; # Remove consecutive blanks
    $last = $_;
    $inspeech = 1 if (/^\s*"/);
    $inprivate = 1 if (/^\*private\*/i);
    PLAYER:
	foreach $p (@players) {
	  select($p);
	    if ($inprivate) {
		print if $p eq "alan";
		next PLAYER;
	    } 
            if (/^\<([^@]*)\>/) {
	      $lang = $1;
	      $lang =~ s/^(.)/\U$1/;
	      $numlangs{$p}++;
	      $lang = &expandlang($lang);
	      if (&reallang($lang)) {
	       print "$speaker began speaking in $lang.\n" if $numlangs{$p} == 1;
	       print "$speaker switched to $lang.\n" if $numlangs{$p} > 1;
              }
	      next PLAYER;
	    }
	    if ($inspeech) {
	      print if (&speaks($p,$lang));
	    } else {
	      print;
	    }
	}
	$inspeech = 0 if (/"\s*$/);
	$inprivate = 0 if (/^\*public\*/i);
}
foreach (@players) {
    close($_);
}

exit 0;

sub getspeaker {
    local($sp) = $_[0];
    $sp =~ tr/A-Z/a-z/;
    unless ($players{$sp} || $npcs{$sp}) {
	foreach $someone (@players) {
	    $sp = $someone, last if $sp =~ /$someone/i;
	}
	unless ($players{$sp}) {
	    # search aliases!
	    if ($aliases{$sp}) {
		$sp = $aliases{$sp};
	    } else {
		# Try their email address
		foreach $someone (@players) {
		    $sp = $someone, last
			if $emails{$someone} =~ /$sender/i;
		}
		$sp = "Unknown" unless ($players{$sp});
	    }
	}
    }
    $sp =~ s/^(.)/\u$1/;
    return $sp;
}

# Bounce message back to $sender, if we've got one, and quit
sub bounce_and_die {
  $arg = "moves" unless $arg;
  if (open(LOG,">>movefilter.log")) {
    print LOG "bounce_and_die: rw-$arg, sender $sender, speaker $speaker\n";
    close(LOG);
  }
  if ($sender) {
     open(MAIL,"|-") || exec 'sendmail','-oi','-t';
     print MAIL <<EOP;
To: $sender
Cc: alansz\@mellers1.psych.berkeley.edu
From: alansz\@mellers1.psych.berkeley.edu
Subject: Improperly formatted message to rw-$arg

This is an automated response.  If you reply to it, you'll reach Alan,

Your message to rw-$arg couldn't be distributed. This almost
certainly means that your Subject: header was not properly formatted.
Subject headers should begin with your character's name in brackets,
like this:

  [Freud] Sometimes a cigar...

Your message body is included below. You can just forward it back
to the list with the proper subject line (erasing all of this
stuff) and things should be fine.

If you think something else is the problem, let Alan know.

---------Your message follows--------
EOP
   print MAIL <STDIN>;
   print MAIL "\n";
   close(MAIL);
  }
  exit 0;
}