#!/usr/bin/perl -w
#
# checkmake.pl Script
#
#
#    ========== licence begin  GPL
#    Copyright (C) 2001 SAP AG
#
#    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.
#    ========== licence end
#
use strict;
use Getopt::Long;

select(STDERR); $| = 1;
select(STDOUT); $| = 1;

#define vars
my ($Prot, $ErrFound, @Lines, @Msg);
my %Opts;

my $ProgramName = "Checkmake";
my $Version     = "1.05";
my $VerDate     = "2003-03-18";

print "\n$ProgramName v$Version ($VerDate)\n\n";

if (!GetOptions( \%Opts, 'qaid=i', 'chlist=i'))
{
    print "Got Wrong cmd line parameters!\nExiting...\n";
    exit(-1);
}

if ($Opts{'qaid'})
{
    require qadb;
    import  qadb;
    print "QA-ID        = $Opts{'qaid'}\n" if $Opts{'qaid'};
}
else
{
    $Opts{'qaid'} = 0;
}

print "CHANGELIST   = $Opts{'chlist'}\n" if $Opts{'chlist'};
print "TARGETS      = @ARGV\n";

foreach my $Prot ( @ARGV ) {

    # read prot
    if ( !open (IN, "<$Prot") )  {
        print "Make protocol $Prot not found (ignored)\n";
        next;
    }
    @Lines = <IN>;
    close IN;

    print "Checking make protocol $Prot for errors\n";
    $ErrFound = grep { /END:\s*MAKE\s*TARGET:\s*\S*\s*RESULT:\s*ERROR/i } @Lines;
    push @Msg, @Lines if ( $ErrFound );
}

if ( @Msg ) {

    print "Errors found in make protocols\n";

    # send mail
    &SendErrorMail(@Msg) if ( @Msg );
    # exit with error code
    if (caller()) {
        return -1;
    } else {
        exit -1;
    }
}

print "No errors found in make protocols\n";
if (caller()) {
    return 0;
} else {
    exit 0;
}

#########################################################################

sub SendErrorMail {

    use Mail::Sendmail;

    my ($msg, $sub, $receiver, $cc, %mail, $it, @targets, %t, $id, @deperrors, %d, %layers);
    my ($hostname, $rel, $qamode, $os, $tinsub, %duser, @duser);
    my (@localtime, $webdavname, $rc, $linkname);
    my $prot = "";
    my ($actuser, $actname);
    my $qah;
    my $mailok = 1;
    my $first = 1;
    my $changedate;

    $rel = substr($ENV{RELVER},1,1) . "." .
           substr($ENV{RELVER},2,1) . "." .
           $ENV{CORRECTION_LEVEL};

    $hostname =  `hostname`;
    $hostname =~ s/\n$//;
    $os = "SUN"     if ( $hostname =~ /^u.*/i );
    $os = "DEC"     if ( $hostname =~ /^d.*/i );
    $os = "AIX"     if ( $hostname =~ /^i.*/i );
    $os = "LINUX"   if ( $hostname =~ /^l.*/i );
    $os = "SNI"     if ( $hostname =~ /^s.*/i );
    $os = "HP"      if ( $hostname =~ /^h.*/i );
    $os = "WINDOWS" if ( $hostname =~ /^p.*/i );

    $os .= "(IA64)" if (($os eq "WINDOWS") and ($ENV{CPU} eq "IA64"));

    @Lines = @_;
    $it = 0;
    $id = 0;

    @localtime = localtime(time);
    $webdavname = $os . "_" . $rel . "_" . sprintf ("%04d%02d%02d%02d%02d", $localtime[5] + 1900, $localtime[4] + 1, $localtime[3], $localtime[2], $localtime[1]);

    while ($_ = $Lines[0])
    {
        shift @Lines;
        if (s/^TARGET:\s*'(\S*)'\s*.*ERROR.*/$1/)
        {
            chomp;
            my $target = $_;
            unless ( defined $t{$target} )
            {
                if ($Lines[1] =~ /not made because of dependency errors of/)
                {
                    $d{$target} = ++$id;
                }
                else
                {
                    $t{$target} = ++$it ;
                    $layers{$1} = 1 if (/::?(.*)\/[^\/]*$/);
                }

            }
        }
    }

    @targets = sort {$t{$a} <=> $t{$b}} keys %t;
    @deperrors = sort {$d{$a} <=> $d{$b}} keys %d;

    while (@_) {$prot .= shift}

    if ($Opts{'qaid'} != 0)
    {
        $qah = qadb->new({'ID' => "$Opts{'qaid'}" });
        if ($qah->{'error_code'} == 0)
        {
            $linkname = $qah->write_prot("$webdavname", $prot, "Error Protocol (.e0 file summary)");
            if ($qah->{'error_code'} != 0)
            {
                print STDERR "ERROR: Can't write protocol to QADB!\n$qah->{'error_text'}\n";
                $Opts{'qaid'} = 0;
            }
        }
        else
        {
            print STDERR "ERROR: Can't write protocol to QADB!\n$qah->{'error_text'}\n";
            $Opts{'qaid'} = 0;
        }
    }

    if ($Opts{'qaid'} == 0)
    {
        open (OUT,">$webdavname");
        print OUT $prot;
        close OUT;
        if ($^O=~/.*win32.*/i)
        {   $rc = system("python $ENV{TOOL}\\bin\\webdav.py $webdavname"); }
        else
        {   $rc = system("webdav.py $webdavname");   }
        unlink ($webdavname);
        $linkname = "http://pts:1080/webdav/daily_makes/$webdavname";
    }

    $msg  = "OWN         = $ENV{OWN}\n";
    $msg .= "CHANGE LIST = $Opts{'chlist'}\n" if ($Opts{'chlist'});
    $msg .= "MACHINE CFG = $ENV{'MACHINE_CONFIG'}\n" if ($ENV{'MACHINE_CONFIG'});
    $msg .= "\nAffected targets :\n\n";

    if ( (!defined $ENV{LC_STATE}) or ($ENV{LC_STATE} eq "DEV") )
    {
        foreach my $trg (@targets)
        {
            $actuser    = "";
            $first      = 1;
            $changedate = "";

            if ($^O=~/.*win32.*/i)
            { open(PIPE,"python $ENV{TOOL}\\bin\\whose.py -format duser $trg |") or print "can't open pipe";  }
            else
            { open(PIPE,"$ENV{TOOL}/bin/whose.py -format duser $trg |") or print "can't open pipe"; }
            while (<PIPE>)
            {
                if ($first)
                {
                    if (/(d\d+)/i)
                    {
                        $duser{$1}  = 1;
                        $actuser    = $1;
                        $first      = 0;
                    }
                }

                if (/(d\d+).*last\schange\sat\s(\S+)$/i)
                {
                    $duser{$1}  = 1;
                    $actuser    = $1;
                    $changedate = ", changed at $2";
                }
            }
            close (PIPE);

            if ($actuser ne "")
            {
                $actname = "";
                if ($^O=~/.*win32.*/i)
                { open(PIPE, "perl $ENV{'TOOL'}\\bin\\tel.pl $actuser |") or print "Can't open pipe for tel!\n$!\n"; }
                else
                { open(PIPE, "$ENV{'TOOL'}/bin/tel.pl $actuser |") or print "Can't open pipe for tel!\n$!\n"; }
                while(<PIPE>)
                {
                    $actname = $1 if (/^\"(.*)\".*/);
                }
                close (PIPE);

                if ($actname ne "")
                {
#                    $msg .= "$trg ($actname$changedate)\n";
                    $msg .= "$trg ($actname)\n";
                }
                else
                {
                    $msg .= "$trg\n";
                }
            }
            else
            {
                $msg .= "$trg\n";
            }
        }
        @duser = keys %duser;
        @duser = grep { /^[^#]\S+$/ } <DATA> unless ( @duser );
    }
    else
    {
       @duser = ('frank.strassenburg', 'axel.mosle', 'gerald.arnold', 'falko.flessner', 'ulrich.jansen');
       $msg  .= join("\n",@targets);
       $msg  .= "\n";
    }

    $msg .= "\nDependency errors:\n\n" . join("\n",@deperrors) if (@deperrors);
    $msg .= "\n\nAffected layers  :\n\n" . join("\n",(sort keys %layers)) if (%layers);
    $tinsub =  join(',', @targets);
    $tinsub = substr($tinsub,0,50) . "..." if (length($tinsub) > 50);
    $qamode = $ENV{LC_STATE} ? $ENV{LC_STATE} : "DEV";
    $sub = "make problem on $os ($hostname) $rel $qamode ($tinsub)";

    $msg .= "\n\nError Protocol : $linkname\n";
    $msg .= "Make Details   : http://pgwdf160:1081/TestMonitor/Make_Details.jsp?id=$Opts{'qaid'}\n" if ($Opts{'qaid'});
    $msg .= "\n\nMail created by $ProgramName v$Version ($VerDate)\n";

    $receiver = join (',', map {chomp; s/(d\d+).*/$1/i; $_ . '@exchange.sap-ag.de'} @duser);

    $cc = 'holger.becker@sap.com'    if ( $hostname =~ /^(s|u).*/i );
    $cc = 'stefan.paeck@sap.com'     if ( $hostname =~ /^d.*/i );
    $cc = 'robin.wissbrock@sap.com'  if ( $hostname =~ /^i.*/i );
    $cc = 'daniel.dittmar@sap.com'   if ( $hostname =~ /^l.*/i );
    $cc = 'gert.grossmann@sap.com'   if ( $hostname =~ /^h.*/i );

    if ( $hostname =~ /^p.*/i ) {
        if (($os eq "WINDOWS(IA64)")) {
            $cc = 'dennis.adler@sap.com' ;
        } else {
            $cc = 'elke.zabach@sap.com' ;
        }
    }

    if ($cc eq "") { $cc = 'ulrich.jansen@sap.com'; }
    else { $cc .= ',ulrich.jansen@sap.com'; }

    %mail = ( To      => "$receiver",
              From    => 'automake@sap.com',
              Message => "$msg",
              Cc      => "$cc",
              Smtp    => 'mail.sap-ag.de',
              Subject => "$sub" );

    if ( ! sendmail(%mail) ) {
        print "FATAL: sendmail error $Mail::Sendmail::error\n";
        $mailok = 0;
    }

    if ($Opts{'qaid'} != 0)
    {
        my $email;

        $email  = "To     : $receiver\n";
        $email .= "Cc     : $cc\n";
        $email .= "Subject: $sub\n\n";
        $email .= "Content:\n\n$msg\n";

        my $ename = "EMail_" . $os . "_" . $rel . "_" . sprintf ("%04d%02d%02d%02d%02d", $localtime[5] + 1900, $localtime[4] + 1, $localtime[3], $localtime[2], $localtime[1]);

        if ($qah->{'error_code'} == 0)
        {
            $qah->write_log("ERROR: Couldn't send error mail!") if ($mailok == 0);
            $linkname = $qah->write_prot("$ename", $email, "Copy of sent automake mail");
            if ($qah->{'error_code'} != 0)
            {
                print STDERR "ERROR: Can't write protocol to QADB!\n$qah->{'error_text'}\n";
                $Opts{'qaid'} = 0;
            }
        }
        else
        {
            print STDERR "ERROR: Can't write protocol to QADB!\n$qah->{'error_text'}\n";
            $Opts{'qaid'} = 0;
        }
    }
}

__DATA__
torsten.strahl
henrik.hempelmann
uwe.hahn
martin.brunzema
daniel.dittmar
martin.kittel
elke.zabach
dirk.thomsen
thomas.anhaus
ferdinand.flohe
gert.grossmann
holger.becker
joerg.mensing
raymond.roedling
stefan.paeck
robin.wissbrock
mechthild.bore
dennis.adler
robert.voelkel
ivan.schreter
markus.sinnwell
peter.goertz
steffen.schildberg
bernd.vorsprach
marco.paskamp
gerald.arnold
frank.strassenburg
