office-gobmx/solenv/bin/cwsanalyze.pl
2007-02-01 13:37:31 +00:00

1136 lines
38 KiB
Perl
Executable file

:
eval 'exec perl -wS $0 ${1+"$@"}'
if 0;
#*************************************************************************
#
# OpenOffice.org - a multi-platform office productivity suite
#
# $RCSfile: cwsanalyze.pl,v $
#
# $Revision: 1.17 $
#
# last change: $Author: rt $ $Date: 2007-02-01 14:37:31 $
#
# The Contents of this file are made available subject to
# the terms of GNU Lesser General Public License Version 2.1.
#
#
# GNU Lesser General Public License Version 2.1
# =============================================
# Copyright 2005 by Sun Microsystems, Inc.
# 901 San Antonio Road, Palo Alto, CA 94303, USA
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License version 2.1, as published by the Free Software Foundation.
#
# This library 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
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
#
#*************************************************************************
#
# cwsanalyze.pl - analyze child workspace, report findings
# cwsintegrate.pl - integrate child workspace into master workspace
#
# TODO implements 'alerts' for integrate mode
use strict;
use File::Basename;
use Getopt::Long;
use Cwd;
use IO::Handle;
use Carp;
#### module lookup
my @lib_dirs;
BEGIN {
if ( !defined($ENV{SOLARENV}) ) {
die "No environment found (environment variable SOLARENV is undefined)";
}
push(@lib_dirs, "$ENV{SOLARENV}/bin/modules");
push(@lib_dirs, "$ENV{COMMON_ENV_TOOLS}/modules") if defined($ENV{COMMON_ENV_TOOLS});
}
use lib (@lib_dirs);
use Cws;
use CvsModule;
use Cvs;
eval { require Logging; import Logging; };
# $log variable is only defined in SO environment...
my $log = undef;
$log = Logging->new() if (!$@);
#### script id #####
( my $script_name = $0 ) =~ s/^.*\b(\w+)\.pl$/$1/;
my $script_rev;
my $id_str = ' $Revision: 1.17 $ ';
$id_str =~ /Revision:\s+(\S+)\s+\$/
? ($script_rev = $1) : ($script_rev = "-");
print "$script_name -- version: $script_rev\n";
#### FIXME: hardcoded globals #####
# Don't use this tool on a MWS workspaces in the veto
# list, because the behavior may not be clearly defined
# examples:
# no MWS branch exists
# MWS branch is obsolete
my @veto_list = (
'SRX644',
'FIX645'
);
my %veto_hash;
foreach (@veto_list) {
$veto_hash{$_}++;
}
# Commit veto pattern. Never integrate files matching this pattern
my %commit_veto_hash;
my @commit_veto_list = (
# The defs file mechanism is not compatible with CWS.
# It really needs to be changed.
'defs\/wntmsci\d+$'
);
foreach (@commit_veto_list) {
$commit_veto_hash{$_}++;
}
#### global #####
my $is_debug = 0; # misc traces for debugging purposes
my $mode = $script_name; # operational mode (cwsanalyze|cwsintegrate)
my $opt_fast = 0; # fast mode, disable conflict check
my $opt_force = 0; # force integration
my $opt_no_set_integrated = 0; # don't toggle integration status
my $vcsid = "unknown";
my $opt_auto_int = 0; # integrate automatically if no conflicts are shown
my $opt_resume = 0; # resume a broken integration
my $opt_quiet = 0; # minimal output
my @args_bak = @ARGV;
my @problem_log = ();
#### main #####
my $parameter_list = $log->array2string(";",@args_bak) if defined($log);
my ($dir, @modules) = parse_options();
my $cws = get_and_verify_cws();
@modules = verify_modules($cws, @modules);
if ( $mode eq 'cwsanalyze' ) {
analyze($cws, $dir, @modules);
}
else {
auto_int($cws, $dir,@modules) if ($opt_auto_int); # will exit and doesn't return
integrate($cws, $dir, @modules);
}
print_plog();
$log->end_log_extended($script_name,$vcsid,"success") if defined($log);
exit(0);
#### subroutines ####
# Get current child workspace from environment.
sub get_and_verify_cws
{
my $childws = $ENV{CWS_WORK_STAMP};
my $masterws = $ENV{WORK_STAMP};
if ( exists $veto_hash{$masterws} ) {
print_error("Please don't use this tool for a CWS based on MWS '$masterws',", 0);
print_error("before you haven't resynced it to a more recent MWS.", 1);
}
if ( !defined($childws) || !defined($masterws) ) {
print_error("Can't determine child workspace environment.\n"
. "Please initialize environment with setsolar ...", 1);
}
my $cws = Cws->new();
$cws->child($childws);
$cws->master($masterws);
$log->start_log_extended($script_name,$parameter_list,$masterws,$childws) if defined($log);
# check if we got a valid child workspace
my $id = $cws->eis_id();
print "Master: $masterws, Child: $childws, $id\n" if $is_debug;
if ( !$id ) {
print_error("Child workspace $childws for master workspace $masterws not found in EIS database.", 2);
}
return $cws;
}
# Parse options and do some sanity checks;
# returns freshly allocated Cws reference.
sub parse_options
{ my $dir = 0;
my $help = 0;
my $success = GetOptions('d=s' => \$dir, 'n' => \$opt_fast, 'h' => \$help,
'F' => \$opt_force, 'q' => \$opt_no_set_integrated, 'A' => \$opt_auto_int, 'r' => \$opt_resume, 'z' => \$opt_quiet);
if ( !$success || @ARGV<1 ) {
usage();
exit(1);
}
if ( $dir && $opt_fast ) {
usage();
exit(1);
}
$dir = $dir ? $dir : cwd();
# check directory
if ( ! -d $dir ) {
print_error("'$dir' is not a directory.", 1);
}
if ( ! -w $dir ) {
print_error("Can't write to directory '$dir'.", 1);
}
unless ( $opt_fast ) {
my @cvsdirs = glob("$dir/*/CVS");
if ( @cvsdirs ) {
print_error("'$dir' contains CVS modules. Please specify an empty scratch directory.", 1);
}
}
return ($dir, @ARGV);
}
# Check if requested modules are registered with child workspace.
sub verify_modules
{
my $cws = shift;
my @modules = @_;
my @registered_modules = $cws->modules();
my $child = $cws->child();
# call with empty modules list
return @registered_modules if $modules[0] eq 'all';
# create hash for easier searching
my %registered_modules_hash = ();
for (@registered_modules) {
$registered_modules_hash{$_}++;
}
foreach (@modules) {
if ( !exists $registered_modules_hash{$_} ) {
print_error("Module '$_' is not registered for child '$child'.", 2);
}
}
return @modules;
}
# Analyze changes in child work space
sub analyze
{
my $cws = shift;
my $dir = shift;
my @modules = @_;
my $child = $cws->child();
my $master = $cws->master();
print_message("Analyzing child workspace '$child', master workspace '$master'.");
print_message("*** Conflict check disabled ***") if $opt_fast;
# display child workspace approval status
my $approval = $cws->get_approval();
if ( !$approval ) {
print_error("Internal error: can't get approval status for '$child'.", 3);
}
print_message("Child workspace approval status: '$approval'");
my ($ntotal_merged, $ntotal_new, $ntotal_removed, $ntotal_conflicts, $ntotal_alerts)
= (0, 0, 0, 0);
foreach (@modules) {
my ($nmerged, $nnew, $nremoved, $nconflicts, $nalerts) = analyze_module($cws, $dir, $_);
$ntotal_merged += $nmerged;
$ntotal_new += $nnew;
$ntotal_removed += $nremoved;
$ntotal_conflicts += $nconflicts;
$ntotal_alerts += $nalerts;
}
my $merge_str = $opt_fast ? 'change(s)' : 'clean merge(s)';
my $stats = "All Modules: $ntotal_merged $merge_str, $ntotal_new new, ";
$stats .= "$ntotal_removed removed";
$stats .= $opt_fast ? '' : ", $ntotal_conflicts conflict(s), $ntotal_alerts alert(s)";
print_message($stats);
return ($ntotal_conflicts,$ntotal_alerts) if $opt_auto_int;
}
# Integrate child workspace into master.
sub integrate
{
my $cws = shift;
my $dir = shift;
my @modules = @_;
my $child = $cws->child();
my $master = $cws->master();
print_message("Integrating child workspace '$child' into master workspace '$master'.");
# check if child workspace has been approved for integration
my $approval = $cws->get_approval();
if ( !$approval ) {
print_error("Internal error: can't get approval status for '$child'.", 3);
}
if ( $approval eq 'new' ) {
print_error("Child workspace '$child' is not approved for integration.", 3);
}
elsif ( $approval eq 'integrated' ) {
print_error("Child workspace '$child' is already integrated.", 3) unless $opt_force;
}
elsif ( $approval eq 'canceled' ) {
print_error("Child workspace '$child' has been canceled.", 3);
}
elsif ( $approval eq 'nominated' ) {
print_message("Child workspace '$child' is nominated for integration, proceeding ...");
}
else {
# can't happen
print_error("Internal error: can't get approval status for '$child'.", 3);
}
my ($ntotal_merged, $ntotal_new, $ntotal_removed, $ntotal_conflicts, $ntotal_alerts) =
(0, 0, 0, 0, 0);
my @failed_registrations;
foreach (@modules) {
my($nmerged, $nnew, $nremoved, $nconflicts, $nalerts, $eisfailure_ref) = integrate_module($cws, $dir, $_);
$ntotal_new += $nnew;
$ntotal_removed += $nremoved;
$ntotal_merged += $nmerged;
$ntotal_conflicts += $nconflicts;
$ntotal_alerts += $nalerts;
push @failed_registrations, @$eisfailure_ref;
}
# If some files could not be registered to EIS try again
# (EIS may have been temporarily unavailable)
my @repeated_regfailures;
foreach my $arg_ref ( @failed_registrations ) {
$cws->add_file( @$arg_ref ) or push @repeated_regfailures, $$arg_ref[0] .'/'. $$arg_ref[1];
}
print "All modules: $ntotal_new new, $ntotal_removed removed, $ntotal_merged merge(s), $ntotal_conflicts conflicts(s). $ntotal_alerts alert(s)\n";
if ( @repeated_regfailures ) {
prompt_manual_registration( $child, $master, @repeated_regfailures );
}
# set CWS status
if ( !$opt_no_set_integrated ) {
if ( $cws->set_integrated() ) {
print_message("\nSet child workspace status to: integrated.");
}
else {
print_error("Could not set child workspace status to integrated.", 0);
}
}
}
# Analyze child workspace module
sub analyze_module
{
my $cws = shift;
my $dir = shift;
my $module = shift;
print_message("========== Analyzing module '$module' ==========");
my $cvs_module = get_cvs_module($cws, $module);
if ( !$cvs_module ) {
print_error("Failure during analysis of '$module', skipping.", 0);
plog("A\t$module: analysis failed!");
return (0, 0, 0, 0, 1);
}
my $changed_files_ref = get_changed_files($cws, $cvs_module);
if ( !defined($changed_files_ref) ) {
print_warning("Analysis of module '$module' failed.");
return undef;
}
my ($master_branch_tag, $cws_branch_tag, $cws_root_tag) = $cws->get_tags();
my ($nnew, $nremoved, $nmerged, $nconflicts, $nalerts) = (0, 0, 0, 0, 0);
if ( @{$changed_files_ref} ) {
# ok we've got changed files
# to check for conflicts we check out the module on the master branch
# and update all changed files against the child workspace branch
my $save_dir;
if ( !$opt_fast ) {
STDOUT->autoflush(1);
print_message("Check out for conflict check ...");
my $co_ref = $cvs_module->checkout($dir, $master_branch_tag);
STDOUT->autoflush(0);
if ( !@{$co_ref} ) {
print_error("Was not able to checkout module '$module',", 0);
print_error("this might be caused by connection failures or authentification problems.", 0);
print_error("Please check your \$HOME/.cvspass for missing entries!", 50);
}
# save working dir for later perusal
# chdir into module
$save_dir = cwd();
if ( !chdir("$dir/$module") ) {
my $test = cwd();
if ( $test !~ /.+$dir\/$module$/) {
print_error("Can't chdir() to '$dir/$module'", 6);
}
}
}
ANALYZE: foreach my $change_ref (@{$changed_files_ref}) {
# Check against vetoed files
foreach my $veto_pattern ( keys %commit_veto_hash ) {
if ( $change_ref->[0] =~ /$veto_pattern/ ) {
next ANALYZE; # jump to next changed file
}
}
if ( !defined($change_ref->[1]) && !defined($change_ref->[2]) ) {
# removed file
print "\tR", "\t", $change_ref->[0], "\n";
$nremoved++;
}
elsif ( !defined($change_ref->[1]) ) {
# new file
print "\tN","\t", $change_ref->[0], "\t", $change_ref->[2], "\n";
$nnew++;
}
else {
# modified file
if ( $opt_fast ) {
print "\tM", "\t", $change_ref->[0], "\t",
$change_ref->[1], " -> ",
$change_ref->[2], "\n";
$nmerged++;
}
else {
my $archive = $change_ref->[0];
if ( !-e $archive ) {
# changes have been made on the CWS for
# a file which has been removed on the MWS
print "\tA", "\t",
$change_ref->[0], " file removed on MWS but changed on CWS\n";
plog("A\t$module/$change_ref->[0]: file removed on MWS but changed on CWS. Please check!");
$nalerts++;
}
my $cvs_archive = get_cvs_archive($archive);
my $rc = update_file($cvs_archive, $cws_branch_tag, $cws_root_tag);
if ( $rc eq 'merged' ) {
print "\tM", "\t", $change_ref->[0], "\t",
$change_ref->[1], " -> ",
$change_ref->[2], "\n";
$nmerged++;
}
elsif ( $rc eq 'conflict' ) {
print "\tC", "\t", $change_ref->[0], "\t",
$change_ref->[1], " -> ",
$change_ref->[2], "\n";
plog("C\t$module/$change_ref->[0]: conflict!");
$nconflicts++;
}
else {
print_error("update_file() operation failed.", 6);
}
}
}
}
# chdir back
chdir($save_dir) if( !$opt_fast );
}
# emit some statistics
my $merge_str = $opt_fast ? 'change(s)' : 'clean merge(s)';
my $stats = "'$module': $nmerged $merge_str, $nnew new, ";
$stats .= "$nremoved removed";
$stats .= $opt_fast ? '' : ", $nconflicts conflict(s), $nalerts alert(s)";
print_message($stats);
return ($nmerged, $nnew, $nremoved, $nconflicts, $nalerts);
}
# Integrate child workspace module.
sub integrate_module
{
# TODO break integrate_module() down into several routines
my $cws = shift;
my $dir = shift;
my $module = shift;
print_message("========== Integrating module '$module' ==========");
my $cvs_module = get_cvs_module($cws, $module);
if ( !$cvs_module ) {
print_error("Failure during integration of '$module', skipping.", 0);
plog("A\t$module: integration failed!");
return (0, 0, 0, 0, 1);
}
my $changed_files_ref = get_changed_files($cws, $cvs_module);
if ( !defined($changed_files_ref) ) {
print_warning("Integration of module '$module' failed.");
return undef;
}
my $child = $cws->child();
my ($master_branch_tag, $cws_branch_tag, $cws_root_tag) = $cws->get_tags();
# statistics counters
my ($nnew, $nremoved, $nmerged, $nconflicts, $nalerts) = (0, 0, 0, 0, 0);
# for error handling of EIS registrations
my @failed2register;
if ( @{$changed_files_ref} && $opt_resume ) {
# opt_resume: we already have integrated parts of this CWS
$changed_files_ref = clear_finished_files( $cws, $module, $changed_files_ref );
}
if ( @{$changed_files_ref} ) {
# ok we've got changed files
STDOUT->autoflush(1);
print_message("Checking out ...");
$cvs_module->checkout($dir, $master_branch_tag);
STDOUT->autoflush(0);
# save working dir for later perusal
my $save_dir = cwd();
# chdir into module
if ( !chdir("$dir/$module") ) {
print_error("Can't chdir() to '$dir/$module'", 0);
}
COMMIT: foreach my $change_ref (@{$changed_files_ref}) {
my $archive = $change_ref->[0];
# Check against vetoed files
foreach my $veto_pattern ( keys %commit_veto_hash ) {
if ( $archive =~ /$veto_pattern/ ) {
next COMMIT; # jump to next changed file
}
}
if ( defined($change_ref->[2]) && !-d dirname($archive) )
{
if ( defined($change_ref->[1]) ) {
}
else {
# A new file appeared in a directory which has not yet
# been added to our local CVS tree.
sanitize_cvs_hierarchy($archive);
}
}
my $cvs_archive = get_cvs_archive($archive);
# Determine the branch root of the CWS branch and the master branch
my $branch_rev = $cvs_archive->get_branch_rev($cws_branch_tag);
my $master_branch_rev = $cvs_archive->get_branch_rev($master_branch_tag);
if ( !$branch_rev ) {
# If this go wrong it's most likely due to a CVS problem
print_error("Can't determine CWS branch root, CVS problems?", 99);
}
my @merge_comments;
push(@merge_comments, get_revision_comments($cvs_archive, $branch_rev));
my $change_type;
if ( !defined($change_ref->[1]) && !defined($change_ref->[2]) ) {
# removed file
push(@merge_comments, "INTEGRATION: CWS $child ($branch_rev); FILE REMOVED\n");
$change_type = 'removed';
}
elsif ( !defined($change_ref->[1]) ) {
# new file
push(@merge_comments, "INTEGRATION: CWS $child ($branch_rev); FILE ADDED\n");
$change_type = 'new';
}
else {
# modified file
push(@merge_comments, "INTEGRATION: CWS $child ($branch_rev); FILE MERGED\n");
$change_type = 'changed';
}
# write out merge comment file
my $merge_comment_file = $archive . '.mergecomment';
if ( !open(COMMENTFILE, ">$merge_comment_file") ) {
print_error("$script_name: can't open $merge_comment_file: $!", 0);
}
print COMMENTFILE reverse @merge_comments;
close(COMMENTFILE);
# get the revision authors and taskids
my $revision_authors_ref = get_revision_authors($cvs_archive, $branch_rev);
my $revision_taskids_ref = get_revision_taskids($cvs_archive, $branch_rev);
# do the update
my $new_revision;
my $rc = update_file($cvs_archive, $cws_branch_tag, $cws_root_tag);
if ( !$rc ) {
print_error("Update operation for file '$archive' failed for unknown reasons.", 0);
plog("$module/$archive: update operation failed for unknown reasons, can't commit changes!");
}
elsif ( $rc eq 'merged' ) {
# commit merges
($rc, $new_revision) = commit_file($cvs_archive, $merge_comment_file);
unless ( $rc eq 'success' || $rc eq 'nothingcomitted' ) {
print_error("Can't commit changes to '$archive'", 0);
plog("\t$module/$archive: can't commit changes!");
next;
}
print "\tN\t$archive\n" and $nnew++ if $change_type eq 'new';
print "\tR\t$archive\n" and $nremoved++ if $change_type eq 'removed';
print "\tM\t$archive\n" and $nmerged++ if $change_type eq 'changed';
unlink($merge_comment_file) if $rc eq 'success';
}
elsif ( $rc eq 'conflict' ) {
print "\tC\t$archive\n";
plog("C\t$module/$archive: conflict!");
$nconflicts++;
# TODO: clean up this mess
# Find out what the new revision will be after the conflict has been
# solved. We are going to report it to EIS even if the commit
# has not yet been done
my $last_rev;
if ( !$master_branch_rev ) {
# master branch is head branch
$last_rev = $cvs_archive->get_head();
}
else {
my $revs_ref = $cvs_archive->get_sorted_revs();
foreach my $rev (@{$revs_ref}) {
if ( $rev =~ /^$master_branch_rev\.\d+/ ) {
$last_rev = $rev;
}
}
if ( !defined($last_rev) ) {
# no revision has ever been committed on the
# master branch => give $last_rev an artificial
# "0" revision
$last_rev = $master_branch_rev . '.0';
}
}
my @rev_field = split(/\./, $last_rev);
$rev_field[-1]++;
$new_revision = join('.', @rev_field);
}
else {
# can't happen
print_error("Internal error: update failed for unknown reasons", 0);
}
# register new revision with EIS
if ( ! $cws->add_file($module, $archive, $new_revision,
$revision_authors_ref, $revision_taskids_ref) ) {
push @failed2register, [$module, $archive, $new_revision,
$revision_authors_ref, $revision_taskids_ref];
}
}
# chdir back
chdir($save_dir);
}
# emit some statistics
print "'$module': $nnew new, $nremoved removed, $nmerged merge(s), $nconflicts conflicts(s). $nalerts alert(s)\n";
return ($nmerged, $nnew, $nremoved, $nconflicts, $nalerts, \@failed2register);
}
# Get all revision comments on child workspace branch.
sub get_revision_comments
{
my $cvs_archive = shift;
my $branch_rev = shift;
# Collect all the logging information of the revisions on the branch
my @merge_comment = ();
my $revs_ref = $cvs_archive->get_sorted_revs();
foreach my $rev (@{$revs_ref}) {
if ( $rev =~ /^$branch_rev\.\d+/ ) {
my $log_ref = $cvs_archive->get_data_by_rev()->{$rev};
my $comment = "$log_ref->{'DATE'} $log_ref->{'AUTHOR'} $rev: $log_ref->{'COMMENT'}";
if ( $log_ref !~ /^RESYNC:/ ) {
push(@merge_comment, $comment);
}
}
}
wantarray ? @merge_comment : \@merge_comment;
}
sub get_revision_authors
{
my $cvs_archive = shift;
my $branch_rev = shift;
# Collect all the authors of the revisions on the branch
my @authors;
my %authors_hash;
my $revs_ref = $cvs_archive->get_sorted_revs();
foreach my $rev (@{$revs_ref}) {
if ( $rev =~ /^$branch_rev\.\d+/ ) {
my $log_ref = $cvs_archive->get_data_by_rev()->{$rev};
$authors_hash{$log_ref->{'AUTHOR'}}++;
}
}
push(@authors, sort keys %authors_hash);
wantarray ? @authors : \@authors;
}
sub get_revision_taskids
{
my $cvs_archive = shift;
my $branch_rev = shift;
# Collect all the taskids of the revisions on the branch
my @task_ids;
my %task_ids_hash;
my $revs_ref = $cvs_archive->get_sorted_revs();
foreach my $rev (@{$revs_ref}) {
if ( $rev =~ /^$branch_rev\.\d+/ ) {
my $log_ref = $cvs_archive->get_data_by_rev()->{$rev};
my @ids = extract_taskids($log_ref->{'COMMENT'});
foreach (@ids) {
$task_ids_hash{$_}++;
}
}
}
push(@task_ids, sort keys %task_ids_hash);
wantarray ? @task_ids : \@task_ids;
}
# Extract task ids from revision comment.
sub extract_taskids
{
# Task ids can be of the form:
# #12345#,#4711# pr #12345,4711#
# Optionally task ids may be prefixed with
# 'i' for issuezilla tasks
# 'b' for for bugtraq+ tasks
# 'm' for mozilla bugzilla tasks
# 'g' for gnome bugzilla tasks
# 'e' for evolution bugzilla tasks
# We may have to cope with a bit of white space, too.
my $comment = shift;
my @ids;
my @candidates;
if ( @candidates = ($comment =~ /#([ibmge\d\s,]+)#/gi) ) {
foreach my $candidate (@candidates) {
my @field = split(/,/, $candidate);
foreach (@field) {
tr/ //d;
push(@ids, $_) if /^[ibmge]?\d+$/i ;
}
}
}
wantarray ? @ids : \@ids;
}
# Update file and report findings.
sub update_file
{
my $cvs_archive = shift;
my $cws_branch_tag = shift;
my $cws_root_tag = shift;
my $file = $cvs_archive->name();
my $merge_option = '';
if ( -e $file ) {
# find out if we need to use the '-kk' flag for merging
my ($status, $working_rev, $repository_rev, $sticky_tag, $branch_rev,
$sticky_date, $sticky_options) = $cvs_archive->status();
if ( $status eq 'unknownfailure' || $status eq 'connectionfailure' ) {
print_error("can't get status of '$file': $status", 0);
return undef;
}
$merge_option = ($sticky_options eq 'kb') ? '' : '-kk';
}
my $rc = $cvs_archive->update("$merge_option -j$cws_root_tag -j$cws_branch_tag");
if ( $rc eq 'success' ) {
return 'merged';
}
elsif ( $rc eq 'conflict' ) {
return 'conflict';
}
else {
return undef;
}
}
sub commit_file
{
my $cvs_archive = shift;
my $merge_comment_file = shift;
my ($rc, $new_revision) = $cvs_archive->commit("-F $merge_comment_file");
return ($rc, $new_revision);
}
# Returns changed files for module.
sub get_changed_files
{
my $cws = shift;
my $cvs_module = shift;
my ($master_branch_tag, $cws_branch_tag, $cws_root_tag) = $cws->get_tags();
$cvs_module->verbose(1) if (! $opt_quiet);
STDOUT->autoflush(1);
print_message("Retrieving changes ...");
my $changed_files_ref;
eval { $changed_files_ref = $cvs_module->changed_files($cws_root_tag,$cws_branch_tag) };
if ( $@ ) {
if ( $@ =~ /server died silently/ ) {
my $time_str = localtime();
print_error("The CVS server has died silently on 'cvs rdiff' operation.", 0);
print_error("Please inform Release Engineering!", 0);
print_error("Time of failure: '$time_str'", 99);
}
else {
croak($@); # rethrow
}
}
STDOUT->autoflush(0);
return $changed_files_ref;
}
# For repeated integrations (only to be done in case of crashes):
# clear files list, avoid integrating twice
sub clear_finished_files
{
my $cws = shift;
my $module = shift;
my $files_ref = shift;
my ($integrated_files_ref, %integrated_files, @remaining_files);
$integrated_files_ref = $cws->files();
foreach ( @$integrated_files_ref ) {
my @filedata = split /,/, $_;
next unless ( $filedata[0] eq $module );
if ( $filedata[1] ) {
$integrated_files{$filedata[1]} ++;
}
}
foreach my $change_ref (@{$files_ref}) {
push @remaining_files, $change_ref unless $integrated_files{$$change_ref[0]};
}
if ( my $n_in_EIS = keys %integrated_files ) {
print_message("skipping $n_in_EIS file(s): already integrated\n");
}
return \@remaining_files;
}
# New files may be in new CVS subdirectories.
# Check if the CVS subdir is available or
# add it to the local CVS tree
sub sanitize_cvs_hierarchy
{
my $file = shift;
my $cvs_dir = dirname($file);
return if $cvs_dir eq '.'; # no need to check current dir
my @elements = split(/\//, $cvs_dir);
my $save_dir = cwd();
my $config = CwsConfig->get_config();
my $cvs_binary = $config->cvs_binary();
foreach ( @elements ) {
if ( ! -d $_ ) {
my $rc = mkdir($_);
print_error("can create directory '$_': $!", 9) unless $rc;
# TODO use a Cvs method for this
system("$cvs_binary add $_ > /dev/null 2>&1 ");
}
if ( !chdir($_) ) {
print_error("Can't chdir() to '$_'", 9);
}
}
# chdir back
chdir($save_dir);
}
# Retrieve CvsModule object for passed module.
sub get_cvs_module
{
my $cws = shift;
my $module = shift;
my $cvs_module = CvsModule->new();
my ($method, $vcsid, $server, $repository);
if ( defined($log) ) {
($method, $vcsid, $server, $repository) = get_cvs_root($cws, $module);
}
else {
# For now just take the configured OOo sever. Later we might implement a mechanism were
# only known OOo modules are fetched from the OOo server, the rest from a local
# server
my $config = CwsConfig::get_config();
($method, $vcsid, $server, $repository) = ($config->get_cvs_server_method(),
$config->get_cvs_server_id(),
$config->get_cvs_server(),
$config->get_cvs_server_repository());
}
return undef if !($method && $vcsid && $server && $repository);
$cvs_module->module($module);
$cvs_module->cvs_method($method);
$cvs_module->vcsid($vcsid);
$cvs_module->cvs_server($server);
$cvs_module->cvs_repository($repository);
return $cvs_module;
}
# Return Cvs object for passed file.
sub get_cvs_archive
{
my $file = shift;
my $cvs_archive = Cvs->new();
$cvs_archive->name($file);
return $cvs_archive;
}
# Find out which CVS server holds the module, returns
# the elements of CVSROOT.
sub get_cvs_root
{
require EnvHelper; import EnvHelper;
my $cws = shift;
my $module = shift;
my $master = $cws->master();
my $vcsid = $ENV{VCSID};
if ( !$vcsid ) {
print_error("Can't determine VCSID. Please use setsolar.", 5);
}
my $workspace_db = EnvHelper::get_workspace_db();
if ( !$workspace_db ) {
print_error("Can't load workspace database.", 4);
}
my $key = "$master/drives/o:/projects/$module/scs";
my $cvsroot = $workspace_db->get_value($key);
if ( !$cvsroot ) {
print_error("No such module '$module' for '$master' in workspace database.", 0);
return (undef, undef, undef, undef);
}
my ($dummy1, $method, $user_at_server, $repository) = split(/:/, $cvsroot);
$repository =~ s/^\d*//;
my ($dummy2, $server) = split(/@/, $user_at_server);
if ( ! ($method && $server && $repository ) ) {
print_error("Can't determine CVS server for module '$module'.", 0);
return (undef, undef, undef, undef);
}
return ($method, $vcsid, $server, $repository);
}
sub plog
{
my $message = shift;
push(@problem_log, $message);
}
sub print_plog
{
if ( @problem_log ) {
print_message("========== Problem Log ==========");
foreach ( @problem_log ) {
print "\t$_\n";
}
print_message("========== End Problem Log ==========");
}
}
sub auto_int
{
my $ai_cws = shift;
my $ai_dir = shift;
my @ai_modules = @_;
print "\n**** starting with automatic integration after successful analyses.****\n" if (! $opt_quiet);
# ... more stuff
my $conflicts = 1;
my $alarms = 1;
($conflicts,$alarms) = analyze($ai_cws, $ai_dir, @ai_modules);
$alarms = &check_alarms($alarms) if ($alarms > 0);
if ( $conflicts + $alarms == 0 ) {
print "no conflicts or alarms are shown during analyses.\n" if (! $opt_quiet);
print "starting integration...\n" if (! $opt_quiet);
# remove directory
if ( $ai_dir ne cwd() )
{
system("rm -rf $ai_dir");
print_error("Can't remove directory '$ai_dir'", 6) if (-e $ai_dir );
mkdir ($ai_dir,0775);
print_error("Can't mkdir() to '$ai_dir'", 6) if ( !-e $ai_dir );
} else
{
system("rm -rf *");
}
integrate($ai_cws, $ai_dir, @ai_modules);
my @final_log = &check_status_plog($ai_dir); # can't commit changes
if ( scalar(@final_log) > 0 ) {
print "====================== Final Problem Log =====================\n";
foreach my $problem(@final_log)
{
print "$problem\n"
}
print "==============================================================\n";
} else
{
print "\n**************** All can't commit changes problems are resolved. ****************\n";
print "**************** No further problems are known ****************\n";
}
} else
{
&print_plog();
print STDERR "Conflicts and/or alarms occured during analysis.\n";
print STDERR "Can't continue...... Bye!\n";
}
$log->end_log_extended($script_name,$vcsid,"success");
exit;
}
sub prompt_manual_registration
{
return unless defined($log);
my $cws_name = shift;
my $mws_name = shift;
my @files = @_;
print_warning( "Could not register all files to EIS. Please manually call");
foreach my $file ( @files ) {
print STDERR "\tperl \$COMMON_ENV_TOOLS/cwsaddfile.pl -c $cws_name -m $mws_name $file\n";
}
}
sub check_alarms
{
my $alarms = shift;
foreach my $line(@problem_log)
{
if ($line =~ /def\sfile\sdetected/g)
{
print "ignoreing def file alarm....\n";
$alarms--;
}
}
return $alarms;
}
sub check_status_plog
{
# cvs status file -> "up to date"? -> ok!
my $ai_dir = shift;
my $problem;
my @final_problem_log = ();
print "Checking CVS status of files which can't be commited.....\n" if (! $opt_quiet);
foreach $problem(@problem_log) { # @problem_log is global defined!
my @result = split(":",$problem);
if ( $result[1] =~ "can't commit changes!" ) {
$result[0] =~ s/^\s+//; # remove leading blanks
my @result2 = split("/",$result[0]);
my $module = $result2[0]; # get module name
$result[0] =~ s/^$module\///g; # get rest of the file path
if (!chdir("$ai_dir/$module") ) {
my $test = cwd();
print STDERR "Check Status: CWD=$test\n";
if ( $test !~ /.+$dir\/$module$/) {
print_error("Check Status: Can't chdir() to '$dir/$module'", 6);
}
}
my $cvs_archive = get_cvs_archive($result[0]);
my ($status, $working_rev, $repository_rev, $sticky_tag, $branch_rev,
$sticky_date, $sticky_options) = $cvs_archive->status();
if ( $status =~ /Up-to-date/ ) { # OK!
next;
} else
{
push(@final_problem_log,($problem . " CVS Status:$status"));
}
} else
{
# conflicts and other problems
push(@final_problem_log, $problem);
}
}
return @final_problem_log;
} ##check_status
sub print_message
{
my $message = shift;
print "$message\n";
return;
}
sub print_warning
{
my $message = shift;
print STDERR "$script_name: ";
print STDERR "WARNING: $message\n";
return;
}
sub print_error
{
my $message = shift;
my $error_code = shift;
print STDERR "$script_name: ";
print STDERR "ERROR: $message\n";
if ( $error_code ) {
print STDERR "\nFAILURE: $script_name aborted.\n";
$log->end_log_extended($script_name,$vcsid,$message) if defined($log);
exit($error_code);
}
return;
}
sub usage
{
if ( $mode eq 'cwsintegrate' ) {
print STDERR "Usage: cwsintegrate [-h] [-d dir] [-q] [-F] <all|module> ... \n";
print STDERR "Integrate one or more child workspace modules into master workspace.\n";
print STDERR "Options:\n";
print STDERR "\t-h \tprint this help\n";
print STDERR "\t-d dir\tscratch space\n";
print STDERR "\t-q \tdo not set child workspace status to 'integrated'\n";
print STDERR "\t-F\tdo integration even if status is already 'integrated'\n";
print STDERR "\t-A\trun cwsanalyze previously and integrate automatically when no conflicts or alerts are shown.\n";
print STDERR "\t \tCheck files with 'can't commit changes' message after integration automatically.\n";
print STDERR "\t-z\tminimial output (quiet mode)\n";
}
else {
print STDERR "Usage: cwsanalyze [-h] [-d dir] [-n] <all|module> ... \n";
print STDERR "Analyze one or more child workspace modules.\n";
print STDERR "Options:\n";
print STDERR "\t-h \tprint this help\n";
print STDERR "\t-d dir\tscratch space\n";
print STDERR "\t-n\tdisable conflict check (no need for checkout)\n";
print STDERR "The -d and -n options are mutually exclusive.\n";
}
}