#!/devtool/local/bin/perl
#
# NACHT.LCA.pl Script
#
#
#    ========== licence begin  GPL
#    Copyright (C) 2002 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 BuildPackage::Vars;
use lcmake ;
use File::Path ;
use Getopt::Long;
use POSIX;
use File::Copy;
use qadblca;
use strict;


################################################################################
################## main ########################################################
################################################################################

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

my $ProtDir;
my $MakeRelease;
my $MakeProt;
my @args_rmtree;
my $CHANGELIST_NO;
my $TOOL_CHANGELIST_NO;
my $qahlca;
my $qalca_id;
my $qalca_ok = 1;
my $found_dsp2vmake_description = 0;
my $ret;
my $SCRATCH;
my $HELP;
my $QASTATUS;
my $TYPE;
my $LCPOOL_ID="0";
my $idobjstat = 0;

# objstat defines 
my $WRITE_TOOLCL=50;
my $START_DSP2VMAKE=601;
my $ERROR_DSP2VMAKE=609;
my $SUCCESS_DSP2VMAKE=610;
my $START_MAKE_AND_BUILD=611;
my $ERROR_MAKE_AND_BUILD=619;
my $SUCCESS_MAKE_AND_BUILD=620;
my $WRITE_LCPOOL_ID=950;
my $ERROR_ALL=999;
my $SUCCESS_ALL=1000;
my $qadb_error_count=0;
my @BUILTTARGETS = ();


#------------------------------------------------------------------------------#
#   get some machine informations
#------------------------------------------------------------------------------#

prot_parts ( "uname" ) ;
my ( $sysname, $nodename, $release, $version, $machine ) = POSIX::uname();

#------------------------------------------------------------------------------#
#   create protocol name of the make
#------------------------------------------------------------------------------#

prot_parts ( "build prot name" ) ;


my ($sec, $min, $hour, $mday, $mon, $year) = localtime();
my $makedate;
# format the dates
$year += 1900;
$mon += 1;
$mon =~ s/\s+//g;
$makedate = "$year.$mon.$mday-$hour.$min.$sec";

$ProtDir="$ENV{OWN}/prot" ;
$MakeRelease="NACHT_LCAPPS_$ENV{APO_COM_SHORT}_${nodename}_$makedate";
$MakeProt="$ProtDir/${MakeRelease}.prot";
mkpath ( [ "$ProtDir" ], 0, 0775 ) ;

#------------------------------------------------------------------------------#
#   redirect STDOUT and STDERR
#------------------------------------------------------------------------------#

prot_parts ( "redirect STDOUT and STDERR" ) ;
open(SAVEOUT, ">&STDOUT") ;
open(SAVEERR, ">&STDERR") ;
close(STDOUT) ;
close(STDERR) ;
open(STDOUT, ">$MakeProt") ;
open(STDERR, ">&STDOUT") ;
select(STDERR); $| = 1;
select(STDOUT); $| = 1;

#------------------------------------------------------------------------------#
#   read options
#------------------------------------------------------------------------------#

Getopt::Long::Configure ("no_auto_abbrev");
prot_parts ( "read and check options" ) ;
if ( GetOptions ( "force_rm"    => \$SCRATCH,
                  "type=s"      => \$TYPE,
                  "help"        => \$HELP,
                  "h"           => \$HELP )  and not  $HELP )
{	$SCRATCH = 1 if ( defined $SCRATCH);}
else
{
	print_usage () ;
	caller () ? return ( 1 ) : exit ( 1 ) ;
}

unless ($TYPE)
{	
	$TYPE = ( $ENV{VMAKE_DEFAULT_VARIANT} =~ /Debug/i ) ? "dbg" : "opt"; 
}


#------------------------------------------------------------------------------#
#   preparation of scratch make
#------------------------------------------------------------------------------#

prot_parts ( "prepare scratch make" ) ;
if ( $SCRATCH )
{
	if($^O=~/.*win32.*/i)
	{   $ret = system ("del /S /Q sys\\wrk sys\\src") ;}
	else
	{   $ret = system ("rm -rf sys/wrk sys/src") ; }
}

#------------------------------------------------------------------------------#
#   read changelist number
#------------------------------------------------------------------------------#

prot_parts ( "read changelist number" ) ;
if ( open ( CHANGELIST_LOG , "$ENV{OWN}/changelist.log" ))
{
   if ( $CHANGELIST_NO = <CHANGELIST_LOG> )
   {      chomp ( $CHANGELIST_NO ) ;   }
}
close ( CHANGELIST_LOG ) ;
unless ($CHANGELIST_NO)
{
  print "WARNING: can\'t read changelist number!\n" ;
  $CHANGELIST_NO = 0;
}


#------------------------------------------------------------------------------#
#   read tool changelist number
#------------------------------------------------------------------------------#

prot_parts ( "read tool changelist number" ) ;

if ( open ( TOOL_CHANGELIST_LOG , "$ENV{TOOL}/data/changelist.log" ))
{
   if ( $TOOL_CHANGELIST_NO = <TOOL_CHANGELIST_LOG> )
   {  chomp ( $TOOL_CHANGELIST_NO ) ;  }
   else
   {  
      print "WARNING: can\'t read tool changelist number!\n" ;
      $TOOL_CHANGELIST_NO = 0;
   }
}
else
{
   print "WARNING: can\'t open $ENV{TOOL}/data/changelist.log!\n" ;
   $TOOL_CHANGELIST_NO = 0;
}
close ( TOOL_CHANGELIST_LOG ) ;


#------------------------------------------------------------------------------#
#   check for lcapps settings
#------------------------------------------------------------------------------#
prot_parts ( "check for lcapps settings" ) ;
unless ( $ENV{LCMAKEID} )
{
  print "WARNING: can\'t find LCMAKEID in environment!\n" ;
  $ENV{LCMAKEID} = 1;
}
unless ( $ENV{APO_COM_SHORT} )
{
  print "WARNING: can\'t find APO_COM_SHORT in environment!\n" ;
  $ENV{APO_COM_SHORT} = "0";
}
if ( $ENV{BRANCH_INFO} )
{
	if ($ENV{BRANCH_INFO} =~ /(COR|DEV|HOT)$/)
	{	$QASTATUS = $1;	}
	else
	{	$QASTATUS = "RAMP";	}
}
else
{
  print "WARNING: can\'t find BRANCH_INFO in environment!\n" ;
  $QASTATUS = "NONE";
}

#------------------------------------------------------------------------------#
#   create a new qadblca entry
#------------------------------------------------------------------------------#

prot_parts ( "create new qadblca entry" ) ;

$qahlca = qadblca -> new ( {	'IDMAKE'     => "$ENV{LCMAKEID}" ,
								'VERSION'    => "$ENV{APO_COM_SHORT}" ,
								'TYPE'       => "$TYPE",
								'QASTATUS'   => "$QASTATUS" ,
								'CHANGELIST' => "$CHANGELIST_NO"								 
						});
if ( $qahlca -> { error_code } != 0 )
{
  $qalca_ok = 0 ;
  $qadb_error_count++;
  print STDERR "ERROR: ".$qahlca->{error_text}."\n" ;
}
else
{
	if ( $TOOL_CHANGELIST_NO )
	{
		if ( $qahlca -> update_columns ( {'TOOLCL'     => "$TOOL_CHANGELIST_NO",
										  'IDOBJSTATUS' => "$WRITE_TOOLCL"
										 } ) != 0 )
		{
			my $errtxt = $qahlca -> { error_text } ;
			print STDERR "ERROR: can\'t update TOOLCL: $errtxt\n" ;
		}
	}
}


#------------------------------------------------------------------------------#
#   storing MAKE ID into $OWN/make.id
#------------------------------------------------------------------------------#

prot_parts ( "store make id" ) ;
$qalca_id = $qahlca -> {'ID'} ;
if ( $qahlca -> { error_code } != 0 )
{
	$qalca_ok = 0 ;
	print STDERR "ERROR: ".$qahlca->{error_text}."\n" ;
}
else
{
	if ( open ( MAKEID_FILE , ">$ENV{OWN}/make.id" ))
	{  print MAKEID_FILE $qalca_id ;  }
else
{  
	print "WARNING: can\'t open $ENV{OWN}/make.id!\n" ;  }
	close ( MAKEID_FILE ) ;
}

#------------------------------------------------------------------------------#
#   call dsp2vmake
#------------------------------------------------------------------------------#

prot_parts ( "create vmake descriptions" ) ;

update_idobjstat ( $START_DSP2VMAKE ) ;

if (-f "$ENV{APO_SRC}/sys/src/descriptions.mac" )
{
	$found_dsp2vmake_description = 1;
	$ret = lcmake ("lcmake.pl", "descriptions.mac"); 
	push @BUILTTARGETS, "descriptions.mac";
}
else
{
	if($^O=~/.*win32.*/i)
	{	$ret = system("python $ENV{TOOL}\\bin\\dsp2vmake.py -inDEV $ENV{APO_SRC}\\sys\\src"); }
	else
	{	$ret = system("python $ENV{TOOL}/bin/dsp2vmake.py -inDEV $ENV{APO_SRC}/sys/src"); }
}

if ($ret != 0)
{
	update_idobjstat ( $ERROR_DSP2VMAKE ) ;
#	if ($found_dsp2vmake_description)
#	{	checkmake::check_lca_make("descriptions.mac");}
#	else
#	{	checkmake::lca_make_message("Error while creating vmake descriptions!\n"); 	}
}
else
{
	update_idobjstat ( $SUCCESS_DSP2VMAKE ) ;
	
	#------------------------------------------------------------------------------#
	# make and build
	#------------------------------------------------------------------------------#
	prot_parts ( "make and build ..." ) ;
	update_idobjstat ( $START_MAKE_AND_BUILD );
	$ret = lcmake ("lcmake.pl", "lcapps_factory.mac"); 
	update_idobjstat ( $ret==0 ? $SUCCESS_MAKE_AND_BUILD : $ERROR_MAKE_AND_BUILD  ) ;
	push @BUILTTARGETS, "lcapps_factory.mac"; 
	
	if ($ret != 0)
	{	
		print "make failed\n";
#		checkmake::check_lca_make("lcapps_factory.mac"); 
	}
	else
	{
		#------------------------------------------------------------------------------#
		# write lcpool id to qadblca
		#------------------------------------------------------------------------------#
		if($^O=~/.*win32.*/i)
		{
			require WinLink;
			import WinLink;
			$LCPOOL_ID = readLink ("$APO_POOL_DIR/LastBuild");
		}
		else
		{	$LCPOOL_ID = readlink "$APO_POOL_DIR/LastBuild"; }
	}
}
		
if ( $qalca_ok )
{
	if ( $qahlca -> update_columns ( {'LCPOOLID' => "$LCPOOL_ID",
									  'IDOBJSTATUS' => "$WRITE_LCPOOL_ID"
									 } ) != 0 )
	{
		my $errtxt = $qahlca -> { error_text } ;
		print STDERR "ERROR: can\'t update LCPOOLID: $errtxt\n" ;
	}
	copy ( "$OWN/make.id", "$APO_POOL_DIR/$LCPOOL_ID/make.id" ) 
		unless ( -f "$APO_POOL_DIR/$LCPOOL_ID/make.id" );
}
else
{	print "WARNING: don't update LCPOOLID because of an open error\n" ;	}


prot_parts ( "end make" ) ;

#------------------------------------------------------------------------------#
#   only protocol informations
#------------------------------------------------------------------------------#

print "\n\nwrite protocoll file \"$MakeRelease.prot\" into qadb\n" ;

if ( $ret == 0 )
{
   print "\nEXIT: Congratulations!!! No make errors occured!\n" ;
   update_idobjstat ( $SUCCESS_ALL ) ;

}
else
{
   update_idobjstat ( $ERROR_ALL ) ;
   print "\nEXIT: ATTENTION---ERRORS---ATTENTION---ERRORS---ATTENTION\n" ;
   print "EXIT: see above\n" ;
}

#------------------------------------------------------------------------------#
#   reset STDOUT and STDERR
#------------------------------------------------------------------------------#

prot_parts ( "reset STDOUT and STDERR" ) ;
close ( STDOUT );
close ( STDERR );
open ( STDOUT , ">&SAVEOUT" ) ;
open ( STDERR , ">&SAVEERR" ) ;

#------------------------------------------------------------------------------#
#   write out make protocol to STDOUT and into qadb
#------------------------------------------------------------------------------#
my $prot_text;
open( IN , "<$MakeProt" ) ;
while ( <IN> )
{
	print $_ ;
	$prot_text .= $_ ;
}
close ( IN ) ;

if ( $qalca_ok )
{
	my $prot_link = $qahlca->write_prot ( "${MakeRelease}.prot" , $prot_text, "make protocol" );
    if ($qahlca->{'error_code'} != 0)
    {
		print STDERR "ERROR: can\'t write prot to DB: $qahlca->{error_text}\n" ;
		$qadb_error_count++;
    }
}
else
{
	print "WARNING: don't write prot because of an open error\n" ;
}

#------------------------------------------------------------------------------#
#   send mail
#------------------------------------------------------------------------------#

prot_parts ( "send mail" ) ;
my $return ;
my @arg_checkmake = ( "$ENV{TOOLSHELL}", "$ENV{'TOOL'}/bin/checklcmake.pl" ) ;
push @arg_checkmake, "-makeid=$qalca_id" if ( $qalca_ok );
push @arg_checkmake , @BUILTTARGETS ;

$return = system ( @arg_checkmake ) ;

if (( !defined $return ) and ( $return != 0 ))
{
  print STDERR "ERROR: file \"checkmake.pl\" failed\n";
}

unlink "${MakeRelease}.prot" unless ($qadb_error_count);

#------------------------------------------------------------------------------#
#   END, return MAIN exit code
#------------------------------------------------------------------------------#

caller () ? return ( $ret ) : exit ( $ret ) ;

################################################################################
################## subroutines #################################################
################################################################################

sub print_usage
{
   print "usage: $0\n\n";
   print "       [-force_rm]\n" ;
   print "          initialise a scratch make\n\n" ;
   print "       [-help | -h]\n" ;
   print "          show this help message\n" ;
}


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

sub prot_parts
{
   my $prot_part = shift ;

   print "\n\n===========================================================\n" ;
   print "=   $prot_part\n" ;
   print "===========================================================\n\n" ;
}


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

sub update_idobjstat
{
	$idobjstat = shift ;
	
	if ( $qalca_ok )
	{
		if ( $qahlca -> update_columns ( {'IDOBJSTATUS' => "$idobjstat"} ) != 0 )
		{
			my $errtxt = $qahlca -> { error_text } ;
			print STDERR "ERROR: can\'t update IDOBJSTATUS: $errtxt\n" ;
		}
	}
	else
	{
		print "WARNING: don't update IDOBJSTATUS because of an open error\n" ;
	}
}

################## subroutines #################################################
