[Libreoffice-commits] .: solenv/bin
Jan Holesovsky
kendy at kemper.freedesktop.org
Tue Oct 19 08:48:37 PDT 2010
solenv/bin/cws | 6
solenv/bin/cws.btm | 11
solenv/bin/cws.pl | 2068 --------------------------------------
solenv/bin/cwsattach | 7
solenv/bin/cwsattach.btm | 11
solenv/bin/cwsattach.pl | 220 ----
solenv/bin/cwscreate | 6
solenv/bin/cwstestresult | 7
solenv/bin/cwstestresult.btm | 11
solenv/bin/cwstestresult.pl | 192 ---
solenv/bin/cwstouched | 6
solenv/bin/cwstouched.btm | 11
solenv/bin/cwstouched.pl | 151 --
solenv/bin/cwstouched.py | 111 --
solenv/bin/modules/Cws.pm | 2153 ----------------------------------------
solenv/bin/modules/CwsConfig.pm | 576 ----------
16 files changed, 5547 deletions(-)
New commits:
commit c590e36dd0879217b5d49fa6e192a312461663d2
Author: Jan Holesovsky <kendy at suse.cz>
Date: Tue Oct 19 17:47:40 2010 +0200
Get rid of the CWS tools, not necessary.
diff --git a/solenv/bin/cws b/solenv/bin/cws
deleted file mode 100755
index e8bcf50..0000000
--- a/solenv/bin/cws
+++ /dev/null
@@ -1,6 +0,0 @@
-#!/bin/sh
-if [ x${SOLARENV}x = xx ]; then
- echo No environment found, please use 'configure'
- exit 1
-fi
-exec perl -w $SOLARENV/bin/cws.pl "$@"
diff --git a/solenv/bin/cws.btm b/solenv/bin/cws.btm
deleted file mode 100644
index 31bff3a..0000000
--- a/solenv/bin/cws.btm
+++ /dev/null
@@ -1,11 +0,0 @@
- at echo off
-iff "%SOLARENV%" == "" then
- echo No environment found, please use 'configure' or 'setsolar'
- goto end
-endiff
-iff "%PERL%" == "" then
- call perl5 -I%SOLARENV%\bin\modules %SOLARENV%\bin\cws.pl %1&
-else
- call %PERL% -I%SOLARENV%\bin\modules %SOLARENV%\bin\cws.pl %1&
-endiff
-:end
diff --git a/solenv/bin/cws.pl b/solenv/bin/cws.pl
deleted file mode 100644
index f241ea0..0000000
--- a/solenv/bin/cws.pl
+++ /dev/null
@@ -1,2068 +0,0 @@
-#!/usr/bin/perl -w
-#*************************************************************************
-#
-# DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
-#
-# Copyright 2000, 2010 Oracle and/or its affiliates.
-#
-# OpenOffice.org - a multi-platform office productivity suite
-#
-# This file is part of OpenOffice.org.
-#
-# OpenOffice.org is free software: you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License version 3
-# only, as published by the Free Software Foundation.
-#
-# OpenOffice.org 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 version 3 for more details
-# (a copy is included in the LICENSE file that accompanied this code).
-#
-# You should have received a copy of the GNU Lesser General Public License
-# version 3 along with OpenOffice.org. If not, see
-# <http://www.openoffice.org/license.html>
-# for a copy of the LGPLv3 License.
-#
-#*************************************************************************
-
-#*************************************************************************
-#
-# cws.pl - wrap common childworkspace operations
-#
-use strict;
-use Getopt::Long;
-use File::Basename;
-use File::Path;
-use File::Copy;
-use Cwd;
-use Benchmark;
-
-#### 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");
-}
-use lib (@lib_dirs);
-
-use Cws;
-
-#### script id #####
-
-( my $script_name = $0 ) =~ s/^.*\b(\w+)\.pl$/$1/;
-
-#### globals ####
-
-# TODO: replace dummy vales with actual source_config migration milestone
-my $ooo320_source_config_milestone = 'm999';
-
-# valid command with possible abbreviations
-my @valid_commands = (
- 'help', 'h', '?',
- 'create',
- 'fetch', 'f',
- 'query', 'q',
- 'task', 't',
- 'eisclone',
- 'setcurrent'
- );
-
-# list the valid options to each command
-my %valid_options_hash = (
- 'help' => ['help'],
- 'create' => ['help', 'milestone', 'migration', 'hg'],
- 'fetch' => ['help', 'milestone', 'childworkspace','platforms','quiet',
- 'onlysolver'],
- 'query' => ['help', 'milestone','masterworkspace','childworkspace'],
- 'task' => ['help'],
- 'setcurrent' => ['help', 'milestone'],
- 'eisclone' => ['help']
- );
-
-my %valid_commands_hash;
-for (@valid_commands) {
- $valid_commands_hash{$_}++;
-}
-
-# set by --debug switch
-my $debug = 0;
-# set by --profile switch
-my $profile = 0;
-
-
-#### main ####
-
-my ($command, $args_ref, $options_ref) = parse_command_line();
-dispatch_command($command, $args_ref, $options_ref);
-exit(0);
-
-#### subroutines ####
-
-# Parses the command line. does prelimiary argument and option verification
-sub parse_command_line
-{
- if (@ARGV == 0) {
- usage();
- exit(1);
- }
-
- my %options_hash;
- Getopt::Long::Configure ("no_auto_abbrev", "no_ignorecase");
- my $success = GetOptions(\%options_hash, 'milestone|m=s',
- 'masterworkspace|master|M=s',
- 'hg',
- 'migration',
- 'childworkspace|child|c=s',
- 'debug',
- 'profile',
- 'commit|C',
- 'platforms|p=s',
- 'onlysolver|o',
- 'quiet|q',
- 'help|h'
- );
-
- my $command = shift @ARGV;
-
- if (!exists $valid_commands_hash{$command}) {
- print_error("Unkown command: '$command'\n");
- usage();
- exit(1);
- }
-
- if ($command eq 'h' || $command eq '?') {
- $command = 'help';
- }
- elsif ($command eq 'f') {
- $command = 'fetch';
- }
- elsif ($command eq 'q') {
- $command = 'query';
- }
- elsif ($command eq 't') {
- $command = 'task';
- }
-
- # An unkown option might be accompanied with a valid command.
- # Show the command specific help
- if ( !$success ) {
- do_help([$command])
- }
-
- verify_options($command, \%options_hash);
- return ($command, \@ARGV, \%options_hash);
-}
-
-# Verify options against the valid options list.
-sub verify_options
-{
- my $command = shift;
- my $options_ref = shift;
-
- my $valid_command_options_ref = $valid_options_hash{$command};
-
- my %valid_command_options_hash;
- foreach (@{$valid_command_options_ref}) {
- $valid_command_options_hash{$_}++;
- }
-
- # check all specified options against the valid options for the sub command
- foreach (keys %{$options_ref}) {
- if ( /debug/ ) {
- $debug = 1;
- next;
- }
- if ( /profile/ ) {
- $profile = 1;
- next;
- }
- if (!exists $valid_command_options_hash{$_}) {
- print_error("can't use option '--$_' with subcommand '$command'.", 1);
- }
- }
-
-}
-
-# Dispatches to the do_xxx() routines depending on command.
-sub dispatch_command
-{
- my $command = shift;
- my $args_ref = shift;
- my $options_ref = shift;
-
- no strict 'refs';
- &{"do_".$command}($args_ref, $options_ref);
-}
-
-# Returns the global cws object.
-BEGIN {
-my $the_cws;
-
- sub get_this_cws {
- if (!defined($the_cws)) {
- $the_cws = Cws->new();
- return $the_cws;
- }
- else {
- return $the_cws;
- }
- }
-}
-
-# Returns a list of the master workspaces.
-sub get_master_workspaces
-{
- my $cws = get_this_cws();
- my @masters = $cws->get_masters();
-
- return wantarray ? @masters : \@masters;
-}
-
-# Checks if master argument is a valid MWS name.
-BEGIN {
- my %master_hash;
-
- sub is_master
- {
- my $master_name = shift;
-
- if (!%master_hash) {
- my @masters = get_master_workspaces();
- foreach (@masters) {
- $master_hash{$_}++;
- }
- }
- return exists $master_hash{$master_name} ? 1 : 0;
- }
-}
-
-# Fetches the current CWS from environment, returns a Cws object
-sub get_cws_from_environment
-{
- my $child = $ENV{CWS_WORK_STAMP};
- my $master = $ENV{WORK_STAMP};
-
- if ( !$child ) {
- print_error("Environment variable CWS_WORK_STAMP is not set. Please set it to your CWS name.", 2);
- }
-
- if ( !$master ) {
- print_error("Environment variable WORK_STAMP is not set. Please set it to the MWS name.", 2);
- }
-
- my $cws = get_this_cws();
- $cws->child($child);
- $cws->master($master);
-
- # Check if we got a valid child workspace.
- my $id = $cws->eis_id();
- if ( $debug ) {
- print STDERR "CWS-DEBUG: ... master: $master, child: $child, $id\n";
- }
- if ( !$id ) {
- print_error("Child workspace $child for master workspace $master not found in EIS database.", 2);
- }
- return ($cws);
-}
-
-# Fetches the CWS by name, returns a Cws object
-sub get_cws_by_name
-{
- my $child = shift;
-
- my $cws = get_this_cws();
- $cws->child($child);
-
- # Check if we got a valid child workspace.
- my $id = $cws->eis_id();
- if ( $debug ) {
- print STDERR "CWS-DEBUG: child: $child, $id\n";
- }
- if ( !$id ) {
- print_error("Child workspace $child not found in EIS database.", 2);
- }
-
- # Update masterws part of Cws object.
- my $masterws = $cws->get_mws();
- if ( $cws->master() ne $masterws ) {
- # can this still happen?
- if ( $debug ) {
- print STDERR "CWS-DEBUG: get_cws_by_name(): fixup of masterws in cws object detected\n";
- }
- $cws->master($masterws);
- }
- return ($cws);
-}
-
-# Register child workspace with eis.
-sub register_child_workspace
-{
- my $cws = shift;
- my $scm = shift;
- my $is_promotion = shift;
-
- my $milestone = $cws->milestone();
- my $child = $cws->child();
- my $master = $cws->master();
-
- # TODO: introduce a EIS_USER in the configuration, which should be used here
- my $config = CwsConfig->new();
- my $vcsid = $config->vcsid();
- # TODO: there is no real need for socustom anymore, should go ASAP
- my $socustom = $config->sointernal();
-
- if ( !$vcsid ) {
- if ( $socustom ) {
- print_error("Can't determine owner for CWS '$child'. Please set VCSID environment variable.", 11);
- }
- else {
- print_error("Can't determine owner for CWS '$child'. Please set CVS_ID entry in \$HOME/.cwsrc.", 11);
- }
- }
-
- if ( $is_promotion ) {
- my $rc = $cws->set_scm($scm);
- if ( !$rc ) {
- print_error("Failed to set the SCM property '$scm' on child workspace '$child'.\nContact EIS administrator!\n", 12);
- }
-
- $rc = $cws->promote($vcsid, "");
-
- if ( !$rc ) {
- print_error("Failed to promote child workspace '$child' to status 'new'.\n", 12);
- }
- else {
- print "\n***** Successfully ***** promoted child workspace '$child' to status 'new'.\n";
- print "Milestone: '$milestone'.\n";
- }
- }
- else {
-
- my $eis_id = $cws->register($vcsid, "");
-
- if ( !defined($eis_id) ) {
- print_error("Failed to register child workspace '$child' for master '$master'.", 12);
- }
- else {
- my $rc = $cws->set_scm($scm);
- if ( !$rc ) {
- print_error("Failed to set the SCM property '$scm' on child workspace '$child'.\nContact EIS administrator!\n", 12);
- }
- print "\n***** Successfully ***** registered child workspace '$child'\n";
- print "for master workspace '$master' (milestone '$milestone').\n";
- print "Child workspace Id: $eis_id.\n";
- }
- }
- return 0;
-}
-
-sub print_time_elapsed
-{
- my $t_start = shift;
- my $t_stop = shift;
-
- my $time_diff = timediff($t_stop, $t_start);
- print_message("... finished in " . timestr($time_diff));
-}
-
-sub hgrc_append_push_path_and_hooks
-{
- my $target = shift;
- my $cws_source = shift;
-
- $cws_source =~ s/http:\/\//ssh:\/\/hg@/;
- if ( $debug ) {
- print STDERR "CWS-DEBUG: hgrc_append_push_path_and_hooks(): default-push path: '$cws_source'\n";
- }
- if ( !open(HGRC, ">>$target/.hg/hgrc") ) {
- print_error("Can't append to hgrc file of repository '$target'.\n", 88);
- }
- print HGRC "default-push = " . "$cws_source\n";
- print HGRC "[extensions]\n";
- print HGRC "hgext.win32text=\n";
- print HGRC "[hooks]\n";
- print HGRC "# Reject commits which would introduce windows-style CR/LF files\n";
- print HGRC "pretxncommit.crlf = python:hgext.win32text.forbidcrlf\n";
- close(HGRC);
-}
-
-sub hg_clone_cws_or_milestone
-{
- my $rep_type = shift;
- my $cws = shift;
- my $target = shift;
- my $clone_milestone_only = shift;
-
- my ($hg_local_source, $hg_lan_source, $hg_remote_source);
- my $config = CwsConfig->new();
- if ( $rep_type eq 'ooo') {
- $hg_local_source = $config->get_ooo_hg_local_source();
- $hg_lan_source = $config->get_ooo_hg_lan_source();
- $hg_remote_source = $config->get_ooo_hg_remote_source();
- }
- else {
- $hg_local_source = $config->get_so_hg_local_source();
- $hg_lan_source = $config->get_so_hg_lan_source();
- $hg_remote_source = $config->get_so_hg_remote_source();
- }
-
- my $masterws = $cws->master();
- my $master_local_source = "$hg_local_source/" . $masterws;
- my $master_lan_source = "$hg_lan_source/" . $masterws;
-
- my $milestone_tag;
- if ( $clone_milestone_only ) {
- $milestone_tag = uc($masterws) . '_' . $clone_milestone_only;
- }
- else {
- my @tags = $cws->get_tags();
- $milestone_tag = $tags[3];
- }
-
- if ( $debug ) {
- print STDERR "CWS-DEBUG: master_local_source: '$master_local_source'\n";
- print STDERR "CWS-DEBUG: master_lan_source: '$master_lan_source'\n";
- if ( !-d $master_local_source ) {
- print STDERR "CWS-DEBUG: not a directory '$master_local_source'\n";
- }
- }
-
- my $pull_from_remote = 0;
- my $cws_remote_source;
- if ( !$clone_milestone_only ) {
- $cws_remote_source = "$hg_remote_source/cws/" . $cws->child();
-
- # The outgoing repository might not yet be available. Which is not
- # an error. Since pulling from the cws outgoing URL results in an ugly
- # and hardly understandable error message, we check for availibility
- # first. TODO: incorporate configured proxy instead of env_proxy. Use
- # a dedicated request and content-type to find out if the repo is there
- # instead of parsing the content of the page
- print_message("... check availibility of 'outgoing' repository '$cws_remote_source'.");
- require LWP::Simple;
- my $content = LWP::Simple::get($cws_remote_source);
- my $pattern = "<title>cws/". $cws->child();
- if ( $content =~ /$pattern/ ) {
- $pull_from_remote = 1;
- }
- else {
- print_message("... 'outgoing' repository '$cws_remote_source' is not accessible/available yet.");
- }
- }
-
- # clone repository (without working tree if we still need to pull from remote)
- my $clone_with_update = !$pull_from_remote;
- hg_clone_repository($master_local_source, $master_lan_source, $target, $milestone_tag, $clone_with_update);
-
- # now pull from the remote cws outgoing repository if its already available
- if ( $pull_from_remote ) {
- hg_remote_pull_repository($cws_remote_source, $target);
- }
-
- # if we fetched a CWS adorn the result with push-path and hooks
- if ( $cws_remote_source ) {
- hgrc_append_push_path_and_hooks($target, $cws_remote_source);
- }
-
- # update the result if necessary
- if ( !$clone_with_update ) {
- hg_update_repository($target);
- }
-
-}
-
-sub hg_clone_repository
-{
- my $local_source = shift;
- my $lan_source = shift;
- my $dest = shift;
- my $milestone_tag = shift;
- my $update = shift;
-
- my $t1 = Benchmark->new();
- my $source;
- my $clone_option = $update ? '' : '-U ';
- if ( -d $local_source && can_use_hardlinks($local_source, $dest) ) {
- $source = $local_source;
- if ( !hg_milestone_is_latest_in_repository($local_source, $milestone_tag) ) {
- $clone_option .= "-r $milestone_tag";
- }
- print_message("... clone LOCAL repository '$local_source' to '$dest'");
- }
- else {
- $source = $lan_source;
- $clone_option .= "-r $milestone_tag";
- print_message("... clone LAN repository '$lan_source' to '$dest'");
- }
- hg_clone($source, $dest, $clone_option);
-
- my $t2 = Benchmark->new();
- print_time_elapsed($t1, $t2) if $profile;
-}
-
-sub hg_remote_pull_repository
-{
- my $remote_source = shift;
- my $dest = shift;
-
- my $t1 = Benchmark->new();
- print_message("... pull from REMOTE repository '$remote_source' to '$dest'");
- hg_pull($dest, $remote_source);
- my $t2 = Benchmark->new();
- print_time_elapsed($t1, $t2) if $profile;
-}
-
-sub hg_update_repository
-{
- my $dest = shift;
-
- my $t1 = Benchmark->new();
- print_message("... update repository '$dest'");
- hg_update($dest);
- my $t2 = Benchmark->new();
- print_time_elapsed($t1, $t2) if $profile;
-}
-
-sub hg_milestone_is_latest_in_repository
-{
- my $repository = shift;
- my $milestone_tag = shift;
-
- # Our milestone is the lastest thing in the repository
- # if the parent of the repository tip is adorned
- # with the milestone tag.
- my $tags_of_parent_of_tip = hg_parent($repository, 'tip', "--template='{tags}\\n'");
- if ( $tags_of_parent_of_tip =~ /\b$milestone_tag\b/ ) {
- return 1;
- }
- return 0;
-}
-
-# Check if clone source and destination are on the same filesystem,
-# in that case hg clone can employ hard links.
-sub can_use_hardlinks
-{
- my $source = shift;
- my $dest = shift;
-
- if ( $^O eq 'cygwin' ) {
- # no hard links on windows
- return 0;
- }
- # st_dev is the first field return by stat()
- my @stat_source = stat($source);
- my @stat_dest = stat(dirname($dest));
-
- if ( $debug ) {
- my $source_result = defined($stat_source[0]) ? $stat_source[0] : 'stat failed';
- my $dest_result = defined($stat_dest[0]) ? $stat_dest[0] : 'stat failed';
- print STDERR "CWS-DEBUG: can_use_hardlinks(): source device: '$stat_source[0]', destination device: '$stat_dest[0]'\n";
- }
- if ( defined($stat_source[0]) && defined($stat_dest[0]) && $stat_source[0] == $stat_dest[0] ) {
- return 1;
- }
- return 0;
-}
-
-sub query_cws
-{
- my $query_mode = shift;
- my $options_ref = shift;
- # get master and child workspace
- my $masterws = exists $options_ref->{'masterworkspace'} ? uc($options_ref->{'masterworkspace'}) : $ENV{WORK_STAMP};
- my $childws = exists $options_ref->{'childworkspace'} ? $options_ref->{'childworkspace'} : $ENV{CWS_WORK_STAMP};
- my $milestone = exists $options_ref->{'milestone'} ? $options_ref->{'milestone'} : 'latest';
-
- if ( !defined($masterws) && $query_mode ne 'masters') {
- print_error("Can't determine master workspace environment.\n", 30);
- }
-
- if ( ($query_mode eq 'integratedinto' || $query_mode eq 'incompatible' || $query_mode eq 'taskids' || $query_mode eq 'status' || $query_mode eq 'current' || $query_mode eq 'owner' || $query_mode eq 'qarep' || $query_mode eq 'issubversion' || $query_mode eq 'ispublic' || $query_mode eq 'build') && !defined($childws) ) {
- print_error("Can't determine child workspace environment.\n", 30);
- }
-
- my $cws = Cws->new();
- if ( defined($childws) ) {
- $cws->child($childws);
- }
- if ( defined($masterws) ) {
- $cws->master($masterws);
- }
-
- no strict;
- &{"query_".$query_mode}($cws, $milestone);
- return;
-}
-
-sub query_integratedinto
-{
- my $cws = shift;
-
- if ( is_valid_cws($cws) ) {
- my $milestone = $cws->get_milestone_integrated();
- print_message("Integrated into:");
- print defined($milestone) ? "$milestone\n" : "unkown\n";
- }
- return;
-}
-
-sub query_incompatible
-{
- my $cws = shift;
-
- if ( is_valid_cws($cws) ) {
- my @modules = $cws->incompatible_modules();
- print_message("Incompatible Modules:");
- foreach (@modules) {
- if ( defined($_) ) {
- print "$_\n";
- }
- }
- }
- return;
-}
-
-sub query_taskids
-{
- my $cws = shift;
-
- if ( is_valid_cws($cws) ) {
- my @taskids = $cws->taskids();
- print_message("Task ID(s):");
- foreach (@taskids) {
- if ( defined($_) ) {
- print "$_\n";
- }
- }
- }
- return;
-}
-
-sub query_status
-{
- my $cws = shift;
-
- if ( is_valid_cws($cws) ) {
- my $status = $cws->get_approval();
- if ( !$status ) {
- print_error("Internal error: can't get approval status.", 3);
- } else {
- print_message("Approval status:");
- print "$status\n";
- }
- }
- return;
-}
-
-sub query_scm
-{
- my $cws = shift;
- my $masterws = $cws->master();
- my $childws = $cws->child();
-
- if ( is_valid_cws($cws) ) {
- my $scm = $cws->get_scm();
- if ( !defined($scm) ) {
- print_error("Internal error: can't retrieve scm info.", 3);
- } else {
- print_message("Child workspace uses '$scm'.");
- }
- }
- return;
-}
-
-sub query_ispublic
-{
- my $cws = shift;
- my $masterws = $cws->master();
- my $childws = $cws->child();
-
- if ( is_valid_cws($cws) ) {
- my $ispublic = $cws->get_public_flag();
- if ( !defined($ispublic) ) {
- print_error("Internal error: can't get isPublic flag.", 3);
- } else {
- if ( $ispublic==1 ) {
- print_message("Child workspace is public");
- } else {
- print_message("Child workspace is internal");
- }
- }
- }
-
- return;
-}
-
-sub query_current
-{
- my $cws = shift;
-
- if ( is_valid_cws($cws) ) {
- my $milestone = $cws->milestone();
- if ( !$milestone ) {
- print_error("Internal error: can't get current milestone.", 3);
- } else {
- print_message("Current milestone:");
- print "$milestone\n";
- }
- }
- return;
-}
-
-sub query_owner
-{
- my $cws = shift;
-
- if ( is_valid_cws($cws) ) {
- my $owner = $cws->get_owner();
- print_message("Owner:");
- if ( !$owner ) {
- print "not set\n" ;
- } else {
- print "$owner\n";
- }
- }
- return;
-}
-
-sub query_qarep
-{
- my $cws = shift;
-
- if ( is_valid_cws($cws) ) {
- my $qarep = $cws->get_qarep();
- print_message("QA Representative:");
- if ( !$qarep ) {
- print "not set\n" ;
- } else {
- print "$qarep\n";
- }
- }
- return;
-}
-
-
-sub query_build
-{
- my $cws = shift;
-
- if ( is_valid_cws($cws) ) {
- my $build = $cws->get_build();
- print_message("Build:");
- if ( $build ) {
- print "$build\n";
- }
- }
- return;
-}
-
-sub query_latest
-{
- my $cws = shift;
-
- my $masterws = $cws->master();
- my $latest = $cws->get_current_milestone($masterws);
-
-
- if ( $latest ) {
- print_message("Master workspace '$masterws':");
- print_message("Latest milestone available for update:");
- print "$masterws $latest\n";
- }
- else {
- print_error("Can't determine latest milestone of '$masterws' available for update.", 3);
- }
-
- return;
-}
-
-sub query_masters
-{
- my $cws = shift;
-
- my @mws = $cws->get_masters();
- my $list="";
-
- if ( @mws ) {
- foreach (@mws) {
- if ( $list ne "" ) {
- $list .= ", ";
- }
- $list .= $_;
- }
- print_message("Master workspaces available: $list");
- }
- else {
- print_error("Can't determine masterworkspaces.", 3);
- }
-
- return;
-}
-
-sub query_milestones
-{
- my $cws = shift;
- my $masterws = $cws->master();
-
- my @milestones = $cws->get_milestones($masterws);
- my $list="";
-
- if ( @milestones ) {
- foreach (@milestones) {
- if ( $list ne "" ) {
- $list .= ", ";
- }
- $list .= $_;
- }
- print_message("Master workspace '$masterws':");
- print_message("Milestones known on Master: $list");
- }
- else {
- print_error("Can't determine milestones of '$masterws'.", 3);
- }
-
- return;
-}
-
-sub query_ispublicmaster
-{
- my $cws = shift;
- my $masterws = $cws->master();
-
- my $ispublic = $cws->get_publicmaster_flag();
- my $list="";
-
- if ( defined($ispublic) ) {
- print_message("Master workspace '$masterws':");
- if ( !defined($ispublic) ) {
- print_error("Internal error: can't get isPublicMaster flag.", 3);
- } else {
- if ( $ispublic==1 ) {
- print_message("Master workspace is public");
- } else {
- print_message("Master workspace is internal");
- }
- }
- }
- else {
- print_error("Can't determine isPublicMaster flag of '$masterws'.", 3);
- }
-
- return;
-}
-
-sub query_buildid
-{
- my $cws = shift;
- my $milestone = shift;
-
- my $masterws = $cws->master();
- if ( $milestone eq 'latest' ) {
- $milestone = $cws->get_current_milestone($masterws);
- }
-
- if ( !$milestone ) {
- print_error("Can't determine latest milestone of '$masterws'.", 3);
- }
-
- if ( !$cws->is_milestone($masterws, $milestone) ) {
- print_error("Milestone '$milestone' is no a valid milestone of '$masterws'.", 3);
- }
-
- my $buildid = $cws->get_buildid($masterws, $milestone);
-
-
- if ( $buildid ) {
- print_message("Master workspace '$masterws':");
- print_message("BuildId for milestone '$milestone':");
- print("$buildid\n");
- }
-
- return;
-}
-
-sub query_integrated
-{
- my $cws = shift;
- my $milestone = shift;
-
- my $masterws = $cws->master();
- if ( $milestone eq 'latest' ) {
- $milestone = $cws->get_current_milestone($masterws);
- }
-
- if ( !$milestone ) {
- print_error("Can't determine latest milestone of '$masterws'.", 3);
- }
-
- if ( !$cws->is_milestone($masterws, $milestone) ) {
- print_error("Milestone '$milestone' is no a valid milestone of '$masterws'.", 3);
- }
-
- my @integrated_cws = $cws->get_integrated_cws($masterws, $milestone);
-
-
- if ( @integrated_cws ) {
- print_message("Master workspace '$masterws':");
- print_message("Integrated CWSs for milestone '$milestone':");
- foreach (@integrated_cws) {
- print "$_\n";
- }
- }
-
- return;
-}
-
-sub query_approved
-{
- my $cws = shift;
-
- my $masterws = $cws->master();
-
- my @approved_cws = $cws->get_cws_with_state($masterws, 'approved by QA');
-
- if ( @approved_cws ) {
- print_message("Master workspace '$masterws':");
- print_message("CWSs approved by QA:");
- foreach (@approved_cws) {
- print "$_\n";
- }
- }
-
- return;
-}
-
-sub query_nominated
-{
- my $cws = shift;
-
- my $masterws = $cws->master();
-
- my @nominated_cws = $cws->get_cws_with_state($masterws, 'nominated');
-
- if ( @nominated_cws ) {
- print_message("Master workspace '$masterws':");
- print_message("Nominated CWSs:");
- foreach (@nominated_cws) {
- print "$_\n";
- }
- }
-
- return;
-}
-
-sub query_ready
-{
- my $cws = shift;
-
- my $masterws = $cws->master();
-
- my @ready_cws = $cws->get_cws_with_state($masterws, 'ready for QA');
-
- if ( @ready_cws ) {
- print_message("Master workspace '$masterws':");
- print_message("CWSs ready for QA:");
- foreach (@ready_cws) {
- print "$_\n";
- }
- }
-
- return;
-}
-
-sub query_new
-{
- my $cws = shift;
-
- my $masterws = $cws->master();
-
- my @ready_cws = $cws->get_cws_with_state($masterws, 'new');
-
- if ( @ready_cws ) {
- print_message("Master workspace '$masterws':");
- print_message("CWSs with state 'new':");
- foreach (@ready_cws) {
- print "$_\n";
- }
- }
-
- return;
-}
-
-sub query_planned
-{
- my $cws = shift;
-
- my $masterws = $cws->master();
-
- my @ready_cws = $cws->get_cws_with_state($masterws, 'planned');
-
- if ( @ready_cws ) {
- print_message("Master workspace '$masterws':");
- print_message("CWSs with state 'planned':");
- foreach (@ready_cws) {
- print "$_\n";
- }
- }
-
- return;
-}
-
-sub is_valid_cws
-{
- my $cws = shift;
-
- my $masterws = $cws->master();
- my $childws = $cws->child();
- # check if we got a valid child workspace
- my $id = $cws->eis_id();
- if ( !$id ) {
- print_error("Child workspace '$childws' for master workspace '$masterws' not found in EIS database.", 2);
- }
- print STDERR "Master workspace '$masterws', child workspace '$childws'\n";
- return 1;
-}
-
-sub query_release
-{
- my $cws = shift;
-
- if ( is_valid_cws($cws) ) {
- my $release = $cws->get_release();
- print_message("Release target:");
- if ( !$release ) {
- print "not set\n";
- } else {
- print "$release\n";
- }
- }
- return;
-}
-
-sub query_due
-{
- my $cws = shift;
-
- if ( is_valid_cws($cws) ) {
- my $due = $cws->get_due_date();
- print_message("Due date:");
- if ( !$due ) {
- print "not set\n";
- } else {
- print "$due\n";
- }
- }
- return;
-}
-
-sub query_due_qa
-{
- my $cws = shift;
-
- if ( is_valid_cws($cws) ) {
- my $due_qa = $cws->get_due_date_qa();
- print_message("Due date (QA):");
- if ( !$due_qa ) {
- print "not set\n";
- } else {
- print "$due_qa\n";
- }
- }
- return;
-}
-
-sub query_help
-{
- my $cws = shift;
-
- if ( is_valid_cws($cws) ) {
- my $help = $cws->is_helprelevant();
- print_message("Help relevant:");
- if ( !$help ) {
- print "false\n";
- } else {
- print "true\n";
- }
- }
- return;
-}
-
-sub query_ui
-{
- my $cws = shift;
-
- if ( is_valid_cws($cws) ) {
- my $help = $cws->is_uirelevant();
- print_message("UI relevant:");
- if ( !$help ) {
- print "false\n";
- } else {
- print "true\n";
- }
- }
- return;
-}
-
-sub verify_milestone
-{
- my $cws = shift;
- my $qualified_milestone = shift;
-
- my $invalid = 0;
- my ($master, $milestone);
- $invalid++ if $qualified_milestone =~ /-/;
-
- if ( $qualified_milestone =~ /:/ ) {
- ($master, $milestone) = split(/:/, $qualified_milestone);
- $invalid++ unless ( $master && $milestone );
- }
- else {
- $milestone = $qualified_milestone;
- }
-
- if ( $invalid ) {
- print_error("Invalid milestone", 0);
- usage();
- exit(1);
- }
-
- $master = $cws->master() if !$master;
- if ( !$cws->is_milestone($master, $milestone) ) {
- print_error("Milestone '$milestone' is not registered with master workspace '$master'.", 21);
- }
- return ($master, $milestone);
-}
-
-sub relink_workspace {
- my $linkdir = shift;
- my $restore = shift;
-
- # The list of obligatorily added modules, build will not work
- # if these are not present.
- my %added_modules_hash;
- if (defined $ENV{ADDED_MODULES}) {
- for ( split(/\s/, $ENV{ADDED_MODULES}) ) {
- $added_modules_hash{$_}++;
- }
- }
-
- # clean out pre-existing linkdir
- my $bd = dirname($linkdir);
- if ( !opendir(DIR, $bd) ) {
- print_error("Can't open directory '$bd': $!.", 44);
- }
- my @old_link_dirs = grep { /^src.m\d+/ } readdir(DIR);
- close(DIR);
-
- if ( @old_link_dirs > 1 ) {
- print_error("Found more than one old link directories:", 0);
- foreach (@old_link_dirs) {
- print STDERR "@old_link_dirs\n";
- }
- if ( $restore ) {
- print_error("Please remove all old link directories but the last one", 67);
- }
- }
-
- # Originally the extension .lnk indicated a linked module. This turned out to be
- # not an overly smart choice. Cygwin has some heuristics which regards .lnk
- # files as Windows shortcuts, breaking the build. Use .link instead.
- # When in restoring mode still consider .lnk as link to modules (for old CWSs)
- my $old_link_dir = "$bd/" . $old_link_dirs[0];
- if ( $restore ) {
- if ( !opendir(DIR, $old_link_dir) ) {
- print_error("Can't open directory '$old_link_dir': $!.", 44);
- }
- my @links = grep { !(/\.lnk/ || /\.link/) } readdir(DIR);
- close(DIR);
- # everything which is not a link to a directory can't be an "added" module
- foreach (@links) {
- next if /^\./;
- my $link = "$old_link_dir/$_";
- if ( -s $link && -d $link ) {
- $added_modules_hash{$_} = 1;
- }
- }
- }
- print_message("... removing '$old_link_dir'");
- rmtree([$old_link_dir], 0);
-
- print_message("... (re)create '$linkdir'");
- if ( !mkdir("$linkdir") ) {
- print_error("Can't create directory '$linkdir': $!.", 44);
- }
- if ( !opendir(DIR, "$bd/ooo") ) {
- print_error("Can't open directory '$bd/sun': $!.", 44);
- }
- my @ooo_top_level_dirs = grep { !/^\./ } readdir(DIR);
- close(DIR);
- if ( !opendir(DIR, "$bd/sun") ) {
- print_error("Can't open directory '$bd/sun': $!.", 44);
- }
- my @so_top_level_dirs = grep { !/^\./ } readdir(DIR);
- close(DIR);
- my $savedir = getcwd();
- if ( !chdir($linkdir) ) {
- print_error("Can't chdir() to directory '$linkdir': $!.", 44);
- }
- my $suffix = '.link';
- foreach(@ooo_top_level_dirs) {
- if ( $_ eq 'REBASE.LOG' || $_ eq 'REBASE.CONFIG_DONT_DELETE' ) {
- next;
- }
- my $target = $_;
- if ( -d "../ooo/$_" && !exists $added_modules_hash{$_} ) {
- $target .= $suffix;
- }
- if ( !symlink("../ooo/$_", $target) ) {
- print_error("Can't symlink directory '../ooo/$_ -> $target': $!.", 44);
- }
- }
- foreach(@so_top_level_dirs) {
- if ( $_ eq 'REBASE.LOG' || $_ eq 'REBASE.CONFIG_DONT_DELETE' ) {
- next;
- }
- my $target = $_;
- if ( -d "../sun/$_" && !exists $added_modules_hash{$_} ) {
- $target .= $suffix;
- }
- if ( !symlink("../sun/$_", $target) ) {
- print_error("Can't symlink directory '../sun/$_ -> $target': $!.", 44);
- }
- }
- if ( !chdir($savedir) ) {
- print_error("Can't chdir() to directory '$linkdir': $!.", 44);
- }
-}
-
-sub fetch_external_tarballs
-{
- my $source_root_dir = shift;
- my $external_tarballs_source = shift;
-
- my $ooo_external_file = "$source_root_dir/ooo/ooo.lst";
- my $sun_external_file = "$source_root_dir/sun/sun.lst";
- my $sun_path = "$source_root_dir/sun";
-
- my @external_sources_list;
- push(@external_sources_list, read_external_file($ooo_external_file));
- if ( -d $sun_path ) {
- if ( -e $sun_external_file ) {
- push(@external_sources_list, read_external_file($sun_external_file));
- }
- else {
- print_error("Can't find external file list '$sun_external_file'.", 8);
- }
- }
-
- my $ext_sources_dir = "$source_root_dir/ext_sources";
- print_message("Copy external tarballs to '$ext_sources_dir'");
- if ( ! -d $ext_sources_dir) {
- if ( !mkdir($ext_sources_dir) ) {
- print_error("Can't create directory '$ext_sources_dir': $!.", 44);
- }
- }
- foreach (@external_sources_list) {
- if ( ! copy("$external_tarballs_source/$_", $ext_sources_dir) ) {
- print_error("Can't copy file '$external_tarballs_source' -> '$ext_sources_dir': $!", 0);
- }
- }
- return;
-}
-
-sub read_external_file
-{
- my $external_file = shift;
-
- my @external_sources;
- open(EXT, "<$external_file") or print_error("Can't open file '$external_file' for reading: $!", 98);
- while(<EXT>) {
- if ( !/^http:/ ) {
- chomp;
- push(@external_sources, $_);
- }
- }
- close(EXT);
- return @external_sources;
-}
-
-sub update_solver
-{
- my $platform = shift;
- my $source = shift;
- my $solver = shift;
- my $milestone = shift;
- my $source_config = shift;
-
- my @zip_sub_dirs = ('bin', 'doc', 'idl', 'inc', 'lib', 'par', 'pck', 'pdb', 'pus', 'rdb', 'res', 'xml', 'sdf');
-
- use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
-
- my $platform_solver = "$solver/$platform";
-
- if ( -d $platform_solver ) {
- print_message("... removing old solver for platform '$platform'");
- if ( !rmtree([$platform_solver]) ) {
- print_error("Can't remove directory '$platform_solver': $!.", 44);
- }
- }
-
- if ( !mkdir("$platform_solver") ) {
- print_error("Can't create directory '$platform_solver': $!.", 44);
- }
-
- my $platform_source = "$source/$platform/zip.$milestone";
- if ( !opendir(DIR, "$platform_source") ) {
- print_error("Can't open directory '$platform_source': $!.", 44);
- }
- my @zips = grep { /\.zip$/ } readdir(DIR);
- close(DIR);
-
- my $nzips = @zips;
- print_message("... unzipping $nzips zip archives for platform '$platform'");
-
-
- foreach(@zips) {
- my $zip = Archive::Zip->new();
- unless ( $zip->read( "$platform_source/$_" ) == AZ_OK ) {
- print_error("Can't read zip file '$platform_source/$_': $!.", 44);
- }
- # TODO: check for erorrs
- foreach (@zip_sub_dirs) {
- my $extract_destination = $source_config ? "$platform_solver/$_" : "$platform_solver/$_.$milestone";
- unless ( $zip->extractTree($_, $extract_destination) == AZ_OK ) {
- print_error("Can't extract stream from zip file '$platform_source/$_': $!.", 44);
- }
- }
- }
-}
-
-# TODO: special provisions for "source_config" migration, remove this
-# some time after migration
-sub get_source_config_for_milestone
-{
- my $masterws = shift;
- my $milestone = shift;
-
- my $milestone_sequence_number = extract_milestone_sequence_number($milestone);
- my $ooo320_migration_sequence_number = extract_milestone_sequence_number($ooo320_source_config_milestone);
-
- my $source_config = 1;
- if ( $masterws eq 'OOO320' ) {
- if ( $milestone_sequence_number < $ooo320_migration_sequence_number ) {
- $source_config = 0;
- }
- }
- return $source_config;
-}
-
-sub extract_milestone_sequence_number
-{
- my $milestone = shift;
-
- my $milestone_sequence_number;
- if ( $milestone =~ /m(\d+)/ ) {
- $milestone_sequence_number = $1;
- }
- else {
- print_error("can't extract milestone sequence number from milestone '$milestone'", 99);
- }
- return $milestone_sequence_number;
-}
-
-# Executes the help command.
-sub do_help
-{
- my $args_ref = shift;
- my $options_ref = shift;
-
- if (@{$args_ref} == 0) {
- print STDERR "usage: cws <subcommand> [options] [args]\n";
- print STDERR "Type 'cws help <subcommand>' for help on a specific subcommand.\n";
- print STDERR "\n";
- print STDERR "Available subcommands:\n";
- print STDERR "\thelp (h,?)\n";
- print STDERR "\tcreate\n";
- print STDERR "\tfetch (f)\n";
- print STDERR "\tquery (q)\n";
- print STDERR "\ttask (t)\n";
- print STDERR "\tsetcurrent\n";
- print STDERR "\teisclone *** release engineers only ***\n";
- }
-
- my $arg = $args_ref->[0];
-
- if (!defined($arg) || $arg eq 'help') {
- print STDERR "help (h, ?): Describe the usage of this script or its subcommands\n";
- print STDERR "usage: help [subcommand]\n";
- }
- elsif ($arg eq 'create') {
- print STDERR "create: Create a new child workspace\n";
- print STDERR "usage: create [-m milestone] <master workspace> <child workspace>\n";
- print STDERR "\t-m milestone: Milestone to base the child workspace on. If ommitted the\n";
- print STDERR "\t last published milestone will be used.\n";
- print STDERR "\t--milestone milestone: Same as -m milestone.\n";
- }
- elsif ($arg eq 'task') {
- print STDERR "task: Add a task to a child workspace\n";
- print STDERR "usage: task <task id> [task id ...]\n";
- }
- elsif ($arg eq 'query') {
- print STDERR "query: Query child workspace for miscellaneous information\n";
- print STDERR "usage: query [-M master] [-c child] <current|integratedinto|incompatible|owner|qarep|status|taskids>\n";
- print STDERR " query [-M master] [-c child] <release|due|due_qa|help|ui|ispublic|scm|build>\n";
- print STDERR " query [-M master] <latest|milestones|ispublicmaster>\n";
- print STDERR " query <masters>\n";
- print STDERR " query [-M master] [-m milestone] <integrated|buildid>\n";
- print STDERR " query [-M master] <planned|new|approved|nominated|ready>\n";
- print STDERR "\t-M master:\t\toverride MWS specified in environment\n";
- print STDERR "\t-c child:\t\toverride CWS specified in environment\n";
- print STDERR "\t-m milestone:\t\toverride latest milestone with specified one\n";
- print STDERR "\t--master master:\tSame as -M master\t\n";
- print STDERR "\t--child child:\t\tSame -c child\n";
- print STDERR "\t--milestone milestone:\tSame as -m milestone\n";
- print STDERR "Modes:\n";
- print STDERR "\tcurrent\t\tquery current milestone of CWS\n";
- print STDERR "\tincompatible\tquery modules which should be build incompatible\n";
- print STDERR "\towner\t\tquery CWS owner\n";
- print STDERR "\tqarep\t\tquery CWS QA Representative\n";
- print STDERR "\tstatus\t\tquery approval status of CWS\n";
- print STDERR "\ttaskids\t\tquery taskids to be handled on the CWS\n";
- print STDERR "\trelease\t\tquery for target release of CWS\n";
- print STDERR "\tdue\t\tquery for due date of CWS\n";
- print STDERR "\tdue_qa\t\tquery for due date (QA) of CWS\n";
- print STDERR "\thelp\t\tquery if the CWS is help relevant\n";
- print STDERR "\tui\t\tquery if the CWS is UI relevant\n";
- print STDERR "\tbuild\t\tquery build String for CWS\n";
- print STDERR "\tlatest\t\tquery the latest milestone available for resync\n";
- print STDERR "\tbuildid\t\tquery build ID for milestone\n";
- print STDERR "\tintegrated\tquery integrated CWSs for milestone\n";
- print STDERR "\tintegratedinto\tquery milestone which CWS was integrated into\n";
- print STDERR "\tplanned\t\tquery for planned CWSs\n";
- print STDERR "\tnew\t\tquery for new CWSs\n";
- print STDERR "\tapproved\tquery CWSs approved by QA\n";
- print STDERR "\tnominated\tquery nominated CWSs\n";
- print STDERR "\tready\t\tquery CWSs ready for QA\n";
- print STDERR "\tispublic\tquery public flag of CWS\n";
- print STDERR "\tscm\t\tquery Source Control Management (SCM) system used for CWS\n";
- print STDERR "\tmasters\t\tquery available MWS\n";
- print STDERR "\tmilestones\tquery which milestones are know on the given MWS\n";
- print STDERR "\tispublicmaster\tquery public flag of MWS\n";
-
- }
- elsif ($arg eq 'fetch') {
- print STDERR "fetch: fetch a milestone or CWS\n";
- print STDERR "usage: fetch [-q] [-p platforms] [-o] <-m milestone> <workspace>\n";
- print STDERR "usage: fetch [-q] [-p platforms] [-o] <-c cws> <workspace>\n";
- print STDERR "usage: fetch [-q] <-m milestone> <workspace>\n";
- print STDERR "usage: fetch [-q] <-c cws> <workspace>\n";
- print STDERR "\t-m milestone: Checkout milestone <milestone> to workspace <workspace>\n";
- print STDERR "\t Use 'latest' for the for lastest published milestone on the current master\n";
- print STDERR "\t For cross master checkouts use the form <MWS>:<milestone>\n";
- print STDERR "\t--milestone milestone: Same as -m milestone\n";
- print STDERR "\t-c childworkspace: Checkout CWS <childworkspace> to workspace <workspace>\n";
- print STDERR "\t--child childworkspace: Same as -c childworkspace\n";
- print STDERR "\t-p platform: Copy one or more prebuilt platforms 'platform'. \n";
- print STDERR "\t Separate multiple platforms with commas.\n";
- print STDERR "\t--platforms platform: Same as -p\n";
- print STDERR "\t-o Omit checkout of sources, copy only solver. \n";
- print STDERR "\t--onlysolver: Same as -o\n";
- print STDERR "\t-q Silence some of the output of the command.\n";
- print STDERR "\t--quiet: Same as -q\n";
- }
- elsif ($arg eq 'setcurrent') {
- print STDERR "setcurrent: Set the current milestone for the CWS (only hg based CWSs)\n";
- print STDERR "usage: setcurrent [-m milestone]\n";
- print STDERR "\t-m milestone: Set milestone to <milestone> to workspace <workspace>\n";
- print STDERR "\t Use 'latest' for the for lastest published milestone on the current master\n";
- print STDERR "\t For cross master change use the form <MWS>:<milestone>\n";
- print STDERR "\t--milestone milestone: Same as -m milestone\n";
- }
- else {
- print STDERR "'$arg': unknown subcommand\n";
- exit(1);
- }
- exit(0);
-}
-
-# Executes the create command.
-sub do_create
-{
- my $args_ref = shift;
- my $options_ref = shift;
-
- if ( exists $options_ref->{'help'} || @{$args_ref} != 2) {
- do_help(['create']);
- }
-
- if ( exists $options_ref->{'hg'} ) {
- print_warning("All childworkspaces are now hosted on Mercurial. The switch --hg is obsolete.");
- }
-
- my $master = uc $args_ref->[0];
- my $cws_name = $args_ref->[1];
-
- if (!is_master($master)) {
- print_error("'$master' is not a valid master workspace.", 7);
- }
-
- # check if cws name fits the convention
- if ( $cws_name !~ /^\w[\w\.\#]*$/ ) {
- print_error("Invalid child workspace name '$cws_name'.\nCws names should consist of alphanumeric characters, preferable all lowercase and starting with a letter.\nThe characters . and # are allowed if they are not the first character.", 7);
- }
-
- my $cws = get_this_cws();
- $cws->master($master);
- $cws->child($cws_name);
-
- # check if child workspace already exists
- my $eis_id = $cws->eis_id();
- if ( !defined($eis_id) ) {
- print_error("Connection with EIS database failed.", 8);
- }
-
- my $is_promotion = 0;
- if ( $eis_id > 0 ) {
- if ( $cws->get_approval() eq 'planned' ) {
- print "Promote child workspace '$cws_name' from 'planned' to 'new'.\n";
- $is_promotion++;
- }
- else {
- print_error("Child workspace '$cws_name' already exists.", 7);
- }
- }
- else {
- # check if child workspace name is still available
- if ( !$cws->is_cws_name_available()) {
- print_error("Child workspace name '$cws_name' is already in use.", 7);
- }
- }
-
- my $milestone;
- # verify milestone or query latest milestone
- if ( exists $options_ref->{'milestone'} ) {
- $milestone=$options_ref->{'milestone'};
- # check if milestone exists
- if ( !$cws->is_milestone($master, $milestone) ) {
- print_error("Milestone '$milestone' is not registered with master workspace '$master'.", 8);
- }
- }
- else {
- $milestone=$cws->get_current_milestone($cws->master());
- }
-
- # set milestone
- $cws->milestone($milestone);
-
- register_child_workspace($cws, 'hg', $is_promotion);
-
- return;
-}
-
-# Executes the fetch command.
-sub do_fetch
-{
- my $args_ref = shift;
- my $options_ref = shift;
-
- my $time_fetch_start = Benchmark->new();
- if ( exists $options_ref->{'help'} || @{$args_ref} != 1) {
- do_help(['fetch']);
- }
-
- my $milestone_opt = $options_ref->{'milestone'};
- my $child = $options_ref->{'childworkspace'};
- my $platforms = $options_ref->{'platforms'};
- my $quiet = $options_ref->{'quiet'} ? 1 : 0 ;
- my $switch = $options_ref->{'switch'} ? 1 : 0 ;
- my $onlysolver = $options_ref->{'onlysolver'} ? 1 : 0 ;
-
- if ( !defined($milestone_opt) && !defined($child) ) {
- print_error("Specify one of these options: -m or -c", 0);
- do_help(['fetch']);
- }
-
- if ( defined($milestone_opt) && defined($child) ) {
- print_error("Options -m and -c are mutally exclusive", 0);
- do_help(['fetch']);
- }
-
- if ( $onlysolver && !defined($platforms) ) {
- print_error("Option '-o' is Only usuable combination with option '-p'.", 0);
- do_help(['fetch']);
- }
-
- my $cws = get_this_cws();
- my $masterws = $ENV{WORK_STAMP};
- if ( !defined($masterws) ) {
- print_error("Can't determine current master workspace: check environment variable WORK_STAMP", 21);
- }
- $cws->master($masterws);
- my $milestone;
- if( defined($milestone_opt) ) {
- if ( $milestone_opt eq 'latest' ) {
- $cws->master($masterws);
- my $latest = $cws->get_current_milestone($masterws);
-
- if ( !$latest ) {
- print_error("Can't determine latest milestone of master workspace '$masterws'.", 22);
- }
- $milestone = $cws->get_current_milestone($masterws);
- }
- else {
- ($masterws, $milestone) = verify_milestone($cws, $milestone_opt);
- }
- }
- elsif ( defined($child) ) {
- $cws = get_cws_by_name($child);
- $masterws = $cws->master(); # CWS can have another master than specified in ENV
- $milestone = $cws->milestone();
- }
- else {
- do_help(['fetch']);
- }
-
- my $config = CwsConfig->new();
- # $so_svn_server is still required to determine if we are in SO environment
- # TODO: change this configuration setting to something more meaningful
- my $so_svn_server = $config->get_so_svn_server();
- my $prebuild_dir = $config->get_prebuild_binaries_location();
- my $external_tarball_source = $prebuild_dir;
- # Check early for platforms so we can bail out before anything time consuming is done
- # in case of a missing platform
- my @platforms;
- if ( defined($platforms) ) {
- use Archive::Zip; # warn early if module is missing
- if ( !defined($prebuild_dir ) ) {
- print_error("PREBUILD_BINARIES not configured, can't find platform solvers", 99);
- }
- $prebuild_dir = "$prebuild_dir/$masterws";
-
- @platforms = split(/,/, $platforms);
-
- my $added_product = 0;
- my $added_nonproduct = 0;
- foreach(@platforms) {
- if ( $_ eq 'common.pro' ) {
- $added_product = 1;
- print_warning("'$_' is added automatically to the platform list, don't specify it explicit");
- }
- if ( $_ eq 'common' ) {
- $added_nonproduct = 1;
- print_warning("'$_' is added automatically to the platform list, don't specify it explicit");
- }
- }
-
- # add common.pro/common to platform list
- if ( $so_svn_server ) {
- my $product = 0;
- my $nonproduct = 0;
- foreach(@platforms) {
- if ( /\.pro$/ ) {
- $product = 1;
- }
- else {
- $nonproduct = 1;
- }
- }
- unshift(@platforms, 'common.pro') if ($product && !$added_product);
- unshift(@platforms, 'common') if ($nonproduct && !$added_nonproduct);
- }
-
- foreach(@platforms) {
- if ( ! -d "$prebuild_dir/$_") {
- print_error("Can't find prebuild binaries for platform '$_'.", 22);
- }
- }
-
- }
-
- my $cwsname = $cws->child();
- my $linkdir = $milestone_opt ? "src.$milestone" : "src." . $cws->milestone;
-
- my $workspace = $args_ref->[0];
-
- if ( !$onlysolver ) {
- if ( -e $workspace ) {
- print_error("File or directory '$workspace' already exists.", 8);
- }
-
- my $clone_milestone_only = $milestone_opt ? $milestone : 0;
- if ( defined($so_svn_server) ) {
- if ( !mkdir($workspace) ) {
- print_error("Can't create directory '$workspace': $!.", 8);
- }
- my $work_master = "$workspace/$masterws";
- if ( !mkdir($work_master) ) {
- print_error("Can't create directory '$work_master': $!.", 8);
- }
- hg_clone_cws_or_milestone('ooo', $cws, "$work_master/ooo", $clone_milestone_only);
- hg_clone_cws_or_milestone('so', $cws, "$work_master/sun", $clone_milestone_only);
- if ( get_source_config_for_milestone($masterws, $milestone) ) {
- # write source_config file
- my $source_config_file = "$work_master/source_config";
- if ( !open(SOURCE_CONFIG, ">$source_config_file") ) {
- print_error("Can't create source_config file '$source_config_file': $!.", 8);
- }
- print SOURCE_CONFIG "[repositories]\n";
- print SOURCE_CONFIG "ooo=active\n";
- print SOURCE_CONFIG "sun=active\n";
- close(SOURCE_CONFIG);
- }
- else {
- my $linkdir = "$work_master/src.$milestone";
- if ( !mkdir($linkdir) ) {
- print_error("Can't create directory '$linkdir': $!.", 8);
- }
- relink_workspace($linkdir);
- }
- }
- else {
- hg_clone_cws_or_milestone('ooo', $cws, $workspace, $clone_milestone_only);
- }
- }
-
- if ( !$onlysolver && defined($external_tarball_source) ) {
- my $source_root_dir = "$workspace/$masterws";
- $external_tarball_source .= "/$masterws/ext_sources";
- if ( -e "$source_root_dir/ooo/ooo.lst" && -d $external_tarball_source ) {
- fetch_external_tarballs($source_root_dir, $external_tarball_source);
- }
- }
-
- if ( defined($platforms) ) {
- if ( !-d $workspace ) {
- if ( !mkdir($workspace) ) {
- print_error("Can't create directory '$workspace': $!.", 8);
- }
- }
- my $solver = defined($so_svn_server) ? "$workspace/$masterws" : "$workspace/solver";
- if ( !-d $solver ) {
- if ( !mkdir($solver) ) {
- print_error("Can't create directory '$solver': $!.", 8);
- }
- }
- my $source_config = get_source_config_for_milestone($masterws, $milestone);
- foreach(@platforms) {
- my $time_solver_start = Benchmark->new();
- print_message("... copying platform solver '$_'.");
- update_solver($_, $prebuild_dir, $solver, $milestone, $source_config);
- my $time_solver_stop = Benchmark->new();
- print_time_elapsed($time_solver_start, $time_solver_stop) if $profile;
- }
- }
- my $time_fetch_stop = Benchmark->new();
- my $time_fetch = timediff($time_fetch_stop, $time_fetch_start);
- print_message("cws fetch: total time required " . timestr($time_fetch));
-}
-
-sub do_query
-{
- my $args_ref = shift;
- my $options_ref = shift;
-
- # list of available query modes
- my @query_modes = qw(integratedinto incompatible taskids status latest current owner qarep build buildid integrated approved nominated ready new planned release due due_qa help ui milestones masters scm ispublic ispublicmaster);
- my %query_modes_hash = ();
- foreach (@query_modes) {
- $query_modes_hash{$_}++;
- }
-
- if ( exists $options_ref->{'help'} || @{$args_ref} != 1) {
- do_help(['query']);
- }
- my $mode = lc($args_ref->[0]);
-
- # cwquery mode 'state' has been renamed to 'status' to be more consistent
- # with CVS etc. 'state' is still an alias for 'status'
- $mode = 'status' if $mode eq 'state';
-
- # cwquery mode 'vcs' has been renamed to 'scm' to be more consistent
- # with general use etc. 'vcs' is still an alias for 'scm'
- $mode = 'scm' if $mode eq 'vcs';
-
- # there will be more query modes over time
- if ( !exists $query_modes_hash{$mode} ) {
- do_help(['query']);
- }
- query_cws($mode, $options_ref);
-}
-
-sub do_task
-{
- my $args_ref = shift;
- my $options_ref = shift;
-
- if ( exists $options_ref->{'help'} ) {
- do_help(['task']);
- }
-
- # CWS states for which adding tasks are blocked.
- my @states_blocked_for_adding = (
- "integrated",
- "nominated",
- "approved by QA",
- "cancelled",
- "finished"
- );
- my $cws = get_cws_from_environment();
-
- # register taskids with EIS database;
- # checks taksids for sanity, will notify user
- # if taskid is already registered.
- my $status = $cws->get_approval();
-
- my $child = $cws->child();
- my $master = $cws->master();
-
- my @registered_taskids = $cws->taskids();
-
- # if called without ids to register just query for tasks
- if ( @{$args_ref} == 0 ) {
- print_message("Task ID(s):");
- foreach (@registered_taskids) {
- if ( defined($_) ) {
- print "$_\n";
- }
- }
- }
-
- if ( !defined($status) ) {
- print_error("Can't determine status of child workspace `$child`.", 20);
- }
-
- if ( grep($status eq $_, @states_blocked_for_adding) ) {
- print_error("Can't add tasks to child workspace '$child' with state '$status'.", 21);
- }
-
- # Create hash for easier searching.
- my %registered_taskids_hash = ();
- for (@registered_taskids) {
- $registered_taskids_hash{$_}++;
- }
-
- my @new_taskids = ();
- foreach (@{$args_ref}) {
- if ( $_ !~ /^([ib]?\d+)$/ ) {
- print_error("'$_' is an invalid task ID.", 22);
- }
- if ( exists $registered_taskids_hash{$1} ) {
- print_warning("Task ID '$_' already registered, skipping.");
- next;
- }
- push(@new_taskids, $_);
- }
-
- # TODO: introduce a EIS_USER in the configuration, which should be used here
- my $config = CwsConfig->new();
- my $vcsid = $config->vcsid();
- my $added_taskids_ref = $cws->add_taskids($vcsid, @new_taskids);
- if ( !$added_taskids_ref ) {
- my $taskids_str = join(" ", @new_taskids);
- print_error("Couldn't register taskID(s) '$taskids_str' with child workspace '$child'.", 23);
- }
- my @added_taskids = @{$added_taskids_ref};
- if ( @added_taskids ) {
- my $taskids_str = join(" ", @added_taskids);
- print_message("Registered taskID(s) '$taskids_str' with child workspace '$child'.");
- }
- return;
-}
-
-sub do_setcurrent
-{
- my $args_ref = shift;
- my $options_ref = shift;
-
- if ( exists $options_ref->{'help'} || @{$args_ref} != 0) {
- do_help(['setcurrent']);
- }
-
- if ( !exists $options_ref->{'milestone'} ) {
- do_help(['setcurrent']);
- }
-
- my $cws = get_cws_from_environment();
- my $old_masterws = $cws->master();
- my $new_masterws;
- my $new_milestone;
-
- my $milestone = $options_ref->{'milestone'};
- if ( $milestone eq 'latest' ) {
- my $latest = $cws->get_current_milestone($old_masterws);
-
- if ( !$latest ) {
- print_error("Can't determine latest milestone of '$old_masterws'.", 22);
- }
- $new_masterws = $old_masterws;
- $new_milestone = $latest;
- }
- else {
- ($new_masterws, $new_milestone) = verify_milestone($cws, $milestone);
- }
-
- print_message("... updating EIS database");
- my $push_return = $cws->set_master_and_milestone($new_masterws, $new_milestone);
- # sanity check
- if ( $$push_return[1] ne $new_milestone) {
- print_error("Couldn't push new milestone '$new_milestone' to database", 0);
- }
-}
-
-sub do_eisclone
-{
- my $args_ref = shift;
- my $options_ref = shift;
-
- print_error("not yet implemented.", 2);
-}
-
-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";
- exit($error_code);
- }
- return;
-}
-
-sub usage
-{
- print STDERR "Type 'cws help' for usage.\n";
-}
-
-### HG glue ###
-
-sub hg_clone
-{
- my $source = shift;
- my $dest = shift;
- my $options = shift;
-
- if ( $debug ) {
- print STDERR "CWS-DEBUG: ... hg clone: '$source -> $dest', options: '$options'\n";
- }
-
- # The to be cloned revision might not yet be avaliable. In this case clone
- # the available tip.
- my @result = execute_hg_command(0, 'clone', $options, $source, $dest);
- if ( defined($result[0]) && $result[0] =~ /abort: unknown revision/ ) {
- $options =~ s/-r \w+//;
- @result = execute_hg_command(1, 'clone', $options, $source, $dest);
- }
- return @result;
-}
-
-sub hg_parent
-{
- my $repository = shift;
- my $rev_id = shift;
- my $options = shift;
-
- if ( $debug ) {
- print STDERR "CWS-DEBUG: ... hg parent: 'repository', revision: '$rev_id', options: $options\n";
- }
-
- my @result = execute_hg_command(0, 'parent', "--cwd $repository", "-r $rev_id", $options);
- my $line = $result[0];
- chomp($line);
- return $line;
-}
-
-sub hg_pull
-{
- my $repository = shift;
- my $remote = shift;
-
- if ( $debug ) {
- print STDERR "CWS-DEBUG: ... hg pull: 'repository', remote: '$remote'\n";
- }
-
- my @result = execute_hg_command(0, 'pull', "--cwd $repository", $remote);
- my $line = $result[0];
- if ($line =~ /abort: /) {
- return undef;
- }
-}
-
-sub hg_update
-{
- my $repository = shift;
-
- if ( $debug ) {
- print STDERR "CWS-DEBUG: ... hg update: 'repository'\n";
- }
-
- my @result = execute_hg_command(1, 'update', "--cwd $repository");
- return @result;
-}
-
-sub hg_show
-{
- if ( $debug ) {
- print STDERR "CWS-DEBUG: ... hg show\n";
- }
- my $result = execute_hg_command(0, 'show', '');
- return $result;
-}
-
-sub execute_hg_command
-{
- my $terminate_on_rc = shift;
- my $command = shift;
- my $options = shift;
- my @args = @_;
-
- my $args_str = join(" ", @args);
-
- # we can only parse english strings, hopefully a C locale is available everywhere
- $ENV{LC_ALL}='C';
- $command = "hg $command $options $args_str";
-
- if ( $debug ) {
- print STDERR "CWS-DEBUG: ... execute command line: '$command'\n";
- }
-
- my @result;
- open(OUTPUT, "$command 2>&1 |") or print_error("Can't execute mercurial command line client", 98);
- while (<OUTPUT>) {
- push(@result, $_);
- }
- close(OUTPUT);
-
- my $rc = $? >> 8;
-
- if ( $rc > 0 && $terminate_on_rc) {
- print STDERR @result;
- print_error("The mercurial command line client failed with exit status '$rc'", 99);
- }
- return wantarray ? @result : \@result;
-}
-
-
-# vim: set ts=4 shiftwidth=4 expandtab syntax=perl:
diff --git a/solenv/bin/cwsattach b/solenv/bin/cwsattach
deleted file mode 100755
index 99bcde5..0000000
--- a/solenv/bin/cwsattach
+++ /dev/null
@@ -1,7 +0,0 @@
-#!/bin/sh
-if [ x${SOLARENV}x = xx ]; then
- echo No environment found, please use 'configure' or 'setsolar'
- exit 1
-fi
-exec perl -w $SOLARENV/bin/cwsattach.pl "$@"
-
diff --git a/solenv/bin/cwsattach.btm b/solenv/bin/cwsattach.btm
deleted file mode 100644
index 94a0f28..0000000
--- a/solenv/bin/cwsattach.btm
+++ /dev/null
@@ -1,11 +0,0 @@
- at echo off
-iff "%SOLARENV%" == "" then
- echo No environment found, please use 'configure' or 'setsolar'
- goto end
-endiff
-iff "%PERL%" == "" then
- call perl5 -I%SOLARENV%\bin\modules %SOLARENV%\bin\cwsattach.pl %1&
-else
- call %PERL% -I%SOLARENV%\bin\modules %SOLARENV%\bin\cwsattach.pl %1&
-endiff
-:end
diff --git a/solenv/bin/cwsattach.pl b/solenv/bin/cwsattach.pl
deleted file mode 100644
index b9ef392..0000000
--- a/solenv/bin/cwsattach.pl
+++ /dev/null
@@ -1,220 +0,0 @@
-:
-eval 'exec perl -wS $0 ${1+"$@"}'
- if 0;
-#*************************************************************************
-#
-# DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
-#
-# Copyright 2000, 2010 Oracle and/or its affiliates.
-#
-# OpenOffice.org - a multi-platform office productivity suite
-#
-# This file is part of OpenOffice.org.
-#
-# OpenOffice.org is free software: you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License version 3
-# only, as published by the Free Software Foundation.
-#
-# OpenOffice.org 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 version 3 for more details
-# (a copy is included in the LICENSE file that accompanied this code).
-#
-# You should have received a copy of the GNU Lesser General Public License
-# version 3 along with OpenOffice.org. If not, see
-# <http://www.openoffice.org/license.html>
-# for a copy of the LGPLv3 License.
-#
-#*************************************************************************
-#
-# cwsattach.pl - attach files to CWS
-#
-
-use strict;
-use Getopt::Long;
-use Cwd;
-
-#### 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;
-
-#### script id #####
-
-( my $script_name = $0 ) =~ s/^.*\b(\w+)\.pl$/$1/;
-
-my $script_rev;
-my $id_str = ' $Revision: 1.3 $ ';
-$id_str =~ /Revision:\s+(\S+)\s+\$/
- ? ($script_rev = $1) : ($script_rev = "-");
-
-print STDERR "$script_name -- version: $script_rev\n";
-
-#### global #####
-
-my $is_debug = 1; # enable debug
-my $opt_master = ''; # option: master workspace
-my $opt_child = ''; # option: child workspace
-my $opt_mime_type = ''; # option: mime type
-
-
-#### main #####
-
-my $arg_file = parse_options();
-attach_cws($arg_file);
-exit(0);
-
-#### subroutines ####
-
-sub attach_cws
-{
- my $filename = shift;
- # get master and child workspace
- my $masterws = $opt_master ? uc($opt_master) : $ENV{WORK_STAMP};
- my $childws = $opt_child ? $opt_child : $ENV{CWS_WORK_STAMP};
-
- if ( !defined($masterws) ) {
- print_error("Can't determine master workspace environment.\n"
- . "Please initialize environment with setsolar ...", 1);
- }
-
- if ( !defined($childws) ) {
- 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);
-
- my $mime_type = $opt_mime_type ? $opt_mime_type : find_mime_type($filename);
-
- no strict;
-
- if ( is_valid_cws($cws) ) {
- #print "CWS is valid filename=" . $filename . " mime_type=" . $mime_type . "\n";
- open(DATA,"<$filename") || die "can't open filename";
- $data="";
- while(<DATA>) {
- $data.=$_;
- }
- my $result=$cws->save_attachment($filename,$mime_type,$data);
- } else {
- print STDERR "cws is not valid";
- }
- exit(0)
-}
-
-
-sub find_mime_type
-{
- my $filename = shift;
- $filename=~/(.*)\.(.*$)/;
- my $ext=$2;
- my $fmime='';
-
- if ( defined($ext) ) {
- open(MIME,"< $ENV{SOLARENV}/inc/mime.types")|| die "can not open mimetype file";
- while (<MIME>) {
- my @a=split();
- my $iscomment=0;
- if ( /(\s*\#).*/ ) {
- $iscomment=1;
- } else {
- $iscomment=0;
- }
- if ( $iscomment eq 0 && $#a >= 1 && $fmime eq '' ) {
- my $i=1;
- for ($i=1; $i<=$#a; $i++) {
- if ( $a[$i] eq $ext ) {
- $fmime=$a[0];
- }
- }
- }
- }
-
- }
- if ( $fmime eq '' ) {
- $fmime="application/octet-stream";
- }
- return $fmime;
-}
-
-
-sub is_valid_cws
-{
- my $cws = shift;
-
- my $masterws = $cws->master();
- my $childws = $cws->child();
- # check if we got a valid child workspace
- my $id = $cws->eis_id();
- if ( !$id ) {
- print_error("Child workspace '$childws' for master workspace '$masterws' not found in EIS database.", 2);
- }
- print_message("Master workspace '$masterws', child workspace '$childws':");
- return 1;
-}
-
-sub parse_options
-{
- # parse options and do some sanity checks
- my $help = 0;
- my $success = GetOptions('h' => \$help, 'm=s' => \$opt_master, 'c=s'=> \$opt_child, 't=s'=> \$opt_mime_type);
- if ( $help || !$success || $#ARGV < 0 ) {
- usage();
- exit(1);
- }
-
- return $ARGV[0];
-}
-
-sub print_message
-{
- my $message = shift;
-
- print STDERR "$script_name: ";
- print STDERR "$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";
- exit($error_code);
- }
- return;
-}
-
-sub usage
-{
- print STDERR "Usage: cwsattach [-h] [-m master] [-c child] [-t mimetype] filename\n";
- print STDERR "\n";
- print STDERR "Attach files to CWS in EIS database\n";
- print STDERR "\n";
- print STDERR "Options:\n";
- print STDERR "\t-h\t\thelp\n";
- print STDERR "\t-m master\toverride MWS specified in environment\n";
- print STDERR "\t-c child\toverride CWS specified in environment\n";
- print STDERR "\t-t mimetype\texplicitly set mime type\n";
- print STDERR "Examples:\n";
- print STDERR "\tcwsattach barfoo.html\n";
- print STDERR "\tcwsattach -t text bar.cxx\n";
- print STDERR "\tcwsattach -t text/rtf foo.rtf\n";
-}
diff --git a/solenv/bin/cwscreate b/solenv/bin/cwscreate
deleted file mode 100755
index c3260f7..0000000
--- a/solenv/bin/cwscreate
+++ /dev/null
@@ -1,6 +0,0 @@
-#!/bin/sh
-if [ x${SOLARENV}x = xx ]; then
- echo No environment found, please use 'configure' or 'setsolar'
- exit 1
-fi
-echo "Please use the 'cws create' command for creating new child workspaces!"
diff --git a/solenv/bin/cwstestresult b/solenv/bin/cwstestresult
deleted file mode 100755
index 29b1c0c..0000000
--- a/solenv/bin/cwstestresult
+++ /dev/null
@@ -1,7 +0,0 @@
-#!/bin/sh
-if [ x${SOLARENV}x = xx ]; then
- echo No environment found, please use 'configure' or 'setsolar'
- exit 1
-fi
-exec perl -w $SOLARENV/bin/cwstestresult.pl "$@"
-
diff --git a/solenv/bin/cwstestresult.btm b/solenv/bin/cwstestresult.btm
deleted file mode 100644
index 38a0129..0000000
--- a/solenv/bin/cwstestresult.btm
+++ /dev/null
@@ -1,11 +0,0 @@
- at echo off
-iff "%SOLARENV%" == "" then
- echo No environment found, please use 'configure' or 'setsolar'
- goto end
-endiff
-iff "%PERL%" == "" then
- call perl5 -I%SOLARENV%\bin\modules %SOLARENV%\bin\cwstestresult.pl %1&
-else
- call %PERL% -I%SOLARENV%\bin\modules %SOLARENV%\bin\cwstestresult.pl %1&
-endiff
-:end
diff --git a/solenv/bin/cwstestresult.pl b/solenv/bin/cwstestresult.pl
deleted file mode 100644
index 018375d..0000000
--- a/solenv/bin/cwstestresult.pl
+++ /dev/null
@@ -1,192 +0,0 @@
-:
-eval 'exec perl -wS $0 ${1+"$@"}'
- if 0;
-#*************************************************************************
-#
-# DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
-#
-# Copyright 2000, 2010 Oracle and/or its affiliates.
-#
-# OpenOffice.org - a multi-platform office productivity suite
-#
-# This file is part of OpenOffice.org.
-#
-# OpenOffice.org is free software: you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License version 3
-# only, as published by the Free Software Foundation.
-#
-# OpenOffice.org 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 version 3 for more details
-# (a copy is included in the LICENSE file that accompanied this code).
-#
-# You should have received a copy of the GNU Lesser General Public License
-# version 3 along with OpenOffice.org. If not, see
-# <http://www.openoffice.org/license.html>
-# for a copy of the LGPLv3 License.
-#
-#*************************************************************************
-#
-# cwstestresult.pl - publish results of CWS tests to EIS
-#
-
-use strict;
-use Getopt::Long;
-use Cwd;
-
-#### 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;
-
-#### global #####
-( my $script_name = $0 ) =~ s/^.*\b(\w+)\.pl$/$1/;
-
-my $is_debug = 1; # enable debug
-my $opt_master; # option: master workspace
-my $opt_child; # option: child workspace
-my $opt_milestone; # option: milestone
-my $opt_testrunName; # option: testrunName
-my $opt_testrunPlatform; # option: testrunPlatfrom
-my $opt_resultPage; # option: resultPage
-
-
-#### main #####
-
-my $arg_status= parse_options();
-testresult($arg_status);
-exit(0);
-
-#### subroutines ####
-
-sub testresult
-{
- my $status = shift;
- # get master and child workspace
- my $masterws = $opt_master ? uc($opt_master) : $ENV{WORK_STAMP};
- my $milestone = $opt_milestone ? $opt_milestone : $ENV{UPDMINOR};
- my $childws = $opt_milestone ? undef : ( $opt_child ? $opt_child : $ENV{CWS_WORK_STAMP} );
-
- if ( !defined($masterws) ) {
- print_error("Can't determine master workspace environment.\n"
- . "Please initialize environment with setsolar ...", 1);
- }
-
- if ( !defined($childws) && !defined($milestone) ) {
- print_error("Can't determine child workspace environment or milestone.\n"
- . "Please initialize environment with setsolar ...", 1);
- }
- if ( !defined($opt_resultPage) ) {
- $opt_resultPage="";
- }
- my $cws = Cws->new();
- if ( defined($childws) ) {
- $cws->child($childws);
- }
- $cws->master($masterws);
- my $eis = $cws->eis();
-
- no strict;
- my $result='';
-
- if ( defined($childws) ) {
- $opt_resultPage=SOAP::Data->type(string => $opt_resultPage);
- my $id = $cws->eis_id();
- if ( is_valid_cws($cws) ) {
- $result=$eis->submitTestResult($id,$opt_testrunName,$opt_testrunPlatform, $opt_resultPage, $status);
- } else {
- print STDERR "cws is not valid";
- }
- } else {
- $opt_resultPage=SOAP::Data->type(string => $opt_resultPage);
- $result=$eis->submitTestResultMWS($masterws,$milestone,$opt_testrunName,$opt_testrunPlatform, $opt_resultPage, $status);
- }
-
- exit(0)
-}
-
-
-sub is_valid_cws
-{
- my $cws = shift;
-
- my $masterws = $cws->master();
- my $childws = $cws->child();
- # check if we got a valid child workspace
- my $id = $cws->eis_id();
- if ( !$id ) {
- print_error("Child workspace '$childws' for master workspace '$masterws' not found in EIS database.", 2);
- }
- return 1;
-}
-
-sub parse_options
-{
- # parse options and do some sanity checks
- Getopt::Long::Configure("no_ignore_case");
- my $help = 0;
- my $success = GetOptions('h' => \$help, 'M=s' => \$opt_master, 'm=s' => \$opt_milestone, 'c=s' => \$opt_child, 'n=s' => \$opt_testrunName, 'p=s' => \$opt_testrunPlatform , 'r=s' => \$opt_resultPage );
- if ( $help || !$success || $#ARGV < 0 || (!defined($opt_testrunName)) || ( !defined($opt_testrunPlatform)) ) {
- usage();
- exit(1);
- }
- if ( defined($opt_milestone) && defined($opt_child) ) {
- print_error("-m and -c are mutually exclusive options",1);
- }
-
- return $ARGV[0];
-}
-
-sub print_message
-{
- my $message = shift;
-
- print STDERR "$script_name: ";
- print STDERR "$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";
- exit($error_code);
- }
- return;
-}
-
-sub usage
-{
- print STDERR "Usage: cwstestresult[-h] [-m masterws] [-m milestone|-c childws] <-n testrunName> <-p testrunPlatform> <-r resultPage> statusName\n";
- print STDERR "\n";
- print STDERR "Publish result of CWS- or milestone-test to EIS\n";
- print STDERR "\n";
- print STDERR "Options:\n";
- print STDERR "\t-h\t\t\thelp\n";
- print STDERR "\t-M master\t\toverride MWS specified in environment\n";
- print STDERR "\t-m milestone\t\toverride milestone specified in environment\n";
- print STDERR "\t-c child\t\toverride CWS specified in environment\n";
- print STDERR "\t-n testrunName\t\tspecifiy name of the test\n";
- print STDERR "\t-p testrunPlatform\tspecify platform where the test ran on\n";
- print STDERR "\t-r resultPage\t\tspecify name of attachment or hyperlink\n";
- print STDERR "\t\t\t\tfor resultPage\n";
-
-
- print STDERR "\nExample:\n";
- print STDERR "\tcwstestresult -c mycws -n Performance -p Windows -r PerfomanceTestWindows.html ok\n";
-}
diff --git a/solenv/bin/cwstouched b/solenv/bin/cwstouched
deleted file mode 100755
index dac08c0..0000000
--- a/solenv/bin/cwstouched
+++ /dev/null
@@ -1,6 +0,0 @@
-#!/bin/sh
-if [ x${SOLARENV}x = xx ]; then
- echo No environment found, please use 'configure' or 'setsolar'
- exit 1
-fi
-exec perl -w $SOLARENV/bin/cwstouched.pl
diff --git a/solenv/bin/cwstouched.btm b/solenv/bin/cwstouched.btm
deleted file mode 100755
index 33e442d..0000000
--- a/solenv/bin/cwstouched.btm
+++ /dev/null
@@ -1,11 +0,0 @@
- at echo off
-iff "%SOLARENV%" == "" then
- echo No environment found, please use 'configure' or 'setsolar'
- goto end
-endiff
-iff "%PERL%" == "" then
- call perl5 -I%SOLARENV%\bin\modules %SOLARENV%\bin\cwstouched.pl %1&
-else
- call %PERL% -I%SOLARENV%\bin\modules %SOLARENV%\bin\cwstouched.pl %1&
-endiff
-:end
diff --git a/solenv/bin/cwstouched.pl b/solenv/bin/cwstouched.pl
deleted file mode 100755
index a26ca69..0000000
--- a/solenv/bin/cwstouched.pl
+++ /dev/null
@@ -1,151 +0,0 @@
-:
-eval 'exec perl -wS $0 ${1+"$@"}'
- if 0;
-
-#*************************************************************************
-# DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
-#
-# Copyright 2000, 2010 Oracle and/or its affiliates.
-#
-# OpenOffice.org - a multi-platform office productivity suite
-#
-# This file is part of OpenOffice.org.
-#
-# OpenOffice.org is free software: you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License version 3
-# only, as published by the Free Software Foundation.
-#
-# OpenOffice.org 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 version 3 for more details
-# (a copy is included in the LICENSE file that accompanied this code).
-#
-# You should have received a copy of the GNU Lesser General Public License
-# version 3 along with OpenOffice.org. If not, see
-# <http://www.openoffice.org/license.html>
-# for a copy of the LGPLv3 License.
-#
-#***********************************************************************/
-
-use strict;
-use Cwd;
-
-#### 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");
-}
-use lib (@lib_dirs);
-
-use Cws;
-
-# Prototypes
-sub getMinor($);
-sub getCwsWorkStamp();
-
-my $workstamp = $ENV{'WORK_STAMP'};
-my $solenv= $ENV{'SOLARENV'};
-my $cwsWorkStamp = getCwsWorkStamp();
-my $minor = getMinor($cwsWorkStamp);
-
-my $oldWorkStamp = $workstamp."_".$minor;
-my $svndiff="svn diff --summarize --old=svn://svn.services.openoffice.org/ooo/tags/".$oldWorkStamp." --new=svn://svn.services.openoffice.org/ooo/cws/".$cwsWorkStamp;
-
-my @diff = `$svndiff`;
-
-my @modules;
-foreach(@diff)
-{
- if (/.*svn:\/\/svn.services.openoffice.org.*/)
- {
- $_ =~ /.*$oldWorkStamp\/(\w*)/;
- my $newModule=$1;
- if (defined($newModule))
- {
- if ( ! grep(/$newModule/, at modules))
- {
- push(@modules, $newModule);
- }
-
- }
- }
-}
-
-foreach(@modules)
-{
- print "$_\n";
-}
-
-exit(0);
-
-sub getMinor($)
-{
- my $workst = shift;
- my $min="";
-
- if ( ! defined($ENV{'UPDMINOR'}))
- {
- my $cws = Cws->new();
- $cws->child($workst);
- $cws->master($ENV{'WORK_STAMP'});
- my $masterws = $cws->master();
- my $childws = $cws->child();
-
- # check if we got a valid child workspace
- my $id = $cws->eis_id();
- if ( !$id )
- {
- print("Child workspace '$childws' for master workspace '$masterws' not found in EIS database.\n");
- exit(1);
- }
-
- my @milestones = $cws->milestone();
- foreach (@milestones) {
- if ( defined($_) )
- {
- $min=$_;
- }
- }
- }
- else
- {
- $min = $ENV{'UPDMINOR'};
- }
-
- chomp($min);
- return $min;
-}
-
-sub getCwsWorkStamp()
-{
- my $cwsWorkSt="";
-
- if ( ! defined($ENV{'CWS_WORK_STAMP'}))
- {
- my $currPath= cwd;
-
- chdir($ENV{'SOLARENV'});
-
- my @info = `svn info`;
-
- foreach(@info)
- {
- if ( /URL:.*/ )
- {
- # URL: svn+ssh://svn@svn.services.openoffice.org/ooo/cws/qadev37/solenv
- $_ =
~ /.*svn.services.openoffice.org(.*\/(.*))\/\w*/;
- $cwsWorkSt=$2; #qadev37
- }
- }
-
- }
- else
- {
- $cwsWorkSt = $ENV{'CWS_WORK_STAMP'};
- }
- return $cwsWorkSt
-}
diff --git a/solenv/bin/cwstouched.py b/solenv/bin/cwstouched.py
deleted file mode 100755
index 87dfe4b..0000000
--- a/solenv/bin/cwstouched.py
+++ /dev/null
@@ -1,111 +0,0 @@
-#!/usr/bin/python
-
-#*************************************************************************
-# DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
-#
-# Copyright 2000, 2010 Oracle and/or its affiliates.
-#
-# OpenOffice.org - a multi-platform office productivity suite
-#
-# This file is part of OpenOffice.org.
-#
-# OpenOffice.org is free software: you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License version 3
-# only, as published by the Free Software Foundation.
-#
-# OpenOffice.org 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 version 3 for more details
-# (a copy is included in the LICENSE file that accompanied this code).
-#
-# You should have received a copy of the GNU Lesser General Public License
-# version 3 along with OpenOffice.org. If not, see
-# <http://www.openoffice.org/license.html>
-# for a copy of the LGPLv3 License.
-#
-#***********************************************************************/
-
-import os
-import sys
-import string
-from os import path
-
-def getCurrPath():
- currPath = sys.path[0] or os.getcwd()
- currPath = path.abspath(currPath)
- return currPath
-
-def getCwsWorkStamp():
- cwsWorkStamp=os.getenv('CWS_WORK_STAMP')
-
- if not cwsWorkStamp:
- currPath=getCurrPath()
-
- os.chdir(os.getenv('SOLARENV'))
-
- (input, output) = os.popen4("svn info")
-
- for outline in output.readlines():
- if outline.startswith("URL:"):
- cwsWorkStamp = outline[outline.index("svn.services"):outline.index("solenv")-1]
- cwsWorkStamp = cwsWorkStamp[cwsWorkStamp.rfind("/")+1:len(cwsWorkStamp)]
- break
-
- os.putenv("CWS_WORK_STAMP",cwsWorkStamp);
- os.chdir(currPath)
-
- return string.strip(cwsWorkStamp)
-
-def getMinor(cwsWorkStamp):
- minor = os.getenv('UPDMINOR')
-
- if not minor:
- if (os.getenv('OSTYPE') == "cygwin"):
- bash=os.getenv("SHELL")
- (input, output) = os.popen4("cygpath -w "+bash)
- winbash=string.strip(output.readlines()[0])
- cws=winbash+" -c 'cws query -c "+cwsWorkStamp+" current'"
- else:
- cws="cws query -c "+cwsWorkStamp+" current"
-
- (input, output) = os.popen4(cws)
-
- found=0
- for outline in output.readlines():
- if found:
- minor=outline
- break
- elif outline.find("Current milestone:") != -1:
- found=1
-
- return string.strip(minor)
-
-
-workstamp = os.getenv('WORK_STAMP')
-solenv= os.getenv('SOLARENV')
-cwsWorkStamp=getCwsWorkStamp()
-minor = getMinor(cwsWorkStamp)
-
-oldWorkStamp = workstamp + "_" + minor
-diff="svn diff --summarize --old=svn://svn.services.openoffice.org/ooo/tags/"+oldWorkStamp+" --new=svn://svn.services.openoffice.org/ooo/cws/"+cwsWorkStamp
-
-modules=[]
-(input, output) = os.popen4(diff)
-
-for outline in output.readlines():
- if outline.find("svn://svn.services.openoffice.org"):
- index = outline.index(oldWorkStamp)+len(oldWorkStamp)+1
- newModule=""
- if outline.find("/",index) != -1:
- # seems to be a file
- newModule=string.strip(outline[index:outline.index("/",index)])
- else:
- #seems to be a folder
- if len(outline[index:]) > 0:
- newModule=string.strip(outline[index:])
- if newModule != "" and not modules.count(newModule):
- modules.append(newModule)
-
-for module in modules:
- print module
\ No newline at end of file
diff --git a/solenv/bin/modules/Cws.pm b/solenv/bin/modules/Cws.pm
deleted file mode 100755
index 871d734..0000000
--- a/solenv/bin/modules/Cws.pm
+++ /dev/null
@@ -1,2153 +0,0 @@
-#*************************************************************************
-#
-# DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
-#
-# Copyright 2000, 2010 Oracle and/or its affiliates.
-#
-# OpenOffice.org - a multi-platform office productivity suite
-#
-# This file is part of OpenOffice.org.
-#
-# OpenOffice.org is free software: you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License version 3
-# only, as published by the Free Software Foundation.
-#
-# OpenOffice.org 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 version 3 for more details
-# (a copy is included in the LICENSE file that accompanied this code).
-#
-# You should have received a copy of the GNU Lesser General Public License
-# version 3 along with OpenOffice.org. If not, see
-# <http://www.openoffice.org/license.html>
-# for a copy of the LGPLv3 License.
-#
-#*************************************************************************
-
-
-#
-# Cws.pm - package for accessing/manipulating child workspaces
-#
-
-# TODO: needs some cleanup
-
-package Cws;
-use strict;
-
-use Eis;
-use CwsConfig;
-use Carp;
-use URI::Escape;
-
-my $config = CwsConfig::get_config();
-
-##### class data #####
-
-my %CwsClassData = (
- # EIS database connectivity
- EIS_URI => 'urn:ChildWorkspaceDataService',
- EIS_PROXY_LIST => $config->cws_db_url_list_ref(),
- NET_PROXY => $config->net_proxy(),
- EIS => undef
-);
-
-##### ctor #####
-
-sub new
-{
- my $invocant = shift;
- my $class = ref($invocant) || $invocant;
- my $self = {};
- # instance data
- # initialize CWS name from environment
- $self->{CHILD} = undef; # name of child workspace
- $self->{MASTER} = undef; # name of master workspace
- $self->{EIS_ID} = undef; # id of child workspace in EIS
- $self->{FILES} = undef; # list of files registered with child
- # any file can be registered multiple times
- $self->{PATCH_FILES} = undef # list of product patch files registered with
- # child, each file can be added only once
- $self->{MILESTONE} = undef; # master milestone to which child is related
- $self->{MODULES} = undef; # list of modules belonging to child
- $self->{INCOMPATIBLE_MODULES} = undef; # list of modules belonging to child
- $self->{NEW_MODULES} = undef; # list of public new modules belonging to child
- $self->{NEW_MODULES_PRIV} = undef; # list of private new modules belonging to child
- $self->{TASKIDS} = undef; # list of tasks registered with child
- $self->{_CACHED_TAGS} = undef; # list of cached tags (tags are looked up frequently)
- bless($self, $class);
- return $self;
-}
-
-#### methods to access instance data ####
-
-# Get the EIS ID for child workspace,
-# return value: undef => not yet asked EIS for ID
-# or connection failed
-# 0 => queried EIS but didn't find such
-# a child workspace for this master
-# silently ignore any parameter, only the EIS database,
-# hands out EIS IDs.
-sub eis_id
-{
- my $self = shift;
- if ( !defined($self->{EIS_ID} ) ) {
- $self->{EIS_ID} = $self->get_eis_id();
- }
- return $self->{EIS_ID};
-}
-
-# Generate remaining instance data accessor methods;
-# if this looks strange see 'perldoc perltootc'
-
-# Accessor methods for single value instance data
-for my $datum (qw(master milestone)) {
- no strict "refs";
- *$datum = sub {
- my $self = shift;
- my $ucdatum = uc($datum);
- if ( @_ ) {
- # set item in database
- my $item = shift;
- # if we already have a valid EIS registered CWS then reset EIS value
- # otherwise just set member to the given value
- if ( !$self->{uc($datum)} # keep order of evaluation
- || !$self->eis_id()
- || $self->set_item_in_eis($datum, $item) )
- {
- $self->{uc($datum)} = $item;
-
- }
- }
- else {
- if ( !defined($self->{$ucdatum} ) ) {
- # fetch item from database
- $self->{$ucdatum} = $self->fetch_item_from_eis($datum);
- }
- }
- return $self->{uc($datum)};
- }
-}
-
-# Accessor methods for instance data consisting of item lists
-# like modules and taskids
-for my $datum (qw(files patch_files modules incompatible_modules new_modules new_modules_priv taskids)) {
- no strict "refs";
- *$datum = sub {
- # get current item list
- # fetch list from EIS database if called the first time
- my $self = shift;
- my $ucdatum = uc($datum);
- if ( !defined($self->{$ucdatum}) ) {
- # fetch item list from databse
- $self->{$ucdatum} = $self->fetch_items_from_eis($datum);
- return undef if !defined($self->{$ucdatum});
- }
- return wantarray ? @{$self->{$ucdatum}} : $self->{$ucdatum}
- }
-}
-
-for my $datum (qw(child)) {
- no strict "refs";
- *$datum = sub {
- my $self = shift;
- $self->{uc($datum)} = shift if @_;
- return $self->{uc($datum)};
- }
-}
-
-
-#### additional public methods ####
-
-# For resync: Sets master and milestone simultaneously
-# In case of a cross master resync it does not make sense to
-# change both items separately
-sub set_master_and_milestone
-{
- my $self = shift;
- my $master = shift or return undef;
- my $milestone = shift or return undef;
-
- # if we do not yet have a valid EIS registered CWS use the above more basic methods
- if ( !$self->master()
- || !$self->milestone()
- || !$self->eis_id() )
- {
- $self->master($master);
- $self->milestone($milestone);
- } else {
- if ( $self->set_master_and_milestone_in_eis($master, $milestone) ) {
- $self->{'MASTER'} = $self->fetch_item_from_eis('master');
- $self->{'MILESTONE'} = $self->fetch_item_from_eis('milestone');
- }
- }
- my @retarray = ($self->{'MASTER'}, $self->{'MILESTONE'});
- return wantarray ? @retarray : \@retarray;
-}
-
-# Query if CWS name is still available. Does not yet register
-# anything with EIS.
-sub is_cws_name_available
-{
- my $self = shift;
-
- my $is_available = $self->is_cws_name_available_in_eis();
- return $is_available;
-}
-
-# Register new child workspace with the EIS database.
-sub register
-{
- my $self = shift;
- my $vcsid = shift;
- my $location = shift;
-
- my $child_id = $self->register_child_with_eis($vcsid, $location);
- return $child_id;
-}
-
-# Promote a child workspace with status 'planned' to a full CWS
-sub promote
-{
- my $self = shift;
- my $vcsid = shift;
- my $location = shift;
-
- my $rc = $self->promote_child_in_eis($vcsid, $location);
- return $rc;
-}
-
-# New style add_module method. Takes an additional bool indicating if
-# a module is public or private. Obsoletes add_modules()
-sub add_module
-{
- my $self = shift;
- my $module = shift;
- my $public = shift;
-
- my $items_ref = $self->add_items('modules', $public, $module);
- if (defined ($items_ref->[0]) && ($items_ref->[0] eq $module)) {
- return 1; # module has been added
- }
- elsif ( defined($items_ref) ) {
- return 0; # module was already add
- }
- return undef; # something went wrong
-}
-
-# Add module to modules list.
-sub add_modules
-{
- my $self = shift;
-
- my $items_ref = $self->add_items('modules', undef, @_);
- return undef unless defined($items_ref);
- return wantarray ? @{$items_ref} : $items_ref;
-}
-
-# Add tasksids to taskids list.
-sub add_taskids
-{
- my $self = shift;
- my $vcsid = shift;
-
- my $items_ref = $self->add_items('taskids', $vcsid, @_);
- return undef unless defined($items_ref);
- return wantarray ? @{$items_ref} : $items_ref;
-}
-
-# Add a file to the files list.
-sub add_file
-{
- my $self = shift;
- my $module = shift;
- my $file = shift;
- my $revision = shift;
- my $authors_ref = shift;
- my $taskids_ref = shift;
- my $archive_path = shift;
-
- my $files_ref = $self->files();
-
- if ( $self->add_file_to_eis($module, $file, $revision,
- $authors_ref, $taskids_ref, $archive_path) )
- {
- push(@{$files_ref}, $file);
- return 1;
- }
- return 0;
-}
-
-# Add a file to the patch file list.
-sub add_patch_file
-{
- my $self = shift;
- my $file = shift;
-
- my $patch_files_ref = $self->patch_files();
-
- foreach (@{$patch_files_ref}) {
- return 0 if $file eq $_;
- }
-
- if ( $self->add_patch_file_to_eis($file) )
- {
- push(@{$patch_files_ref}, $file);
- return 1;
- }
- return 0;
-}
-
-#
-# Procedure retrieves the workspace which
-# is based on cvs head (not branch)
-#
-sub get_cvs_head {
- my $eis = Cws::eis();
- my $result;
- eval { $result = $eis->getCVSHead() };
- if ( $@ ) {
- carp("ERROR: get_eis_id(): EIS database transaction failed. Reason:\n$@\n");
- }
- return $result;
-};
-
-#### public class methods ####
-
-sub get_master_tag {
- my ($self, $master, $milestone) = @_;
- $master = $self->master() if (!defined $master);
- $milestone = $self->milestone() if (!defined $milestone);
- return uc($master) . '_' . lc($milestone);
-};
-
-sub get_master_branch_tag {
- my ($self, $master) = @_;
- $master = $self->master() if (!defined $master);
- # check in environment if master is on the the HEAD branch
- my $cvs_head = get_cvs_head();
- if ( $master eq $cvs_head ) {
- return undef;
- }
- else {
- return 'mws_' . lc($master);
- }
-};
-
-sub get_mws {
- my $self = shift;
... etc. - the rest is truncated
More information about the Libreoffice-commits
mailing list