office-gobmx/solenv/bin/cwsadd.pl

:
eval 'exec perl -wS $0 ${1+"$@"}'
    if 0;
#*************************************************************************
#
#   $RCSfile: cwsadd.pl,v $
#
#   $Revision: 1.6 $
#
#   last change: $Author: hr $ $Date: 2004-12-10 18:02:21 $
#
#   The Contents of this file are made available subject to the terms of
#   either of the following licenses
#
#          - GNU Lesser General Public License Version 2.1
#          - Sun Industry Standards Source License Version 1.1
#
#   Sun Microsystems Inc., October, 2000
#
#   GNU Lesser General Public License Version 2.1
#   =============================================
#   Copyright 2000 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
#
#
#   Sun Industry Standards Source License Version 1.1
#   =================================================
#   The contents of this file are subject to the Sun Industry Standards
#   Source License Version 1.1 (the "License"); You may not use this file
#   except in compliance with the License. You may obtain a copy of the
#   License at http://www.openoffice.org/license.html.
#
#   Software provided under this License is provided on an "AS IS" basis,
#   WITHOUT WARRUNTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING,
#   WITHOUT LIMITATION, WARRUNTIES THAT THE SOFTWARE IS FREE OF DEFECTS,
#   MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE, OR NON-INFRINGING.
#   See the License for the specific provisions governing your rights and
#   obligations concerning the Software.
#
#   The Initial Developer of the Original Code is: Sun Microsystems, Inc..
#
#   Copyright: 2000 by Sun Microsystems, Inc.
#
#   All Rights Reserved.
#
#   Contributor(s): _______________________________________
#
#
#
#*************************************************************************

#
# cwsadd.pl - add modules to child workspaces
#

use strict;
use Getopt::Long;
use Cwd;
use IO::Handle;
use File::Copy;

#### 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 CwsConfig;

eval { require Logging; import Logging; };
# $log variable is only defined in SO environment...
my $log = undef;
$log = Logging->new() if (!$@);
eval { require CopyPrj; import CopyPrj; };
use CvsModule;

######### Interrupt handler #########
 $SIG{'INT'} = 'INT_handler' if defined($log);

#### script id #####

( my $script_name = $0 ) =~ s/^.*\b(\w+)\.pl$/$1/;

my $script_rev;
my $id_str = ' $Revision: 1.6 $ ';
$id_str =~ /Revision:\s+(\S+)\s+\$/
  ? ($script_rev = $1) : ($script_rev = "-");

print "$script_name -- version: $script_rev\n";

#### global #####

my $force_checkout = '';
my $allow_modified = 0;
my $is_debug = 0;
my $opt_dir  = '';  # dir option
my $vcsid = "unknown";
my $add_output_tree = 1;
my $keep_output_trees = 0;
my $force_output_tree_copy = 0;
my @found_platforms = ();

my @args_bak = @ARGV;
      # store the @ARGS here for logging

# module names to be rejected
my @invalid_names =
qw(common common.pro cvs cws wntmsci unxsols unxsoli unxlngi unxlngp macosxp);


#### main #####
my $parameter_list = $log->array2string(";",@args_bak) if (defined $log);

my @modules = parse_options();
my ($dir, $cws) = get_and_verify_cws();
my @modules_to_add = check_modules($cws, @modules);
my $workspace_db;
if ( @modules_to_add ) {
    if (defined $log) {
        require EnvHelper; import EnvHelper;
        $workspace_db = EnvHelper::get_workspace_db();
        @modules_to_add = copy_modules($cws, $dir, $workspace_db, @modules_to_add);
    } else {
        @modules_to_add = update_modules($cws, $dir, @modules_to_add);
    };
    if ( @modules_to_add ) {
        my @registered_modules = ();
        my $success = 0;
        my $module;
        foreach (@modules_to_add) {
            $module = $_;
            $success = branch_module($cws, $dir, $module);
            last unless $success;
            $success = register_module($cws, $workspace_db, $module);
            last unless $success;
            push(@registered_modules, $module);
        }
        if ( @registered_modules ) {
            my $modules_str = join(", ", @registered_modules);
            my $child = $cws->child();
            print "\n";
            print_message("Summary:");
            print_message("Sucessfully added and registered module(s) '$modules_str'.");
        }
        if ( !$success ) {
            print_error("Adding and/or registering module '$module' failed!", 5);
        }
    }
}

$log->end_log_extended($script_name,$vcsid,"success") if (defined $log);
exit(0);

#### subroutines ####

#
# Subroutine updates module
#
sub update_modules {
    my ($cws, $stand_dir, @modules_to_update) = @_;
    my (@updated_modules, @rejected_modules);
    my $master_tag = $cws->get_master_tag();
    foreach my $module (@modules_to_add) {
        my $cvs_module = CvsModule->new();
        $cvs_module->module($module);
        print "\tUpdating '$module' ...\n";
        my $result = $cvs_module->update($stand_dir, $master_tag);
        my ($updated, $merged, $conflicts) =
            $cvs_module->handle_update_information($result);
        if ( ( $merged && ! $allow_modified ) || $conflicts ) {
            push(@rejected_modules, $module);
            next;
        };
        push(@updated_modules, $module);
    };
    if (@rejected_modules) {
        print_warning("Found conflicts and/or locally modified files in the following modules:");
        print STDERR "$_\n" foreach (@rejected_modules);
        print_warning("These modules will not be added to CWS. Clean up and try adding them again.");
    };
    return @updated_modules;
};

sub get_and_verify_cws
{
    # get current child workspace from environment
    my $childws  = $ENV{CWS_WORK_STAMP};
    my $masterws = $ENV{WORK_STAMP};

    if ( !defined($childws) || !defined($masterws) ) {
        print_error("Can't determine child workspace environment.\n"
                    . "Please initialize environment with setsolar ...", 1);
    }

    # get destination directory for modules to add
    my $dir = $ENV{SRC_ROOT};

    if ( !defined($dir) )
    {
        print_error("Need to get destination from SOURCE_ROOT - but it's not defined!",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 ($dir, $cws);
}

sub parse_options
{
    # parse options and do some sanity checks
    # returns freshly allocated Cws reference

    # linking and unlinking requires UNIX
    if ( $^O =~ "MSWin32" )
    {
        print_error("Sorry! not for non-cygwin Windows environment",2);
    }
    my $help;
    my $success = GetOptions(
                '-h' => \$help,
                '-a' => \$force_checkout,
                '-f' => \$allow_modified,
                '-o' => \$force_output_tree_copy,
                '-k' => \$keep_output_trees
            );
    if ( $force_checkout && $force_output_tree_copy ) {
        print_error ("Can't copy output trees with checkout forced!", 2);
    }
    if ( $keep_output_trees && $force_output_tree_copy ) {
        print_error ("Can't copy output trees but keep existing...", 2);
    }
    if ( $help || !$success || $#ARGV < 0 ) {
        usage();
        exit(1);
    }

    return @ARGV;
}

sub check_modules
{
    # check if modules are registered with child workspace
    # returns list of modules which can be added

    my $cws     = shift;
    my @modules = @_;

    my @registered_modules = $cws->modules();

    # create hash for easier searching
    my %registered_modules_hash = ();
    for (@registered_modules) {
        $registered_modules_hash{$_}++;
    }
    my %invalid_names_hash = ();
    for (@invalid_names) {
        $invalid_names_hash{$_}++;
    }

    my $config = CwsConfig->get_config();
    my $cvs_module = CvsModule->new();
    $cvs_module->cvs_method($config->get_cvs_server_method());
    $cvs_module->vcsid($config->get_cvs_server_id());
    $cvs_module->cvs_server($config->get_cvs_server());
    $cvs_module->cvs_repository($config->get_cvs_server_repository());
    my @new_modules = ();
    my %cvs_aliases = $cvs_module->get_aliases_hash();
    foreach (@modules) {
        if ( $_ =~ /[\s\t\|\$\(\)\[\]\{\\}]/ || exists $invalid_names_hash{lc($_)} ) {
            print_error("'$_' is an invalid module name.", 3);
        }
        if ( exists $registered_modules_hash{$_} ) {
            print_warning("Module '$_' already registered, skipping.");
            next;
        };
        if (!defined($log) && !defined $cvs_aliases{$_}) {
            print_error("There is no such module alias '$_'.", 3);
        };
        push(@new_modules, $_);
    }

    return @new_modules;
}

sub copyprj_module_sourcetree
{
    my $module_name = shift;
    my $src_dest = shift;
    print "copyprj $module_name\n";

    # hash, that should contain all the
    # data needed by CopyPrj module
    my %ENVHASH = ();
    my %platforms_to_copy = ();
    $ENVHASH{'platforms_hash'} = \%platforms_to_copy;
    if ( $add_output_tree && !$force_checkout ) {
        $platforms_to_copy{$_}++ foreach (@found_platforms);
    };
    my %projects_to_copy = ();
    $ENVHASH{'projects_hash'} = \%projects_to_copy;
    $ENVHASH{'no_otree'} = 1; # does this match with %platforms_to_copy???
    $ENVHASH{'no_path'} = 1;
    $ENVHASH{'only_otree'} = 0;
    $ENVHASH{'only_update'} = 1;
    $ENVHASH{'last_minor'} = 0;
    $ENVHASH{'spec_src'} = 0;
    $ENVHASH{'dest'} = "$src_dest";
    $ENVHASH{'prj_to_copy'} = '';
    $ENVHASH{'i_server'} = '';
    $ENVHASH{'current_dir'} = cwd();
    $ENVHASH{'remote'} = '';
    $ENVHASH{'force_checkout'} = 1 if ($force_checkout);

    $projects_to_copy{$module_name}++;

    CopyPrj::copy_projects(\%ENVHASH);

};

sub copy_modules
{
    # copy modules from master workspace into child workspace
    my $cws          = shift;
    my $dir          = shift;
    my $workspace_db = shift;
    my @modules      = @_;

    my $masterws = $cws->master();
    my $childws  = $cws->child();
    my $milestone  = $cws->milestone();

    # ause: Deine Spielwiese
    my $result;
    my @success_modules = ();

    my $workspace = $workspace_db->get_key($masterws);
    if ( !$workspace ) {
        print_error("Master workspace '$masterws' not found in workspace database.", 3);
    }

    my $wslocation = $workspace_db->get_value($masterws."/Drives/o:/UnixVolume");
    if ( !defined($wslocation) ) {
        print_error("Location of master workspace '$masterws' not found in workspace database.", 3);
    }

    print "$wslocation\n" if $is_debug;

    my $source_root = $ENV{SOURCE_ROOT};
    if ( !defined( $source_root )) {
        print_error("SOURCE_ROOT not defined! Please setup a valid environment for CWS \"$childws\"", 1);
    }
    my $cws_solver = "$source_root/$masterws";

    my $start_dir = getcwd();
    $result = chdir($dir);
    if ( !$result ) {
        print_error("Cannot change to $dir!", 1);
    }

    # assume that every valid platform on child "solver" has to be copied
    $result = opendir( SOLVER, "$cws_solver");
    if ( !$result ){ print_error ("Root dir of child workspace not accessible: $!", 1) };
    my @found_dirs = readdir( SOLVER );
    closedir( SOLVER );

    # hack to get the milestone :-(((((
    if ( ! defined($milestone))
    {
        $milestone = $ENV{UPDMINOR};
    }
    if ( $#found_dirs )
    {
        foreach my $dir_candidate ( @found_dirs )
        {
            if ( -d "$cws_solver/$dir_candidate/inc.".$milestone )
            {
                push @found_platforms, $dir_candidate;
            }
        }
    }
    # preparing pseudo environment for copyprj
    $ENV{SRC_ROOT}="$wslocation/$masterws/src.$ENV{UPDMINOR}";

    print "$ENV{SRC_ROOT}\n" if ( $is_debug );
    print "working dir: ".getcwd()."\n" if ( $is_debug );
    foreach my $one_module (@modules) {
        # do some snity checks for this module
        if ( -e "$one_module.lnk" && -e "$one_module" )
        {
            print_error("Duplicate representation of module $one_module ($one_module.lnk $one_module)", 0);
            print_error("Please clean up!", 0);
            print_error("Will NOT add module $one_module to child workspace!", 0);
            # fail for this module
            next;
        }
        if ( -e "$one_module.backup.lnk" || -e "$one_module.backup" )
        {
            print_error("Backup of module $one_module already exists.", 0);
            print_error("Please clean up!", 0);
            print_error("Will NOT add module $one_module to child workspace!", 0);
            # fail for this module
            next;

        }

        $result = 0;
        $result = rename($one_module, "$one_module.backup.lnk") if ( -l $one_module );
        if ( ! -l $one_module && -e $one_module ) {
            $result ||= rename($one_module, "$one_module.backup");
            # if it is no link, assume incompatible build
            # -> don't copy output tree unless required
            $add_output_tree = 0 if ( !$force_output_tree_copy );
        }
        $result ||= rename("$one_module.lnk", "$one_module.backup.lnk") if ( -e "$one_module.lnk" );
        $result = 0 if ( -e $one_module || -e "$one_module.lnk" );
        if ( ! $result )
        {
            print_error("Couldn't backup existing module $one_module before copying", 0);
            print_error("Will NOT add module $one_module to child workspace!", 0);
            # fail for this module
            next;
        }

        # now copy sources
        $result = copyprj_module_sourcetree( $one_module, "." );
        if ( $result )
        {
            if ( -d $one_module )
            {
                $result = rename("$one_module", "$one_module.failed");
                $result = system("rm -rf $one_module.failed");
            }
            print_error("Couldn't copy module $one_module, restoring previous.", 0);
            if ( -e "$one_module.backup" )
            {
                $result = rename("$one_module.backup", $one_module);
            }
            else
            {
                $result = rename("$one_module.backup.lnk", "$one_module.lnk");
            }
            print_error("Restoring link for $one_module failed! Cleanup is in your hands now", 1) if ( ! $result );
            # fail for this module
            next;
        }

        # remove backuped link
        unlink("$one_module.backup.lnk") if -l "$one_module.backup.lnk";

        # or backuped directory...
        if ( -d "$one_module.backup" )
        {
            my $keep_this_module = 0;
            if ( $^O =~ "MSWin32" || $^O =~ "cygwin" )
            {
                print_error("Sorry! not for windows, nobody should ever get here!",2);
            }
            if ( $keep_output_trees ) {
                # copy output trees from backup to added module
                foreach my $i ( @found_platforms ) {

                    if ( ! move "$one_module.backup/$i", "$one_module/$i" ) {
                        print_warning("Could not keep \"$one_module/$i\" autommatically.");
                        print_warning("Keeping backuped module \"$one_module.back\" to allow manual copying...");
                        $keep_this_module = 1;
                    }
                }
            }
            if ( ! $keep_this_module ) {
                $result = system("rm -rf $one_module.backup");
                print_warning("Couldn't remove backuped module \"$one_module.backup\".") if $result;
            }
        }

        # insert module in list of successfull copied modules
        push(@success_modules, $one_module);
    }

    chdir($start_dir);

#    return my @empty = (); # ause - disable all further steps
    return @success_modules;
}

sub branch_module
{
    # tag modules with cws branch cws root tag
    my $cws          = shift;
    my $dir          = shift;
    my $module       = shift;

    my ($cws_master_tag, $cws_branch_tag, $cws_root_tag) = $cws->get_tags();

    # Sanity check
    print "operating on $dir/$_\n" if $is_debug;
    if ( -S "$dir/$module" || ! -d "$dir/$module" ) {
        print_error("Can't find physical copy of module '$module'", 4);
    }

    STDOUT->autoflush(1);
    print_message("Tagging module '$module'.");
    my $cvs_module = CvsModule->new();
    $cvs_module->module($module);
    $cvs_module->verbose(1);

    print_message("Tag with branch tag '$cws_branch_tag'.");
    my ($branched_files, $branch_errors) = $cvs_module->tag($dir, $cws_branch_tag, '-b');
    if ( $branched_files < 1 ) {
        print_error("Tagging module '$module' failed.", 0);
        return 0;
    }
    if ( $branch_errors > 0 ) {
        print_error(cleanup_tags_msg($module), 0);
        return 0;
    }
    print_message("Tagged $branched_files files in module '$module' with branch tag.");

    print_message("Tag with tag '$cws_root_tag'.");
    my ($tagged_files, $anchor_errors) = $cvs_module->tag($dir, $cws_root_tag);
    if ( $tagged_files < 1 || $anchor_errors > 0
            || $branched_files != $tagged_files )
    {
        print_error(cleanup_tags_msg($module), 0);
        return 0;
    }
    print_message("Tagged $tagged_files files in module '$module'.");

    print_message("Updating module '$module' to branch '$cws_branch_tag'.");
    my @dirs = $cvs_module->update($dir, $cws_branch_tag);
    if ( $#dirs < 0 ) {
        print_error("Updating module '$module' to branch '$cws_branch_tag' failed.\n", 0);
        return 0;
    }
    STDOUT->autoflush(0);
    return 1;
}

sub cleanup_tags_msg
{
    my $module = shift;
    my ($cws_master_tag, $cws_branch_tag, $cws_root_tag) = $cws->get_tags();

    my $msg = "Tagging module '$module' failed partly. Can't continue.\n";
    $msg .= "Please remember to manually remove the tags '$cws_branch_tag' and '$cws_root_tag'\n";
    $msg .= "from module '$module' before retrying the operation!";

    return $msg;
}

# Register module with EIS.
sub register_module
{
    my $cws          = shift;
    my $workspace_db = shift;
    my $module       = shift;

    my $public = 1;

    # find out if module has public flag
    my $master = $cws->master();
    if (defined $log) {
        my $key = "$master/Drives/o:/Projects/$module/SCS";
        my $scs = $workspace_db->get_value($key);

        if ( !defined($scs) ) {
            print_error("Can't find module '$module' in workspace db", 0);
            return 0;
        }

        # FIXME - this really shouldn't be hard coded
        if ( $scs !~ /tunnel/ ) {
            $public = 0;
        }
    }

    my $success = $cws->add_module($module, $public);
    if ( !$success ) {
        print_error("Can't register module '$module' with EIS!", 0);
        return 0;
    }
    print_message("Succesfully registered module '$module'.");
    return 1;
}

sub print_message
{
    my $message     = shift;

    print "$script_name: ";
    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
{
    print STDERR "Usage: cwsadd [-h] [-a] [-f ] [-o|-k] <module> ... \n";
    print STDERR "Add one or more modules to child workspace.\n";
    print STDERR "Options:\n";
    print STDERR "    -a    use cvs checkout instead of copying\n";
    print STDERR "    -f    incorporate modified files into cws\n";
    print STDERR "    -o    force copying output trees (in copy mode only)\n";
    print STDERR "    -k    keep existing output trees\n";
    print STDERR "    -h    print this help\n";

}