#!/usr/bin/perl
use integer;
use strict qw(subs refs);
use Math::Random;
require 5.004;

#Email server to generate random dice rolls
#Copyright (C) 1999 Steve C. Lamb <morpheus@rpglink.com>

#This program is free software; you can redistribute it and/or
#modify it under the terms of the GNU General Public License
#as published by the Free Software Foundation; either version 2
#of the License, or (at your option) any later version.

#This program is distributed in the hope that it will be useful,
#but WITHOUT ANY WARRANTY; without even the implied warranty of
#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#GNU General Public License for more details.

#You should have received a copy of the GNU General Public License
#along with this program; if not, write to the Free Software
#Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

# --------- Begin the work ------------
# Init some variables
$to = "";
$subj = "RPGLink Dice Server Results";
$from = "dserv\@rpglink.com";
$relimit = 0;
$dielimit = 0;
$ruleset = "ST";  # default to Standard Ruleset
$wodtarget = 6;   # Default to 6 for the WoD ruleset
$mailprogram = "/usr/sbin/exim -t";
$build = "v0.6.1";

# -------------------------------------

sub make_date {
  @time = gmtime(time);
  my(@month) = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec");
  my(@dow) = ("Sun","Mon","Tue","Wed","Thu","Fri","Sat");
  $time[5] += 1900;
  my($date) = sprintf("Date: %s, %02d %s %d %02d:%02d:%02d +0000",$dow[$time[6]],$time[3],$month[$time[4]],$time[5],$time[2],$time[1],$time[0]);
  return($date);
}

sub make_msgid {
  $msgid = time."$from";
}

sub build_headers {
  $to = "To: ".$to."\n";
  $subj = "Subject: ".$subj."\n";
  $msgid = "Message-ID: ".make_msgid()."\n\n";
  $from = "From: ".$from."\n";
  $date = "Date: ".make_date()."\n";
  $mailer = "X-Mailer: dserv $build\n";
  @headers = ($to,$from,$subj,$date,$mailer,$msgid);
}

sub send_results {
#  open(MAIL,"|$mailprogram");
  open(MAIL,">output");
  build_headers();
  print(MAIL @headers);
  print(MAIL @body);
  close(MAIL);
}  

sub add_body {
  my($output) = shift;
  push(@body,$output);
}

# Standard xDy+z 
sub ST_ruleset { 
  my($die, $sides, $pm, $mod) = @_;
  my($dice) = "";
  $total = 0;
  $dielimit += 1;
  $rolltrue = 1;
  srand(random_normal());
  for ($x=0; $x < $die ; $x++){
    $newdie = int(rand($sides))+1;
    $total += $newdie;
    $dice = $dice.$newdie." ";
  }
  if ($mod){
    if ($pm == "+"){
      $total += $mod;
    }
    else{
      $total -= $mod;
    }
  }
  add_body($ruleset.": ".$die."d".$sides.$pm.$mod.": ".$dice."= ".$total."\n");
}

# World of Darkness ruleset
sub WD_ruleset { 
  my($die, $sides, $pm, $mod) = @_;
  my($dice) = "";
  $dielimit = $dielimit+1;
  $total = 0;     # For WoD $total tallies number of successes
  $rolltrue = 1;
  srand(random_normal());
  for ($x=0; $x < $die ; $x++){
    $newdie = int(rand($sides))+1;
    if ($newdie == 1){
      $dice = $dice."-".$newdie."- ";
      $total -= 1;
    }
    elsif ($newdie >= $wodtarget){
      $dice = $dice.$newdie."* ";
      $total += 1;
    }
    else{
      $dice = $dice.$newdie." ";
    }
  }
  add_body($ruleset.": ".$die."d".$sides.": ".$dice."= ".$total." - ");
  if ($total < 0){
    add_body("Botch!\n");
  }
  elsif ($total == 0){
    add_body("No success.\n");
  }
  elsif ($total == 1){
    add_body("Marginal success.\n");
  }
  elsif ($total == 2){
    add_body("Moderate success.\n");
  }
  elsif ($total == 3){
    add_body("Complete success.\n");
  }
  elsif ($total == 4){
    add_body("Exceptional success.\n");
  }
  else{
    add_body("Phenominal success.\n");
  }
}

# xDy+z with Star Wars extensions
sub SW_ruleset { 
  my($die, $sides, $pm, $mod) = @_;
  my($dice) = "";
  $total = 0;
  $dielimit = $dielimit+1;
  $rolltrue = 1;
  srand(random_normal());
  for ($x=0; $x < $die ; $x++){
    $newdie = int(rand($sides))+1;
    if (($newdie == $sides) && ($x == 0)){ # Wild die a max_sides?
      $total += $newdie;
      $dice = $dice."(".$newdie." ";
      $newdie = int(rand($sides))+1;
      while ($newdie == $sides){           # Another max_sides?
        $total += $newdie;
        $dice = $dice.$newdie." ";
        $newdie = int(rand($sides))+1;
      }
      $total += $newdie;
      $dice = $dice.$newdie.") ";
      $x += 1;
      $newdie = int(rand($sides))+1;
    }
    elsif (($newdie == 1) && ($x == 0)){ # Wild die a 1?
      $total = $total+$newdie;
      $dice = $dice."-".$newdie."- ";
      $x += 1;
      $newdie = int(rand($sides))+1;
    }
    $total += $newdie;
    $dice = $dice.$newdie." ";
  }
  if ($mod){
    if ($pm == "+"){
      $total += $mod;
    }
    else{
      $total -= $mod;
    }
  }
  add_body($ruleset.": ".$die."d".$sides.$pm.$mod.": ".$dice."= ".$total."\n");
}

srand($$);  # initialize randomizer
while(<>){
  study($_);
 # Catch email addresses, build a list to send out to.
  if (/^[rR][Ee]: ([\w,\d,\.,\-]+[\@]{1,1}[\w,\d,.]+)/){
    if ($relimit < 5){ # limits replies
      $relimit += 1;
      if ($to){
        $to = "$to,$1";
      }
      else{
        $to = $1;
      }
      $retrue = 1;
    }
  }
  #Catch dice and roll them
  elsif (/^(\d{1,2})[Dd](\d{1,3})$/ || /^(\d{1,2})[Dd](\d{1,3})([\+\-])(\d{1,2})$/){ #catches standard dice notation
    if ($dielimit < 20){ # limit rolls
      if ($ruleset eq "ST"){
        ST_ruleset($1, $2, $3, $4);
      }
      elsif ($ruleset eq "SW"){
        SW_ruleset($1, $2, $3, $4);
      }
      elsif ($ruleset eq "WD"){
        WD_ruleset($1, $2, $3, $4);
      }
    }
  }
  # Next few ifs are to catch comments and "whitespace" coments
  elsif (/^[Cc][Oo]:(.*)$/){
    $comment = $1;
    $comment =~ s/^\s+//; 
    add_body("Co: $1\n");
  }
  # Next few ifs are to catch the changes in the rulesets
  elsif (/^[Rr][Uu]: (\w\w)$/){
    $newrule = lc($1);
    if ($newrule eq "st"){
      add_body("Ru: Ruleset switched to: Standard (ST)\n");
      $ruleset = "ST";
    }
    elsif ($newrule eq "sw"){
      add_body("Ru: Ruleset switched to: Star Wars (SW)\n");
      $ruleset = "SW";
    }
    elsif ($newrule eq "wd"){
      add_body("Ru: Ruleset switched to: Worlds of Darkness (WD)\n");
      add_body("Ta: Target defaults to $wodtarget\n");
      $ruleset = "WD";
    }
    else{
      add_body("Er: Unrecognized ruleset \"$1\"\n");
    }
  }
  # Next batch takes care of changing target numbers for the appopriate ruleset
  elsif (/^[Tt][Aa]: (\d*)$/){
    if ($ruleset eq "WD"){
      if ($1 < 1){
        $wodtarget = 1;
      }
      elsif ($1 > 10){
        $wodtarget = 10;
      }
      else{
        $wodtarget = $1;
      }
      add_body("Ta: Target set to $wodtarget\n");
    }
    else{
      add_body("Er: Not in the Wod ruleset.\n");
    }
  }
}
# begin the spew
add_body("\n\n");
if ($relimit == 5){
  add_body("Er: Limit of 5 reply addresses exceeded.\n");
}
if ($dielimit == 20){
  add_body("Er: Limit of 20 die rolls exceeded.\n");
}
add_body("Mail sent to: $to\n");
add_body("\ndserv $build - (c) 1999 Steve Lamb\n"); # Credit where Credit Due.
if ($rolltrue && $retrue){
  send_results();
}
else{
  print("No mail sent.\n");
}
