view release on metacpan or  search on metacpan

lib/Test/AutoBuild/Stage/EmailAlert.pm  view on Meta::CPAN

# 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
#
# $Id$

=pod

=head1 NAME

Test::AutoBuild::Stage::EmailAlert - Send email alerts with build status

=head1 SYNOPSIS

  use Test::AutoBuild::Stage::EmailAlert


=head1 DESCRIPTION

This module generates email alerts at the end of a build containing
status information. They can be sent on every cycle, or just when
the cycle has a failure.

=head1 METHODS

=over 4

=cut

package Test::AutoBuild::Stage::EmailAlert;

use base qw(Test::AutoBuild::Stage);
use warnings;
use strict;
use Net::SMTP;
use IO::Scalar;
use Log::Log4perl;
use POSIX qw(strftime);
use Template;
use Sys::Hostname;
use Test::AutoBuild::Lib;

sub process {
    my $self = shift;
    my $runtime = shift;

    my $log = Log::Log4perl->get_logger();

    my $from = $self->option("from");
    unless (defined $from) {
	my ($name,$passwd,$uid,$gid,
	    $quota,$comment,$gcos,$dir,$shell,$expire) = getpwuid($>);

	my $email = $name . '@' . hostname;

	if ($comment) {
	    $from = $comment . " <" . $email . ">";
	} else {
	    $from = $email;
	}
	$log->debug("No from address set, so using '$from'");
    }

    my $trigger = $self->option("trigger");
    $trigger = "first-fail" unless defined $trigger;

    my $scope = $self->option("scope");
    $scope = "global" unless $scope;
    if ($scope eq "module") {
	$log->info("Sending one mail per module");

	foreach my $name (sort { $a cmp $b } $runtime->modules) {
	    my $module = $runtime->module($name);

	    my $to = $self->option("to");
	    $to = "admin" unless defined $to;
	    my @to;
	    foreach my $addr (split /,/, $to) {
		$addr =~ s/^\s*//g;
		$addr =~ s/\s*$//g;
		if ((lc $addr) eq "admin") {
		    if (defined $module->admin_email) {
			push @to, $module->admin_name . " <" . $module->admin_email . ">";
		    } else {
			push @to, $runtime->admin_name . " <" . $runtime->admin_email . ">";
		    }
		    $log->debug("Resolved module administrator address to '" . $to[$#to] . "'");
		} elsif ((lc $addr) eq "group") {
		    if (defined $module->group_email) {
			push @to, $module->group_name . " <" . $module->group_email . ">";
		    } else {
			push @to, $runtime->group_name . " <" . $runtime->group_email . ">";
		    }
		    $log->debug("Resolved module developer group address to '" . $to[$#to] . "'");
		} else {
		    push @to, $addr;
		}
	    }

	    if ((lc $trigger) eq "always") {
		$log->debug("Sending regardless of status");
		$self->dispatch_message($runtime, $from, \@to, [$name]);
	    } elsif ($module->status eq "failed") {
		if ((lc $trigger) eq "fail") {
		    $log->debug("Sending due to failure");
		    $self->dispatch_message($runtime, $from, \@to, [$name]);
		} else {
		    my $newfail = 0;
		    my $arcman = $runtime->archive_manager;
		    if ($arcman) {
			my $cache = $arcman->get_previous_archive;
			if ($cache) {