#!/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 () { 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 () { 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 <; print MAIL "\n"; close(MAIL); } exit 0; }