# The rules consist of sections, delimited by '##'.
# If there is a compile-time error, the section it's in will die
# and a message will be sent to the owner. If there's a run-time
# error, the current action will stop and a message will be sent
# to the owner. If a function is missing, a message will be sent
# to the debugger, undef will be returned, and nothing else bad
# will happen. For this reason, try to break things into functions,
# and put each function in its own section.

## Forward declarations. Your milage may vary.

# This stops missing functions from being an error
sub AUTOLOAD;

# This is called once for each incoming mail message
sub mail;

# A helper function used by mail()
sub docommand;

# This is called before mail()
sub setup;

# This is called after mail()
sub main;

# This prints a report of currently active proposals
sub proposal_report;

# This determines the results of proposals, and generates a report
sub resolve_proposals;

# This prints the text of new proposals
sub new_proposal_report;

## The autoload routine, to catch bugs

# This catches missing functions and returns undef, as well
# as sending an error message to the debugger. If the block a
# function is in fails to compile (due to an error), the function
# will not be available, so this is important. Forgetting to add
# a forward declaration might also cause errors.

sub AUTOLOAD {
    $mail{$data{officers}{debugger}}{message} .= <<"BUG";
*** Missing subroutine: $AUTOLOAD ***
BUG
    return undef;
}

## The mail function

# This extracts commands from incoming mail files, then calls
# do_command() for each command. It also figures out who
# sent each message from the From: line, and discards messages sent
# by non-players (so be careful).

sub mail {
    local($mes) = @_;
    my(%message) = %$mes;

    # split the message into its component lines
    my(@lines) = split /\n/, $message{text};

    # some variables for later
    my($gunk) = '';
    my($command) = undef;

    # find the sender
    my($sender);

    $message{From} =~ /^(.*)\s+<(\S*)>/;
    if ($2) {
        $sender = $2;
    }
    else {
        $message{From} =~ /^(\S*)/;
        $sender = $1;
    }

    # figure out which player this is
    my($player) = '!';
    foreach $key (keys %{$data{players}}) {
        if ($data{players}{$key}{email} eq $sender) {
            $player = $key;
        }
    }

    if ($player eq '!') {
        print "Message from non-player '$sender'\n";
        return;
    }

    # check each line for a command
    foreach $line (@lines) {
        if ($line =~ /^##\s*(\w+)\s*(.*)/) {
            docommand($command, $extra, $gunk, $player, \%message);
            $command = $1;
            $extra = $2;
            $gunk = '';
        }
        elsif ($line =~ /^---+$/) {
            # start of signature, probably
            docommand($command, $extra, $gunk, $player, \%message);
            return 0;
        }
        else {
            $gunk .= $line . "\n";
        }
    }

    docommand($command, $extra, $gunk, $player, \%message);
}

## Parse a specific mail command

# This is called by mail() to process individual commands.
# Anything new should probably be added as a subroutine, so
# compilation errors don't prevent any commands from working.
# If this crashes, the owner will have to fix it, and he won't
# like it.

# Current commands implemented are:

# ##propose <name>
#   <text>

# ##vote <number> <yes/no/abstain>

sub docommand {
    local($command, $extra, $gunk, $player, $message) = @_;
    my(%message) = %$message;

    # pick a specific command
    if (not $command) {
        # not a real command, ignore
    }
    elsif ($command eq 'propose') {
        $number = $data{next_prop_num}++;
        $data{proposals}{$number} = {
            name => $extra,
            date => [$data{date2}],
            author => $player,
            text => $gunk,
        }
    }
    elsif ($command eq 'vote') {
        if (not $extra =~ /(\d+)\s+([yna])/) {
            $mail{$player}{message} .= <<"FAILED";
*** Bad arguments to vote '$extra' ***
FAILED
            return;
        }
        $data{proposals}{$1}{votes}{$player} = $2;
    }
    else {
        $mail{$player}{message} .= <<"NOCOMMAND";
*** Command '$command $extra' does not exist ***
NOCOMMAND
    }
}

## Setup - misc. stuff

sub setup {
    # Set up the email addresses of the players
    foreach $player (keys %{$data{players}}) {
        $mail{$player} = {
            name => $data{players}{$player}{name},
            address => $data{players}{$player}{email},
            message => <<"WELCOME",
This is an automatically produced PerlNomic status message.
Production time: $data{date}.
Recipient: $data{players}{$player}{name}.

If you wish to be removed from PerlNomic, contact:
$data{players}{$data{officers}{registrar}}{email}

WELCOME
        }
    }
}

## The main function (generates various reports)

sub main {
    new_proposal_report();
    resolve_proposals();
    proposal_report();
}

## A nice helper function for sending mail to many people

# This adds some text to the specified players' messages,
# or to all players' messages by default. If you add arguments
# of non-players, be sure that an address is given somewhere.

sub sendall {
    local($text, @players) = @_;
    @players = keys %{$data{players}} if not @players;

    foreach $player (@players) {
        $mail{$player}{message} .= $text;
    }

    print $text;
}

## Send a report of current proposals

sub proposal_report {
    my(@proposals) = sortnum keys %{$data{proposals}};
    my(@curprops) = ();

    foreach $proposal (@proposals) {
        next if $data{proposals}{$proposal}{result};
        push @curprops, $proposal;
    }

    return if not @curprops;

    sendall "\n----\nProposals currently up for vote\n\n";
    sendall sprintf(
" Num Name\n");
    foreach $proposal (@curprops) {
        sendall sprintf(
"\%4i $data{proposals}{$proposal}{name}\n", $proposal);
    }
}

## Send a report of new proposals

sub new_proposal_report {
    my(@proposals) = sortnum keys %{$data{proposals}};
    my(@newprops) = ();

    foreach $proposal (@proposals) {
        next if $data{proposals}{$proposal}{distributed};
        push @newprops, $proposal;
    }

    return if not @newprops;

    sendall "\n----\nText of new proposals\n\n";
    foreach $proposal (@newprops) {
        $data{proposals}{$proposal}{distributed} = 'yes';
        sendall sprintf(
"\%4i $data{proposals}{$proposal}{name}\n+---\n", $proposals);
        foreach $line (split /\n/, $data{proposals}{$proposal}{text}) {
            sendall "| $line\n";
        }
        sendall "\n";
    }
}

## Resolve proposals

sub resolve_proposals {
    my(@proposals) = sortnum keys %{$data{proposals}};
    my(@resprops) = ();

    foreach $proposal (@proposals) {
        next if ($data{proposals}{$proposal}{result});
        $quotum = keys %{$data{proposals}{$proposal}{votes}};
        $quorum = keys %{$data{players}};
        next if $quorum < $quotum;
        push @resprops, $proposal;
    }

    return if not @resprops;

    sendall "\n----\nResolved proposals\n\n";

    sendall "R  Y-N   Num Name\n";
    foreach $proposal (@proposals) {
        next if ($data{proposals}{$proposal}{result});
        $quotum = keys %{$data{proposals}{$proposal}{votes}};
        $quorum = keys %{$data{players}};
        $yes = 0;
        $no = 0;
        foreach $voter (keys %{$data{proposals}{$proposal}{votes}}) {
            $vote = $data{proposals}{$proposal}{votes}{$voter};
            $yes++ if $vote eq 'y';
            $no++ if $vote eq 'n';
        }
        $result = $yes > 0 and ($yes / ($yes + $no)) > 0.6;
        $data{proposals}{$proposal}{result} = $result ? 'pass' : 'fail';
        $r = $result ? 'P' : 'F';
        $fa = " $yes-$no ";
        sendall sprintf(
"$r $fa \%4i $data{proposals}{$proposal}{name}\n", $proposal);
        eval($data{proposals}{$proposal}{text}) if $result;
    }
}