#!/usr/bin/perl -w ###################################################
######################################################################
# This is just a perl script that automates some of the more common
# build management tasks. It is not for the faint of heart. It handles
# a complex CVS setup with Ant builds and assumes an Application
# Support branch, a main (HEAD) line in which no development takes
# place, and a QA branch where patches against QA are tracked.  This
# will support, but does not require separate branches for concurrent
# sub component development (silos) which will not be merged on the
# same schedule as AppSupport and QA.
#
# Be sure to set the path to perl above to match your system. Also, I
# would suggest trying it out for a full cycle on a copy of your live
# CVS repository to make sure you understand it before using it for
# real.  My only guarantee is that this script WILL trash everything
# if used incorrectly and should only be used by someone capable of
# doing all of this manually, but who has chosen not to.
#
# It's menu driven and fairly self-explanatory.
#
# Available from http://www.billglover.com/software/merge/
#
# 03/02/2002 - Bill Glover mailto:Bill.Glover@Sun.Com
######################################################################

# Unbuffer I/O
$| = 1;

# CVS command and log settings
$cvsroot =  $ENV{'CVSROOT'};
$cvs = "cvs -qd $cvsroot";
$miscLog = "2>&1 | tee -a ../misc.log";

# Setup the menu
%help = (
	 'L' => "License, Term and Conditions",
	 'M' => "Merge AppSupport and QA",
	 'S' => "Silo Merge",
	 'T' => "Tag Merge as Complete",
	 'P' => "Promote Release",
	 'C' => "Who's fault is this script anyway?",
	 'H' => "Display Help",
	 'Q' => "Quit Script",
	 );
# Setup the commands
%commands = (
	     'L' => "&displayLicense",
	     'T' => "&tagAfterMergingAllBranches",
	     'S' => "&mergeSilo",
	     'M' => "&mergeAppSupportAndQABranches",
	     'P' => "&promoteRelease",
	     'C' => "&displayContactInfo",
	     'H' => "&displayHelp(%help)",
	     'Q' => "&quitSillyGame",
	     );


# Starts things off.
&main;

# The start of things.
sub main {
    &commandLoop;
}

# Command Loop
sub commandLoop
{
    $continue = 1;
    $nextCommand = 'H';
    while ($continue) {
	if(!$commands{$nextCommand}){
	    print "I don't know that command.\n";
	    &displayHelp(%help);
	}else{
	    eval $commands{$nextCommand};
	}
	$nextCommand = uc(&get_answer(">", "h", 1));
    }
    return;
}


# Returns true / false for yes / no
sub get_yes_no 
{
    my $question = shift;
    my $default  = shift;
    my $interactive = shift;
    $default = $default eq "" ? "y" : $default;	# default to n
    unless ($interactive) { return $default =~ /^y$/i; }
    print "\n", $question, " (y/n) [$default]: ";
    my $answer = '';
    chomp($answer = <STDIN>);
    while ($answer ne "" && $answer !~ /^[yn]$/i) {
	print "  please answer y or n: ";
	chomp ($answer = <STDIN>);
    }
    return $answer eq "" ? $default =~ /^y$/i : $answer =~ /^y$/i;
}

# Gets a string answer
sub get_answer 
{
    my $question = shift;
    my $current  = shift;
    my $interactive = shift;
    unless ($interactive) { return $current; }

    print "\n$question [$current]: ";
    my $answer = '';
    chomp($answer = <STDIN>);
    return $answer eq "" ? $current : $answer;
}

# Displays the license string
sub displayLicense
{
    print &center("This software is licensed under")."\n"; 
    print &center("the GNU General Public License, Version 2.")."\n";
    print &center("Please refer to http://www.gnu.org/licenses/gpl.html")."\n";
    print &center("for details.")."\n";
}

# Exits
sub quitSillyGame
{
    print "\n\nI'm quiting this silly game.\n\n";
    exit;
}

# Shows the menu
sub displayHelp
{
    my %items = @_;
    print "";
    print "@". ("=" x 78) ."@\n";
    foreach my $item(keys %items){
	print " $item - $items{$item}\n";
    }
    print "@". ("=" x 78) ."@\n";
}

# Displays my contact info
sub displayContactInfo
{
    print "
._________________________________________.
| Bill Glover: Senior Java Architect      |             (
| -------------------------------------   |              )
|-----------------------------------------|1    1..*    ___
| company = \"Sun MicroSystems\"            |--------->  c\\_/
| cellPhone = \"(806) 433-0866\"            |           `-----'
| email = \"Bill.Glover\@sun.COM\"           |
+-----------------------------------------+
";
}


# Shows dots as it executes commands in the shell.
# Dies if it receives a nonZero exit value.
# otherwise it returns the lineCount containing the
# number of lines of input received from the command.
sub showDots
{
    my ($cmd) = @_;
    my @spinner = ('.', 'o', '0', 'O', '0', 'o');
    my $lineCount = "0";
    if ($verbose) {
	print "Executing: $cmd\n";
    }
    print "Watch the dancing dot! --> ";

    open(STATUS, $cmd ." 2>&1 |")
	|| die "can't fork: $!";
           while (<STATUS>) {
	       $frame = shift @spinner;
               print "$frame\b";
	       push(@spinner, $frame);
	       ++$lineCount;
           }
    print "\n";
           close STATUS || die "Bad command in showDots!: $! $?";
    return lineCount;
}

# Centers a string in the display
sub center()
{
    my ($text) = @_;
    $padding = " " x ((80 - length $text) / 2);
    $text = $padding . $text;
    return $text;
}

# Saves configuration values
sub saveConfig
{
    my ($release, $workDirectory, $module) = @_;
    my %config = (
		  "workDirectory" =>  $workDirectory . "\n",
		  "release" => $release . "\n",
		  "module" => $module . "\n",
		 );
    open CONFIG, "> $ENV{'HOME'}/.merge_branch.cfg";
    while(($key, $value) = each %config){
	print CONFIG "$key=$value";
    }
    close CONFIG;
}

# Loads configuration values
sub loadConfig
{
    my $configFile = "$ENV{'HOME'}/.merge_branch.cfg";
    if (!stat($configFile)) {
	&saveConfig("0_1_0", "project", "our-project",
		    ":local:/usr/local/cvs", "0", "Release");
    }
    open CONFIG, "< $configFile";
    while(<CONFIG>){
	chomp;
	%config = (%config, split('='));
    }
    close CONFIG;
    return %config;
}

# Promotes a major release. For instance 0_52_0 -> 1_0_0
sub promoteRelease()
{
    if(setupMerge()){
	my $promotedRelease = get_answer("What would you like to promote the last release too?", "1_0_0", 1);
	if (!&get_yes_no("Promote $ {lastDevVersion} to ${promotedRelease}?", "n", 1)) { return; }
	chdir;
	showDots("$cvs rtag -r $release $promotedRelease $module  $miscLog");
	print("Done\n");
    }
}

# Tags the merged code.
sub tagAfterMergingAllBranches
{
    if( ! setupMerge()) { return; }
    &showDots("$cvs tag after_merge_cleanup_$nextDevVersion $miscLog");
    print "You're done. Hand-off to the Build Coordinator\n";
    print "Thank you, and come again.(tm)\n";
}

# Merges the main development line with the QA line after merging
# in the Application Support line.
sub mergeAppSupportAndQABranches{
    if( ! setupMerge()) { return; }
    &oneLastWarning;
    if ( ! &get_yes_no("Continue?", "n", 1)) { return; }
    if ( ! &mergeAppSupportBranch ) { return; }
    if ( ! &mergeQABranch ) { return; }
}

# Merges a component development line into the main development line.
sub mergeSilo
{
    if( ! setupMerge() ) { return; }
    $siloBranch = &get_answer('What is the silo\'s branch?', 0, 1);
    if ( ! $siloBranch ) { return; }
    &oneLastWarning;
    if ( ! &get_yes_no("Continue?", "n", 1) ) { return; }
    if ( ! &mergeBranchToTrunk($siloBranch) ) { return; }
}

# Merges the Application Support line into the main development line.
sub mergeAppSupportBranch
{
    return &mergeBranchToTrunk("AppSupport_" . substr($nextDevVersion, 2));
}

# Merges the QA line into the main development line.
sub mergeQABranch
{
    return &mergeBranchToTrunk("Branch_${release}");
}

# Merges some specified line into the development line.
sub mergeBranchToTrunk
{
    ( $version ) = @_;
    &checkOutBranch;
    &showDots("$cvs tag latest_${version} $miscLog");
    if ( ! &ableToMerge ) { return; }
    print "Commiting our work.\n";
    &showDots("$cvs commit -m clean-up $miscLog");
    return 'continue';    
}

# Terrifies the unprepared, offer advice to the wary
sub oneLastWarning
{
	print "=" x 79 . "\n";
	print &center("WARNING: During this process YOU are the only") . "\n";
        print &center("developer allowed to use the repository. ") . "\n";
	print &center ("NO EXCEPTIONS!") . "\n";
	print "=" x 79 . "\n";
	print "Please open another session to work in as this script\n";
	print "may prompt you to perform feats of daring as it runs.\n";
	print "I keep alot of logs and tag important milestones as\n";
	print "we go. If this is your first time, you might want to\n";
	print "go back and ask me to show my work. Otherwise\n";
	print "just press \'y\' and we\'ll get rolling.\n";
}

# Sets the current workspace to represent some branch.
sub checkOutBranch 
{
	chdir;
	print "Working...\n";
	if (stat($workDirectory)) {
	    chdir $workDirectory;
	    &showDots("$cvs update -r ${version}  $miscLog");
	}else {
	    &showDots("$cvs co -r ${version} $module 2>&1 | tee misc.log");
	    chdir $workDirectory;
	}
}

# Finds all of the files which have changed.
sub patchedFiles
{
    open PATCHED, "< qa.log";
    my @patchedFiles;
    while (<PATCHED>) {
	chomp;
	push(@patchedFiles, /^Index:(.*)/);
    }
    close PATCHED;
    return @patchedFiles;
}

# Fixes any merge collisions interactively.
sub fixAnyCollisions
{
    my @conflictingFiles = &conflictingFiles;
    if ( @conflictingFiles ) {
	print "These Files look like they have conflicts.\n";
	print "You will need to check them.\n";
	print "I'll just wait here.\n";
	foreach ( @conflictingFiles ) {
	    print "$_ \n";
	}
    }
    if (!&get_yes_no("Continue?", "n", 1)) { return; }
    @conflictingFiles = ();
    @conflictingFiles = &conflictingFiles;
    if ( @conflictingFiles ) {
	print "These Files look like they still have conflicts.\n";
	foreach (@conflictingFiles) {
	    print "$_ \n";
	}
	if (!&get_yes_no("Are you sure you want to Continue?", "n", 1)) { return; }
    }
    return 'continue';
}

# Finds the files with merge conflicts.
sub conflictingFiles
{
    #mask these to avoid seeing these in it's own scan.
    &showDots("find . | xargs grep -l '\<\<\<\<\<\<\<' 2>/dev/null | tee conflict.log");
    open CONFLICT, "< conflict.log";
    my @conflictingFiles;
    while (<CONFLICT>) {
	chomp;
	push(@conflictingFiles, $_);
    }
    close CONFLICT;
    return @conflictingFiles;
}

# Runs an ant build and unit tests.
# be sure to set your JUnit task to fail the compile if 
# a test fails or errors.
sub compileTestAndRun
{
    print "I will now try to compile.\n";
    &showDots("ant 2>&1 | tee ant.log");
    my @failedCompiles = &failedCompiles;
    while (@failedCompiles) {
	print "The compile failed.\n";
	print "You should look at these files.\n";
	foreach (@failedCompiles) {
	    print "$_\n";
	}
	if (!&get_yes_no("Ready to try again? ('n' to quit))", "n", 1)) { return; }
	print "I will now try to compile.\n";
	print "Again ...\n";
	&showDots("ant 2>&1 | tee ant.log");
	@failedCompiles = ();
	@failedCompiles = &failedCompiles;
    }
    print "Through with the compile.\n";
    print "Try running it. I'll wait here.\n";
    if (!&get_yes_no("Continue?", "n", 1)) { return; }
    return 'continue';
}

# Reports a failed compile.
sub failedCompiles
{
    open FILES, "< ant.log";
    my @failedCompiles;
    while (<FILES>) {
	chomp;
	push(@failedCompiles, /errors compiling \"(.*)\"/);
    }
    close FILES;
    return @failedCompiles;
}

# Determines if two branches are ready to merge.
sub ableToMerge 
{
    $longString = "$cvs diff -r $lastDevVersion ";
    $longString = $longString . "-r latest_${version} 2>&1 | tee qa.log";
    &showDots($longString);
    @patchedFiles = &patchedFiles;
    &showDots("$cvs update -A $miscLog");
    if ( @patchedFiles ) {
	print "These Files look like they have changed in QA.\n";
	print "You will probably want to check them after the merge.\n";
	foreach my $patchedFile(@patchedFiles) {
	    print "$patchedFile \n";
	}
	&showDots("$cvs diff -r $lastDevVersion -r HEAD 2>&1 | tee dev.log");
	&showDots("$cvs tag premerge_$nextDevVersion $miscLog");
	print "Merging\n";
	&showDots("$cvs update -j ${version} 2>&1 | tee premerge.log");
	if ( ! &fixAnyCollisions ) {return;}
	print "Logging and commiting your changes.\n";
	&showDots("$cvs diff 2>&1 | tee merged.log");
	&showDots("$cvs commit -m merged $miscLog");
	&showDots("$cvs tag just_merged_changes_$nextDevVersion $miscLog");
    }else {
	print "According to qa.log, there have apparently been no patches in QA.\n";
    }
    if ( ! &compileTestAndRun ) { return; } 
    return 'continue';
}

# Prompts for starting values and sets up the calculated 
# tags for the next versions
sub setupMerge
{
    if(!get_yes_no("Are your sure you want to do this?", "n", 1)){
	print "You have chosen wisely. Aborting operation.\n";
	return;
    }
    %config = &loadConfig;
    print "\n";
    $release = $config{'release'};
    $workDirectory = $config{'workDirectory'};
    $module = $config{'module'};

    while (1) {
	($major, $minor, $patch) = split(/_/, $release);
	$lastDevVersion = "v\_$major\_" . ($minor - 1) . "\_$patch";
	$nextDevVersion = "v\_$major\_". ($minor + 1) . "\_$patch";
	if (($minor - 1) < 0) {
	    print "I'm not smart enough to calculate this one.";
	    $lastDevVersion = "v\_" . &get_answer("What was the last development version?", ($major - 1) . "\_" . "99" . "\_$patch", 1);
	}
	print "Last Development Version : $lastDevVersion\n";
	print "Next Development Version : $nextDevVersion\n";
	print "Release in QA right now  : $release\n";
	print "Work Directory           : $workDirectory\n";
	print "CVS  Module              : $module\n";
	print "Show my work.            : " . ($verbose ? 'yes' : 'no') . "\n";

	if(get_yes_no("Is this correct?", "n", 1)){last;}

	print "Ok. Let\'s start over then.\n";
	$release = get_answer("What was the last release version?", $release, 1);
	$workDirectory = get_answer("What is the work directory?", $workDirectory, 1);
	$module = get_answer("What is the name of the CVS module?", $module, 1);
	$verbose = get_yes_no("Should I show all my work?", "n", 1);
	saveConfig($release, $workDirectory, $module);
    }
    return 'continue';
}