2 ################################################################################
4 # File: $RCSfile: BinMerge.pm,v $
5 # Revision: $Revision: 1.4 $
6 # Description: This module will perform a merge checking for any merge
7 # conflicts and grouping them at the end. This allows the
8 # majority of a large merge to happen and the user can resolve
9 # the conflicts at a later time.
11 # This module also assists in performing binary merges for the
12 # common case. With a binary merge one cannot easily merge the
13 # binary code. Most often it's a sitatution where the user will
14 # either accept the source or the destination binary file as
15 # a whole. In cases where there is only a 2 way merge, this
16 # script offers the user the choice to accept 1 binary file
17 # or the other or to abort this binary merge. Binary merges
18 # conflicts greater than 2 way are not handled.
20 # This was made into a module so that it could be easily called
21 # from UCMCustom.pl. There is also a corresponding bin_merge
22 # script which essentially calls this module
24 # Dependencies: This module depends on PerlTk. As such it must be run
25 # from ccperl or a Perl that has the PerlTk module
26 # installed. Additionally it uses the Clearcase
27 # cleartool command which is assumed to be in PATH.
28 # Author: Andrew@ClearSCM.com
29 # Created: Thu Nov 3 10:55:51 PST 2005
30 # Modified: $Date: 2011/03/10 23:47:31 $
33 # (c) Copyright 2005, ClearSCM, Inc. all rights reserved
35 ################################################################################
55 # Extract relative path and basename from script name.
56 $0 =~ /(.*)[\/\\](.*)/;
58 $me = (!defined $2) ? $0 : $2;
61 # Remove .pl for Perl scripts that have that extension
70 my $user = $ENV {USERNAME};
73 my $selection_file = "$me.selection.$$";
78 # Sometimes people foolishly undef $/
81 open my $file, '<', $filename
82 or error "Unable to open $filename ($!)", 1;
93 push @cleansed_lines, $_ if !/^#/; # Discard comment lines
96 return @cleansed_lines;
102 my $err = $main->Dialog (
116 my @entries = $list->curselection;
118 if (scalar @entries == 0) {
119 Error "Nothing selected!";
123 my $selected = $list->get ($entries [0]);
125 # Write selection out to file and exit
126 open my $file, '>', $selection_file
127 or die "Unable to open $selection_file\n";
129 print $file "$selected\n";
133 # Close prompt window
142 $text = "A merge conflict has been detected between two binary files. ";
143 $text .= "Please pick the version that you want to be the result of this ";
144 $text .= "merge.\n\nNote you can pick any of these versions and the result ";
145 $text .= "will be that that version will be considered the new version ";
146 $text .= "overwriting the previous version.\n\nIf this is not what you want ";
147 $text .= "then select the Cancel button and regenerate this binary file ";
148 $text .= "so that it is the result of what you want for this merge.\n\n";
149 $text .= "Copyright ? 2005 - All rights reserved\n";
150 $text .= "Andrew DeFaria <Andrew\@ClearSCM.com>";
152 my $desc = $main->Dialog (
172 my $cmd = "cleartool lsvtree -graphical $file";
174 if ($^O =~ /mswin|cygwin/i) {
175 system "start /b $cmd";
188 # Create a ListBox widget in $parent, dynamically sizing it to the length of
189 # the longest entry in @list.
191 my ($parent, @list) = @_;
193 my $list = $parent->Scrolled ("Listbox",
194 -scrollbars => "osoe",
199 # Insert entries from @list into the new ListBox, $list
201 $list->insert ("end", $_);
210 my ($parent, $list, $file) = @_;
211 my $one = $parent->Frame->pack (-side => "left", -pady => 2, -padx => 2);
212 my $two = $parent->Frame->pack (-side => "left", -pady => 2, -padx => 2);
213 my $three = $parent->Frame->pack (-side => "left", -pady => 2, -padx => 2);
214 my $four = $parent->Frame->pack (-side => "left", -pady => 2, -padx => 2);
216 my $ok = $one->Button (
218 -command => [ \&CheckSelection, $list ]
221 my $cancel = $two->Button (
223 -command => [ \&Cancel ]
226 my $help = $three->Button (
231 my $vtree = $four->Button (
232 -text => "Version Tree",
233 -command => [ \&VersionTree, $file ]
240 my ($element, @versions) = @_;
242 debug "ENTER: PromptUser";
245 $main = MainWindow->new;
248 $main->title ("Resolve merge conflict for binary element");
250 # Create the main window using containers
251 my $top = $main->Frame->pack (-side => "top", -fill => "x");
252 my $prompt = $top->Frame->pack (-side => "left", -pady => 5, -padx => 5);
253 my $list = $main->Frame->pack (-side => "left");
254 my $buttons = $list->Frame->pack (-side => "bottom");
257 my $prompt_str = <<"END";
258 A binary merge conflict has been detected between two versions of
262 Please pick the version that you want to be the result of this merge. Note you
263 can pick any of these versions and the result will be that that version will be
264 considered the new version overwriting the previous version. If this is not what
265 you want then select the Cancel button here and regenerate this binary file so
266 that it is the result of what you want for this merge.
269 $prompt->Message (-text => $prompt_str, -width => 500)->pack;
271 my $version_list = CreateList $list, @versions;
273 CreateButtons $buttons, $version_list, $element;
275 # Make sure the window pops to the top
276 # Trying really hard... :-)
287 open my $result, '<', $selection_file
290 my @lines = <$result>;
294 unlink $selection_file;
306 # The merging of directories could, in theory, unearth other elements inside
307 # those directories thus causing further merging. Here we keep merging
308 # directories until there are no directories to merge.
309 sub MergeDirectories {
310 my ($log, $path, $branch) = @_;
312 my $cmds = "$me.$$.cmds";
313 my $cmd = "cleartool findmerge $path -nc -type d -fversion $branch " .
314 "-log $cmds -print > $NULL 2>&1";
316 debug "ENTER: MergeDirectories (<log>, $path, $branch)";
321 $log->msg ("Searching for directories that need merging...");
323 debug "Performing: $cmd";
325 my $status = $log->logcmd ($cmd);
327 return $status if $status != 0;
329 @lines = ReadFile $cmds;
331 last if scalar @lines == 0;
333 $log->msg ("Performing directory merges...");
337 debug "Performing: $_";
338 $status = $log->logcmd ($_);
340 return $status if $status != 0;
344 $log->msg ("All directories merged.");
349 debug "EXIT: MergeDirectories (<log>, $path, $branch)";
354 # Here we'll attempt to merge file individually using -abort. This tells
355 # cleartool findmerge to only merge that which is can automatically merge. For
356 # every merge failure we'll push an entry onto @merge_conflicts.
358 my ($log, $path, $branch) = @_;
360 my $cmds = "$me.$$.cmds";
361 my $cmd = "cleartool findmerge $path -nc -type f -fversion $branch " .
362 "-log $cmds -print > $NULL 2>&1";
364 debug "ENTER: MergeFiles (<log>, $path, $branch)";
366 $log->msg ("Merging files...");
370 my @lines = ReadFile $cmds;
373 foreach my $file_merge_cmd (@lines) {
378 if ($file_merge_cmd =~ /cleartool findmerge (.*) -fver/) {
382 # Add -abort to this variable, which use for execution. We keep
383 # the old variable to put in the return array.
384 my $file_merge_cmd_abort = "$file_merge_cmd -abort 2>&1";
386 debug "Performing $file_merge_cmd_abort";
387 $log->msg ($file_merge_cmd_abort);
389 # Capture the output from the merge and parse it. If there's
390 # just a merge conflict then "*** No Automatic Decision
391 # possible" and "merge: Warning: *** Aborting.." are present in
392 # the output. If the merge fails because of binary files then
393 # nothing is in the output. Either way, if Clearcase is unable
394 # to merge the status returned is non zero. We can then
395 # differentiate between resolvable merge conflicts and
396 # unresolvable merge conflicts (binary files). Format
397 # %merge_conflicts to indicate the type and push it on
398 # @merge_conflicts to return to the caller.
400 # Also find merges that will not work because the element is
401 # checked out reserved somewhere else.
402 my @output = `$file_merge_cmd_abort`;
405 # Put output in the logfile
412 # If $status eq 0 then the merge was successful! Next merge!
413 $log->msg ("Auto merged $file_to_merge");
418 my @errors = grep {/\*\*\* /} @output;
419 my @reserved = grep {/is checked out reserved/} @output;
421 if (scalar @reserved > 0) {
422 if ($reserved [0] =~ /view (\S+)\./) {
423 $log->err ("Unable to merge $file_to_merge because it is checked out reserved in the view $1");
429 $merge_conflict {cmd} = $file_merge_cmd;
431 # Differentiate between binary merge conflicts and non binary
433 if (scalar @errors > 0) {
434 $merge_conflict {type} = "regular";
435 $log->msg ("Delaying regular conflicting merge for " . $file_to_merge);
437 $log->msg ("Delaying binary merge for " . $file_to_merge);
438 $merge_conflict {type} = "binary";
441 push @merge_conflicts, \%merge_conflict;
444 my $nbr_conflicts = scalar @merge_conflicts;
446 if ($nbr_conflicts == 0) {
447 $log->msg ("All files merged");
448 } elsif ($nbr_conflicts == 1) {
449 $log->msg ("$nbr_conflicts merge conflict found");
451 $log->msg ("$nbr_conflicts merge conflicts found");
457 debug "EXIT: MergeFiles (<log>, $path, $branch)";
459 return @merge_conflicts;
464 my $baseline = shift;
466 $log->msg ("Finding directories that need rebasing...");
468 my $cmd = "cleartool rebase -long -preview ";
470 if (!defined $baseline) {
471 $cmd .= "-recommended";
473 $cmd .= "-baseline $baseline";
476 $log->msg ("Performing command: $cmd");
483 return %rebase_dirs if $? != 0;
485 # Now parse the files to be merged collecting information
487 if (/\s*(\S*)\@\@(\S*)/) {
492 next if !-d $element;
494 $log->msg ("Directory Element: $element Version: $ver");
495 $rebase_dirs {$element} = $ver;
504 my $baseline = shift;
506 $log->msg ("Finding files that need rebasing...");
508 my $cmd = "cleartool rebase -long -preview ";
510 if (!defined $baseline) {
511 $cmd .= "-recommended";
513 $cmd .= "-baseline $baseline";
516 $log->msg ("Performing command: $cmd");
526 # Now parse the files to be merged collecting information
528 if (/\s*(\S*)\@\@(\S*)/) {
533 next if !-f $element;
535 $log->msg ("Element: $element Version: $ver");
536 $rebase_files {$element} = $ver;
540 return %rebase_files;
543 sub RebaseDirectories {
545 my $baseline = shift;;
547 debug "ENTER: RebaseDirectories";
549 $log->msg ("Rebasing directories");
551 my $rebase_status = 0;
554 # Keep rebasing directories until there are no more
555 while (%rebase_dirs = GetRebaseDirs $log, $baseline) {
556 foreach my $element (keys %rebase_dirs) {
557 # First checkout file if necessary - ignore errors
558 my @output = `cleartool checkout -nc $element > $NULL 2>&1`;
560 my $cmd = "cleartool merge -abort -to $element -version ${rebase_dirs {$element}} 2>&1";
565 # Put output in the logfile
573 # If $status eq 0 then the merge was successful! Next merge!
574 $log->msg ("Auto merged $element");
579 my @errors = grep {/\*\*\* /} @output;
580 my @reserved = grep {/is checked out reserved/} @output;
582 # TODO: This is broke!
584 if (scalar @reserved > 0) {
585 if ($reserved [0] =~ /view (\S+)\./) {
586 $log->err ("Unable to merge $file_to_merge because it is checked out reserved in the view $1");
595 debug "Returning $rebase_status from RebaseDirectories";
596 return $rebase_status;
597 } # RebaseDirectories
600 my ($log, $baseline, %rebase_elements) = @_;
602 debug "ENTER: RebaseFiles";
604 # TODO: This is broke too
607 $log->msg ("Rebasing elements");
609 foreach my $element (keys %rebase_elements) {
610 # First checkout file if necessary - ignore errors
611 my @output = `cleartool checkout -nc $element > $NULL 2>&1`;
613 my $cmd = "cleartool merge -abort -to $element -version ${rebase_elements {$element}} 2>&1";
618 # Put output in the logfile
625 # If $status eq 0 then the merge was successful! Next merge!
626 $log->msg ("Auto merged $element");
631 my @errors = grep {/\*\*\* /} @output;
632 my @reserved = grep {/is checked out reserved/} @output;
634 # TODO: This is broke too
635 my ($file_to_merge, $merge_conflict, %merge_conflict, @merge_conflicts);
637 if (scalar @reserved > 0) {
638 if ($reserved [0] =~ /view (\S+)\./) {
639 $log->err ("Unable to merge $file_to_merge because it is checked out reserved in the view $1");
645 # Differentiate between binary merge conflicts and non binary
647 if (scalar @errors > 0) {
648 $merge_conflict {type} = "regular";
649 $log->msg ("Delaying regular conflicting merge for " . $element);
651 $log->msg ("Delaying binary merge for " . $element);
652 $merge_conflict {type} = "binary";
655 push @merge_conflicts, \%merge_conflict;
658 my $nbr_conflicts = scalar @merge_conflicts;
660 if ($nbr_conflicts == 0) {
661 $log->msg ("All files merged");
662 } elsif ($nbr_conflicts == 1) {
663 $log->msg ("$nbr_conflicts merge conflict found");
665 $log->msg ("$nbr_conflicts merge conflicts found");
668 debug "EXIT: RebaseFiles";
670 return @merge_conflicts;
674 my ($baseline, $verbose, $debug) = @_;
677 Display::set_verbose;
683 my $log = Logger->new (
685 disposition => "temp",
689 $log->msg ("BinMerge (rebase) $version started at " . localtime);
691 if (!defined $baseline) {
692 $log->msg ("Baseline: RECOMMENDED");
694 $log->msg ("Baseline: $baseline");
697 my $rebase_status = RebaseDirectories $log, $baseline;
699 my @merge_conflicts = RebaseFiles $log, $baseline;
706 my ($branch, $path, $verbose, $debug) = @_;
709 Display::set_verbose;
715 error "Must specify a branch" if !defined $branch;
716 $path = "." if !defined $path;
718 my $log = Logger->new (
720 disposition => "temp",
724 $log->msg ("BinMerge $version started at " . localtime);
725 my $merge_status = 0;
727 $merge_status = MergeDirectories $log, $path, $branch;
729 my @merge_conflicts = MergeFiles $log, $path, $branch;
731 my (@binary_merge_conflicts, @text_merge_conflicts);
734 # Separate the bin merges from the text merges.
735 while (@merge_conflicts) {
736 my %merge_conflict = %{shift @merge_conflicts};
738 if ($merge_conflict {type} eq "binary") {
739 # Since we can't merge binary files, change -merge to
740 # -print. Later we'll use the -print output to present the
742 $merge_conflict {cmd} =~ s/ -merge / -print /;
743 push @binary_merge_conflicts, $merge_conflict {cmd};
745 # For text merges we can merge but we want to merge
747 $merge_conflict {cmd} =~ s/ -merge / -gmerge /;
748 push @text_merge_conflicts, $merge_conflict {cmd};
752 # Now process the text merges
753 foreach my $merge_conflict (@text_merge_conflicts) {
754 # Now try the merge so that diffmerge comes up allowing the user
755 # to resolve the conflicts for this element.
758 if ($merge_conflict =~ /cleartool findmerge (.*) -fver/) {
762 $file_to_merge =~ s/\\\\/\\/g;
764 debug "Performing $merge_conflict";
765 my $status = $log->logcmd ("$merge_conflict 2>&1");
768 $log->err ("$user did not resolve merge conflicts in $file_to_merge");
771 $log->msg ("$user resolved conflicts in merge of $file_to_merge");
775 # Now process the binary ones...
776 foreach my $merge_conflict (@binary_merge_conflicts) {
777 # Now try to handle the binary merge conflicts. Best we can do
778 # is to present the user the with the various versions that
779 # could be taken as a whole along with an option to not
780 # merge. If they select a specific version then we simply draw a
785 # First let's do the merge command again capturing the output
786 # which has a format like:
788 # Needs Merge "firefox.exe" [to \main\adefaria_Andrew\CHECKEDOUT
789 # from \main\Andrew_Integration\2 base \main\adefaria_Andrew\1]
791 # From this we'll get the $from and $to to present to the user.
794 if ($merge_conflict =~ /cleartool findmerge (.*) -fver/) {
798 debug "Performing $merge_conflict";
799 my @output = `$merge_conflict 2>&1`;
803 if ($output [0] =~ /to (\S*) from (\S*)/) {
808 push @selections, $from;
809 push @selections, $to;
811 my $choice = PromptUser $file_to_merge, @selections;
813 if (!defined $choice) {
814 $log->err ("$user aborted binary merge of $file_to_merge");
819 # I don't know why the above doesn't remove the trailing \n so let's
820 # chop it off if it exists!
821 chop $choice if $choice =~ /\n/;
825 # At this point the merge process has checked out the file in
826 # the current view but is unable to perform the merge because
827 # this is a binary file. If the user chooses the $from version
828 # then they are saying that the $from version should be brought
829 # into the current view and a merge arrow drawn from $from ->
832 # If, however, they choose the CHECKEDOUT version then what we
833 # want to do is to cancel the current checkout and draw a merge
834 # arrow from the predecessor to $to.
835 if ($choice eq $from) {
836 # Need to copy the $from version to the checkedout version here.
837 debug "Copying $file_to_merge\@\@$choice to current view";
838 open my $from, '<', "$file_to_merge\@\@$choice"
839 or error "Unable to open $file_to_merge\@\@$choice", 1;
842 open my $to, '>', "$file_to_merge"
843 or error "Unable to open $file_to_merge\@\@$to", 2;
853 $log->msg ("$user chose to link from $choice -> $file_to_merge" .
854 " in the current view");
855 $cmd = "cleartool merge -to \"$file_to_merge\"" .
856 " -ndata \"$file_to_merge\@\@$choice\"";
858 # Need to cancel the checkout then determine what version
859 # Clearcase reverts to. WARNING: This might doesn't work
860 # for a snapshot view.
861 debug "Canceling checkout for $file_to_merge";
862 @output = `cleartool unco -rm $file_to_merge 2>&1`;
864 error "Unable to cancel checkout of $file_to_merge", 3 if $? != 0;
866 @output = `cleartool ls -s $file_to_merge`;
870 if ($output [0] =~ /\@\@(.*)/) {
874 debug "Drawing merge arrow from $file_to_merge\@\@$from -> $choice";
875 $log->msg ("$user chose to link $file_to_merge from $from -> $choice");
876 $cmd = "cleartool merge -to \"$file_to_merge\"\@\@$choice\" -ndata \"$file_to_merge\@\@$from\"";
880 my $status = $log->logcmd ($cmd);
882 error "Unable to draw merge arrow ($cmd)" if $status != 0;
884 $merge_status += $status;
887 if ($merge_status > 0) {
888 $log->err ("There were problems with the merge. Please review " .
889 $log->fullname . " for more infomation");