# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
################################
# Tinderbox Module             #
################################

package BotModules::Tinderbox;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;

# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
    my $self = shift;
    $self->SUPER::RegisterConfig(@_);
    $self->registerVariables(
      # [ name, save?, settable? ]
        ['trees', 1, 1, ['SeaMonkey', 'SeaMonkey-Ports', 'MozillaTest', 'Grendel']], 
        ['treesAnnounced', 1, 1, ['SeaMonkey', 'SeaMonkey-Ports']], 
        ['treesDefault', 1, 1, ['SeaMonkey']], 
        ['treeStates', 0, 0, {}], # ->tree->(current, previous, lastupdate)
        ['lasttreesStates', 0, 0, []], # copy of trees in last test
        ['tinderboxStates', 0, 0, {}], # ->tree->build->(current, previous, lastupdate)
        ['updateDelay', 1, 1, 120],
        ['useNotice', 1, 1, 1], # set to 1 to use notice and 0 to use a normal message
        ['_lastupdate', 0, 0, 0],
        ['preferredLineLength', 1, 1, 100], 
        ['mutes', 1, 1, {}],  # tree -> "channel channel channel"
        ['states', 1, 1, {'success' => 'Success', 'testfailed' => 'Test Failed', 'busted' => 'Burning', }],
        ['maxInChannel', 1, 1, 5], # maximum number of lines to report in a channel
        ['tinderboxURI', 1, 1, "http://tinderbox.mozilla.org/"], # base URL for Tinderbox
        ['isTinderbox2', 1, 1, 0], # whether this is tinderbox2 or not
    );
}

# Schedule - called when bot connects to a server, to install any schedulers
# use $self->schedule($event, $delay, $times, $data)
# where $times is 1 for a single event, -1 for recurring events,
# and a +ve number for an event that occurs that many times.
sub Schedule {
    my $self = shift;
    my ($event) = @_;
    $self->schedule($event, \$self->{'updateDelay'}, -1, 'tinderbox');
    $self->SUPER::Schedule($event);
}

sub Help {
    my $self = shift;
    my ($event) = @_;
    my %commands = (
        '' => 'The Tinderbox module monitors who the state of the tinderboxen.',
        'qt' => 'Quick trees, same as \'trees terse\'. You can give it a <tree> argument if you like, for example \'qt seamonkey\'.',
        'builds' => 'Gives the status of all the builds in all the trees that match a particular pattern. Syntax: \'builds <build>\'. For example: \'builds Mac\'.',
        'trees' => 'Reports on the current state of the tinderboxen. Syntax: \'trees <options> <tree>\' where <options> is any number of: '.
                   'all (show all trees and all builds), main (show only main trees), burning (show only burning builds), '.
                   'long, medium, short, terse (how much detail to include), and <tree> is the name of the tree to show (or a regexp matching it).',
    );
    if ($self->isAdmin($event)) {
        $commands{'mute'} = 'Disable reporting of a tree in a channel. (Only does something if the given tree exists.) Syntax: mute tinderbox <tree> in <channel>';
        $commands{'unmute'} = 'Enable reporting of a tree in a channel. By default, trees are reported in all channels that the module is active in. Syntax: unmute tinderbox <tree> in <channel>';
    }
    return \%commands;
}

sub Told {
    my $self = shift;
    my ($event, $message) = @_;
    if ($message =~ /^\s*trees?(?:\s+(.*?))?\s*(?:[, ]\s*please)?\?*\s*$/osi) {

        # initial setup
        my $trees = -1; # 0=default; 1=all; 'x'=pattern match
        my $builds = -1; # 0=all; 1=horked and test failed; 2=horked only
        my $verbosity = -1; # 1=terse; 2; 3; 4=verbose

        # parse parameters
        if (defined($1)) {
            foreach (split(/\s+/, $1)) {
                   if (/^all$/osi) { $trees = '1' if $trees < 0; $builds = 0 if $builds < 0; }
                elsif (/^main$/osi) { $trees = '0'; }
                elsif (/^burning$/osi) { $builds = 2; }
                elsif (/^long$/osi) { $verbosity = 4; }
                elsif (/^medium$/osi) { $verbosity = 3; }
                elsif (/^short$/osi) { $verbosity = 2; }
                elsif (/^terse$/osi) { $verbosity = 1; }
                else { $trees = $_; }
            }
        }

        # defaults
        $trees = '0' if $trees < 0;
        $builds = 1 if $builds < 0;
        $verbosity = 2 if $verbosity < 0;

        # go
        $self->GetTrees($event, 1, $trees, $builds, $verbosity);

    } elsif ($message =~ /^\s*builds?\s+(.*?)\s*\?*\s*$/osi) {
        $self->GetTrees($event, 2, $1);
    } elsif ($message =~ /^\s*qt(?:\s+(.+?))?\s*$/osi) {       
        $self->GetTrees($event, 1, defined($1) ? $1 : 0, 1, 1);
    } elsif ($self->isAdmin($event)) {
        if ($message =~ /^\s*mute tinderbox\s+(\S+?)\s+in\s+(\S+?)\s*$/osi) {
            my $tree = $1 eq 'Tinderbox' ? '' : $1;
            my $treeName = $tree eq '' ? 'all trees' : "trees named $tree";
            if (($tree eq '') or (grep $_ eq $tree, @{$self->{'trees'}})) {
                $self->{'mutes'}->{$tree} .= " $2";
                $self->saveConfig();
                $self->say($event, "$event->{'from'}: Tinderbox notifications for $treeName muted in channel $2.");
            } else {
                $self->say($event, "$event->{'from'}: There is no tree called $tree is there?.");
            }
        } elsif ($message =~ /^\s*unmute tinderbox\s+(\S+?)\s+in\s+(\S+?)\s*$/osi) {
            my $tree = $1 eq 'Tinderbox' ? '' : $1;
            my $treeName = $tree eq '' ? 'all trees' : "trees named $tree";
            if (($tree eq '') or (grep $_ eq $tree, @{$self->{'trees'}})) {
                my %mutedChannels = map { lc($_) => 1 } split(/ /o, $self->{'mutes'}->{$1});
                delete($mutedChannels{lc($2)}); # get rid of any mentions of that channel
                $self->{'mutes'}->{$1} = join(' ', keys(%mutedChannels));
                $self->saveConfig();
                $self->say($event, "$event->{'from'}: Tinderbox notifications for trees named $1 resumed in channel $2.");
            } else {
                $self->say($event, "$event->{'from'}: There is no tree called $tree is there?.");
            }
        } else {
            return $self->SUPER::Told(@_);
        }
    } else {
        return $self->SUPER::Told(@_);
    }
    return 0; # dealt with it...
}

sub GetTrees {
    my $self = shift;
    my ($event, $requested, @mode) = @_;
    my @trees = @{$self->{'trees'}};
    if ($self->{'isTinderbox2'}) {
        foreach (@trees) {
            my $uri = $self->{'tinderboxURI'} . $_ . "/quickparse.html";
            $self->getURI($event, $uri, $requested, @mode);
        }
    } else {
        local $" = ','; # XXX %-escape this 
        my $uri = $self->{'tinderboxURI'} . "showbuilds.cgi?quickparse=1&tree=@trees";
        $self->getURI($event, $uri, $requested, @mode);
    }
}

sub GotURI {
    my $self = shift;
    my ($event, $uri, $output, $requested, @mode) = @_;
    if ($output) {
        my $now = $event->{'time'};
        $self->{'_lastupdate'} = $now;
        my @lines = split(/\n/os, $output);

        # loop through quickparse output
        foreach my $line (@lines) {
            my ($type, $tree, $build, $state) = split(/\|/os, $line);
            if ($type eq 'State') {
                $self->{'treeStates'}->{$tree}->{'lastupdate'} = $now;
                if (defined($self->{'treeStates'}->{$tree}->{'current'})) {
                    $self->{'treeStates'}->{$tree}->{'previous'} = $self->{'treeStates'}->{$tree}->{'current'};
                }
                $self->{'treeStates'}->{$tree}->{'current'} = $state;
                $self->{'states'}->{$state} = $state unless defined($self->{'states'}->{$state});
            } elsif ($type eq 'Build') {
                $self->{'tinderboxStates'}->{$tree}->{$build}->{'lastupdate'} = $now;
                if (defined($self->{'tinderboxStates'}->{$tree}->{$build}->{'current'})) {
                    $self->{'tinderboxStates'}->{$tree}->{$build}->{'previous'} = $self->{'tinderboxStates'}->{$tree}->{$build}->{'current'};
                }
                $self->{'tinderboxStates'}->{$tree}->{$build}->{'current'} = $state;
                $self->{'states'}->{$state} = $state unless defined($self->{'states'}->{$state});
            } # else unsupported type XXX
        }
        
        #If a Tinderbox tree is configured without Bonsai, it lacks a state line and doesn't
        # appear properly in the trees output (even though machine state changes work.)
        # Work around this by setting a default state of Unknown to trees w/o a state line.
        my $state = "unknown";
        foreach my $tree (keys(%{$self->{'tinderboxStates'}})) {
            if (!defined($self->{'treeStates'}->{$tree})) {
                $self->{'treeStates'}->{$tree}->{'current'} = $state;
                $self->{'treeStates'}->{$tree}->{'lastupdate'} = $now;
                if (defined($self->{'treeStates'}->{$tree}->{'current'})) {
                    $self->{'treeStates'}->{$tree}->{'previous'} = $self->{'treeStates'}->{$tree}->{'current'};
                }
                $self->{'states'}->{$state} = $state unless defined($self->{'states'}->{$state});
            }
            #Update timestamps on trees we're 'managing' state on.
            if (($self->{'treeStates'}->{$tree}->{'current'} eq $state) and 
                ($self->{'treeStates'}->{$tree}->{'lastupdate'} < $now)) {
                $self->{'treeStates'}->{$tree}->{'lastupdate'} = $now;
            }
        }
        
        $self->CheckForUpdates($event, $requested);
        if ($requested == 1) {
            $self->ReportState($event, @mode);
        } elsif ($requested == 2) {
            $self->ReportBuild($event, @mode);
        }
        # update list of active trees
        @{$self->{'lasttreesState'}} = @{$self->{'trees'}};
    } else {
        if ($requested) {
            $self->say($event, "$event->{'from'}: I can't access tinderbox right now, sorry.");
        }
        $self->debug('failed to get tinderbox data');
    }
}


sub Scheduled {
    my $self = shift;
    my ($event, @data) = @_;
    if ($data[0] eq 'tinderbox') {
        $self->GetTrees($event, 0);
    } else {
        $self->SUPER::Scheduled($event, @data);
    }
}

sub CheckForUpdates {
    my $self = shift;
    my ($event, $avoidTarget) = @_;
    my $a; # disclaimer: I was asleep when I wrote the next line. I've no longer any idea what it does.
    my @trees = map { $a = $_; grep { $_ eq $a } @{$self->{'lasttreesState'}}; } @{$self->{'treesAnnounced'}};
    # After staring at it for a few minutes, I think what it does is get a list of the trees that should
    # be announced, AND that have already been found to exist. But I'm not 100% sure.
    foreach my $tree (@trees) {
        my @newTrees;
        my @newBuilds;
        my @lostBuilds;
        my @lostTrees;
        my @changes;

        # check trees
        if (defined($self->{'treeStates'}->{$tree})) {
            if ($self->{'treeStates'}->{$tree}->{'lastupdate'} == $self->{'_lastupdate'}) {
                if (defined($self->{'treeStates'}->{$tree}->{'previous'})) {
                    if ($self->{'treeStates'}->{$tree}->{'previous'} ne $self->{'treeStates'}->{$tree}->{'current'}) {
                        push(@changes, "$tree has changed state from $self->{'states'}->{$self->{'treeStates'}->{$tree}->{'previous'}} to $self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}.");
                    }
                } else {
                    push(@newTrees, "New tree added to tinderbox: $tree (state: $self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}).");
                }
            } else {
                # tree has dissappeared!
                delete($self->{'treeStates'}->{$tree});
                push(@lostTrees, "Eek!!! Tree '$tree' has been removed from tinderbox!");
            }
        } # else tree doesn't exist

        # check builds
        if (defined($self->{'tinderboxStates'}->{$tree})) {
            foreach my $build (keys(%{$self->{'tinderboxStates'}->{$tree}})) {                
                if ($self->{'tinderboxStates'}->{$tree}->{$build}->{'lastupdate'} == $self->{'_lastupdate'}) {
                    if (defined($self->{'tinderboxStates'}->{$tree}->{$build}->{'previous'})) {
                        if ($self->{'tinderboxStates'}->{$tree}->{$build}->{'previous'} ne $self->{'tinderboxStates'}->{$tree}->{$build}->{'current'}) {
                            push(@changes, "$tree: '$build' has changed state from $self->{'states'}->{$self->{'tinderboxStates'}->{$tree}->{$build}->{'previous'}} to $self->{'states'}->{$self->{'tinderboxStates'}->{$tree}->{$build}->{'current'}}.");
                        }
                    } else {
                        push(@newBuilds, "$tree: Build '$build' added to tinderbox. (Status: $self->{'states'}->{$self->{'tinderboxStates'}->{$tree}->{$build}->{'current'}}).");
                    }
                } else {
                    # build has dissappeared!
                    delete($self->{'tinderboxStates'}->{$tree}->{$build});
                    push(@lostBuilds, "$tree: Build '$build' has dropped from tinderbox.");
                }
            }
        } # else tree doesn't exist

        # sort out which channels to talk to
        my %mutedChannels = ();
        if (defined($self->{'mutes'}->{$tree})) {
            %mutedChannels = map { lc($_) => 1 } split(/\s+/os, $self->{'mutes'}->{$tree});
        }
        if (defined($self->{'mutes'}->{''})) {
            %mutedChannels = (%mutedChannels, map { lc($_) => 1 } split(/\s+/os, $self->{'mutes'}->{''}));
        }
        if (($avoidTarget) and ($event->{'target'} eq $event->{'channel'})) {
            $mutedChannels{$event->{'channel'}} = 1;
        }

        # speak!
        my @output = (@newTrees, @lostTrees, @newBuilds, @lostBuilds);
        foreach (@{$self->{'channels'}}) {
            unless ($mutedChannels{$_}) {
                local $event->{'target'} = $_;
                foreach (@changes) {
                    $self->sayOrNotice($event, $_);
                }
                if (@output < $self->{'maxInChannel'}) {
                    foreach (@output) {
                        $self->sayOrNotice($event, $_);
                    }
                } else {
                    $self->sayOrNotice($event, "Many tree changes just occured. Check tinderbox to see what they were.");
                }
            }
        }
    }
}

sub ReportState {
    my $self = shift;
    my ($event, $trees, $builds, $verbosity) = @_;

    # $trees: 0=default; 1=all; 'x'=pattern match
    # $builds: 0=all; 1=horked and test failed; 2=horked only
    # $verbosity: 1=terse; 2; 3; 4=verbose

    # the complete output 
    my @lines;

    # work out which trees we want
    my @trees;
    if ($trees eq '0') {
        @trees = @{$self->{'treesDefault'}};
    } elsif ($trees eq '1') {
        @trees = @{$self->{'trees'}};
    } else {
        my $pattern = $self->sanitizeRegexp($trees);
        foreach my $tree (keys %{$self->{'treeStates'}}) {
            push(@trees, $tree) if $tree =~ /$pattern/si;
        }
    }

    if (@trees) {

        foreach my $tree (@trees) {
            if ((defined($self->{'treeStates'}->{$tree})) and ($self->{'treeStates'}->{$tree}->{'lastupdate'} == $self->{'_lastupdate'})) {
 
                # setup
                my @output;
                my ($redShort) = ($self->{'states'}->{'bustedShort'} or split(//osi, $self->{'states'}->{'busted'}));
                my $red = 0; 
                my ($orangeShort) = ($self->{'states'}->{'testfailedShort'} or split(//osi, $self->{'states'}->{'testfailed'}));
                my $orange = 0; 
                my ($greenShort) = ($self->{'states'}->{'successShort'} or split(//osi, $self->{'states'}->{'success'}));
                my $green = 0;

                # foreach build
                if (defined($self->{'tinderboxStates'}->{$tree})) {
                    foreach my $build (keys(%{$self->{'tinderboxStates'}->{$tree}})) {
                        if ($self->{'tinderboxStates'}->{$tree}->{$build}->{'lastupdate'} == $self->{'_lastupdate'}) {

                            my $state = $self->{'tinderboxStates'}->{$tree}->{$build}->{'current'};

                            # count results
                            if ($state eq 'success') {
                                $green++;
                            } elsif ($state eq 'testfailed') {
                                $orange++;
                            } else {
                                $red++;
                            }

                            # make sure we should list this build
                            if ($state eq 'success') {
                                next if $builds >= 1;
                            } elsif ($state eq 'testfailed') {
                                next if $builds >= 2;
                            }

                            if ($verbosity == 1) {
                                my($minibuild) = split(/\s/osi, $build);
                                my $ministate = $self->{'states'}->{$state.'Short'};
                                if (not $ministate) {
                                   ($ministate) = split(//osi, $self->{'states'}->{$state});
                                }
                                push(@output, "$minibuild: $ministate;");
                            } elsif (($verbosity == 2) || ($verbosity == 3)) {
                                my($minibuild) = $verbosity == 2 ? split(/\s/osi, $build) : ($build);
                                my $ministate = $self->{'states'}->{$state.'Medium'};
                                if (not $ministate) {
                                   $ministate = $self->{'states'}->{$state};
                                }
                                push(@output, "$minibuild ($ministate),"); 
                            } else {
                                push(@output, "[$build: $self->{'states'}->{$state}]")
                            }

                        } # else build is dead
                    } # (foreach build)
                } # else tree is dead

                # pretty print it
                my @newoutput;
                if ($verbosity == 1) {
                    if (@output == 0) {
                        unless ($red + $green + $orange) {
                            push(@output, "(none)");
                        } elsif ($builds <= 1) {
                            push(@output, "(all green)");
                        } else {
                            push(@output, "(none red)");
                        }
                    }
                    my $ministate = $self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}.'Short'};
                    if (not $ministate) {
                        ($ministate) = split(//osi, $self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}});
                    }
                    @newoutput = $self->wordWrap($self->{'preferredLineLength'}, 
                        "$tree <$ministate> $redShort:${red} $orangeShort:${orange} $greenShort:${green} ",
                        '  ', ' ', @output);
                    $newoutput[0] =~ s/^  //o;
                    $newoutput[$#newoutput] =~ s/;$//o;
                    push(@lines, @newoutput);
                } elsif (($verbosity == 2) || ($verbosity == 3)) {
                    unless ($red+$orange+$green) {
                        push(@lines, "$tree <$self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}>: no tinderboxen for this tree.");
                    } elsif (($red) or ($orange)) {
                        if (@output == 0) {
                            # can only happen if $red is 0 and $builds is 1.
                            push(@output, "all tinderboxen compile");
                        }
                        my @newoutput = $self->wordWrap($self->{'preferredLineLength'}, 
                            "$tree <$self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}> $red red, $orange orange, $green green: ", 
                            '  ', ' ', @output);
                        $newoutput[0] =~ s/^  //o;
                        $newoutput[$#newoutput] =~ s/,$//o;
                        # if (length(@newoutput[$#newoutput]) < $self->{'preferredLineLength'} - 33) {
                        #     $newoutput[$#newoutput] .= "     Summary: $red red, $orange orange, $green green";
                        # } else {
                        #     push(@newoutput, "  Summary: $red red, $orange orange, $green green");
                        # }
                        push(@lines, @newoutput);
                    } else {
                        push(@lines, "$tree <$self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}>: all $green tinderboxen green!");
                    }
                } else {
                    if (@output == 0) {
                        unless ($red + $green + $orange) {
                            push(@output, "no tinderboxen for this tree.");
                        } elsif ($builds <= 1) {
                            push(@output, "all tinderboxen for this tree are green!");
                        } else {
                            push(@output, "all tinderboxen for this tree compile successfully.");
                        }
                    }
                    @newoutput = $self->wordWrap($self->{'preferredLineLength'}, 
                        "$tree <$self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}> $red red, $orange orange, $green green: ", 
                        '  ', ' ', @output);
                    $newoutput[0] =~ s/^  //o;
                    push(@lines, @newoutput);
                }

            } # else tree is dead

        } # (foreach tree)

    } else { # no tree selected
        @lines = ("No tree matches the pattern '$trees', sorry!");
    }

    $self->Report($event, 'tree status', @lines);
}

sub ReportBuild {
    my $self = shift;
    my ($event, $pattern) = @_;

    # the complete output 
    my @output;

    foreach my $tree (@{$self->{'trees'}}) {
        if ((defined($self->{'treeStates'}->{$tree})) and 
            ($self->{'treeStates'}->{$tree}->{'lastupdate'} == $self->{'_lastupdate'}) and
            (defined($self->{'tinderboxStates'}->{$tree}))) {
            foreach my $build (keys(%{$self->{'tinderboxStates'}->{$tree}})) {
                if (($self->{'tinderboxStates'}->{$tree}->{$build}->{'lastupdate'} == $self->{'_lastupdate'}) and 
                    ($build =~ /\Q$pattern\E/is)) {
                    push(@output, "[$build: $self->{'states'}->{$self->{'tinderboxStates'}->{$tree}->{$build}->{'current'}}]")
                }
            }
        }
    }

    @output = ('There are no matching builds.') unless @output;
    @output = $self->prettyPrint($self->{'preferredLineLength'}, undef, "$event->{'from'}: ", '  ', @output);

    $self->Report($event, 'tree status', @output);
}

sub Report {
    my $self = shift;
    my ($event, $what, @output) = @_;
    if (scalar(@output) > $self->{'maxInChannel'}) {
        foreach (@output) {
            $self->directSay($event, $_);
        }
        $self->channelSay($event, "$event->{'from'}: $what /msg'ed");
    } else {
        foreach (@output) {
            $self->say($event, $_);
        }
    }
}

sub sayOrNotice {
    my $self = shift;
    if ($self->{'useNotice'}) {
        $self->notice(@_);
    } else {
        $self->say(@_);
    }
}