TODO: Is cleartool find really needed? I mean since we are going through
the extended version namespace don't we by default find all
subdirectories?
-
+
This script will use cleartool find to process all directory elements from
$startingDir (Default '.'). For each version of the directory a hash will be
built up containing all of the element names in that directory version.
$log->msg ("File: $filename");
foreach (@oids) {
- $log->msg ("\tOID: $$_{OID} ($$_{count})");
- $log->msg ("\tFirst detected \@: $$_{version}");
+ $log->msg ("\tOID: $$_{OID} ($$_{count})");
+ $log->msg ("\tFirst detected \@: $$_{version}");
} # foreach
} # if
} # foreach
if $directory eq '.';
my $displayName = "$directory$Clearcase::SFX$version";
-
+
# We only want to deal with branches and numbered versions. Non-numbered
# versions which are not branches represent labels and baselines which are
# just aliases for directory and file elements. Branches represent recursion
last;
} # if
} # foreach
-
+
unless ($found) {
# If we didn't find a match then make a new %objInfo starting with a
# count of 1. Also save this current $version, which is the first
close $dirs
or $log->err ("Unable to close $cmd - $!");
-
+
return $total{'evil twins'};
} # processDirs
+++ /dev/null
-################################################################################
-#
-# File: testcc.conf
-# Revision: 2.0
-# Description: Parameters for testcc
-#
-# Author: Andrew@DeFaria.com
-# Created: Thu Sep 6 14:05:55 MST 2007
-# Modified:
-# Language: Conf
-#
-# (c) Copyright 2007, Andrew@DeFaria.com, all rights reserved.
-#
-#################################################################################
-vobhost: gdvob1
-vobpath: /net/$vobhost
-vobstore: $vobpath/local/gdvob1a
-
-viewhost: view1
-viewpath: /net/$viewhost
-viewstore: $viewpath/local/view1a
\ No newline at end of file
+++ /dev/null
-#!/bin/bin/perl
-
-=pod
-
-=head1 NAME $RCSfile: testcc.pl,v $
-
-Test Clearcase
-
-=head1 VERSION
-
-=over
-
-=item Author
-
-Andrew DeFaria <Andrew@ClearSCM.com>
-
-=item Revision
-
-$Revision: 1.6 $
-
-=item Created:
-
-Tue Apr 10 13:14:15 CDT 2007
-
-=item Modified:
-
-$Date: 2011/01/09 01:01:32 $
-
-=back
-
-=head1 SYNOPSIS
-
- Usage testcc.pl: [-u|sage] [-ve|rbose] [-d|ebug]
- [-c|onfig <file>] [-vi|ewstore <viewstore>]
- [-vo|bstore <vobstore>]
-
- Where:
- -u|sage: Displays usage
-
- -ve|rbose: Be verbose
- -d|ebug: Output debug messages
-
- -c|onfig <file>: Config file (Default: testcc.conf)
- -vi|ewstore: Path to view storage area
- -vo|bstore: Path to vob storage area
-
-=head1 DESCRIPTION
-
-Clearcase smoke tests. Perform simple Clearcase operations to validate that
-Clearcase minimally works
-
-=cut
-
-use strict;
-use warnings;
-
-use FindBin;
-use Getopt::Long;
-use Cwd;
-use Term::ANSIColor qw(:constants);
-
-my $libs;
-
-BEGIN {
- $libs = $ENV{SITE_PERLLIB} ? $ENV{SITE_PERLLIB} : "$FindBin::Bin/../lib";
-
- die "Unable to find libraries\n"
- unless -d $libs;
-} # BEGIN
-
-use lib $libs;
-
-use Clearcase;
-use Clearcase::Element;
-use Clearcase::View;
-use Clearcase::Views;
-use Clearcase::Vob;
-use Clearcase::Vobs;
-use DateUtils;
-use Display;
-use GetConfig;
-use Logger;
-use OSDep;
-use Utils;
-
-# Globals
-my $VERSION = '2.0';
-
-my ($vbs, $vws, %default_opts, %opts);
-
-my $log = Logger->new;
-my $view = $Clearcase::VIEWTAG_PREFIX;
-my $view_tag = $FindBin::Script;
-my $vob = $ENV{TMP} ? $ENV{TMP} : "/tmp"; # Private vob - mount to /tmp!
-my $vob_tag = $view_tag;
-
-my ($test_view, $test_vob);
-
-# LogOpts: Log the %opts has to the log file so we can tell the options used for
-# this run.
-sub LogOpts () {
- $log->msg (
- "$FindBin::Script v$VERSION run at "
- . YMDHM
- . " with the following options:"
- );
-
- foreach (sort keys %opts) {
- if (ref $opts{$_} eq "ARRAY") {
- my $name = $_;
- $log->msg ("$name:\t$_") foreach (@{$opts{$_}});
- } else {
- $log->msg ("$_:\t$opts{$_}");
- } # if
- } # foreach
-
- return;
-} # LogOpts
-
-sub CreateVob () {
- $log->msg ("Creating vob $vob/$vob_tag");
-
- $test_vob = Clearcase::Vob->new ("$vob/$vob_tag");
-
- my ($status, @output) = $test_vob->create ($opts{vobhost}, $vbs);
-
- $log->log ($_) foreach (@output);
-
- if ($status != 0) {
- if ($output[0] =~ /already exists/) {
- $log->warn ("Vob " . $test_vob->tag . " already exists");
- return 0;
- } # if
- } # if
-
- return $status;
-} # CreateVob
-
-sub MountVob () {
- $log->msg ("Mounting vob " . $test_vob->tag);
-
- # Create mount directory
- my ($status, @output) = Execute "mkdir -p " . $test_vob->tag . " 2>&1";
-
- $log->log ($_) foreach (@output);
-
- ($status, @output) = $test_vob->mount;
-
- $log->log ($_) foreach (@output);
-
- return $status;
-} # MountVob
-
-sub DestroyVob () {
- my ($status, @output);
-
- ($status, @output) = $Clearcase::CC->execute ("cd");
-
- $log->msg ("Unmounting vob " . $test_vob->tag);
-
- ($status, @output) = $test_vob->umount;
-
- $log->msg ("Removing vob " . $test_vob->tag);
-
- ($status, @output) = $test_vob->remove;
-
- $log->log ($_) foreach (@output);
-
- ($status, @output) = Execute "rmdir " . $test_vob->tag;
-
- $log->log ($_)
- foreach (@output);
-
- return $status;
-} # DestroyVob
-
-sub CreateView () {
- $log->msg ("Creating view $view_tag");
-
- $test_view = Clearcase::View->new ($view_tag);
-
- my ($status, @output) = $test_view->create ($opts{viewhost}, $vws);
-
- $log->log ($_) foreach (@output);
-
- if ($status != 0) {
- if ($output[0] =~ /already exists/) {
- $log->warn ("View " . $test_view->tag . " already exists");
- return 0;
- } # if
- } # if
-
- return $status;
-} # CreateView
-
-sub SetView () {
- $log->msg ("Setting view $test_view->tag");
-
- my ($status, @output) = $test_view->set;
-
- $log->log ($_) foreach (@output);
-
- return $status;
-} # SetView
-
-sub DestroyView () {
- $log->msg ("Removing view " . $test_view->tag);
-
- my ($status, @output) = $Clearcase::CC->execute ("cd");
-
- $log->log ($_) foreach (@output);
-
- chdir $ENV{HOME}
- or $log->err ("Unable to chdir $ENV{HOME}", 1);
-
- ($status, @output) = $test_view->remove;
-
- $log->log ($_) foreach (@output);
-
- return $status;
-} # DestroyView
-
-sub CreateViewPrivateFiles (@) {
- my (@elements) = @_;
-
- $log->msg ("Creating test files");
-
- foreach (@elements) {
- my $file;
-
- $log->msg ("Creating $_");
-
- open $file, ">>", $_
- or $log->err ("Unable to open $_ for writing - $!", 1);
-
- print $file "This is file $_\n";
-
- close $file;
- } # foreach
-
- return;
-} # CreateViewPrivateFiles
-
-sub CheckOut ($) {
- my ($element) = @_;
-
- my ($status, @output);
-
- if (ref $element eq "ARRAY") {
- foreach (@{$element}) {
- $log->msg ("Checking out $_");
-
- my $newElement = Clearcase::Element->new ($_);
-
- ($status, @output) = $newElement->checkout;
-
- $log->log ($_) foreach (@output);
- $log->err ("Unable to check out $_", $status) if $status;
- } # foreach
- } else {
- $log->msg ("Checking out $element");
-
- my $newElement = Clearcase::Element->new ($element);
-
- ($status, @output) = $newElement->checkout;
-
- $log->log ($_) foreach (@output);
- $log->err ("Unable to check out $element", $status) if $status;
- } # if
-
- return;
-} # CheckOut
-
-sub CheckIn ($) {
- my ($element) = @_;
-
- my ($status, @output);
-
- if (ref $element eq "ARRAY") {
- foreach (@{$element}) {
- $log->msg ("Checking in $_");
-
- my $newElement = Clearcase::Element->new ($_);
-
- ($status, @output) = $newElement->checkin;
-
- $log->log ($_) foreach (@output);
- $log->err ("Unable to check in $_", $status) if $status;
- } # foreach
- } else {
- $log->msg ("Checking in $element");
-
- my $newElement = Clearcase::Element->new ($element);
-
- ($status, @output) = $newElement->checkin;
-
- $log->log ($_) foreach (@output);
- $log->err ("Unable to check in $element", $status) if $status;
- } # if
-
- return;
-} # CheckIn
-
-sub ComparingFiles (@) {
- my (@elements) = @_;
-
- foreach (@elements) {
- my @lines = ReadFile $_;
-
- $log->err ("Element $_ should contain only two lines", 2) if scalar @lines != 2;
- } # foreach
-
- return;
-} # ComparingFiles
-
-sub MakeElements (@) {
- my (@elements) = @_;
-
- foreach (@elements) {
- $log->msg ("Mkelem $_");
-
- my $newElement = Clearcase::Element->new ($_);
-
- my ($status, @output) = $newElement->mkelem;
-
- $log->log ($_) foreach (@output);
- $log->err ("Unable to make $_ an element", $status) if $status;
- } # foreach
-
- return;
-} # MakeElements
-
-sub RunTests () {
- # Simple tests:
- #
- # . Create a few elements
- # . Check them in
- # . Check them out
- # . Modify them
- # . Check them in
- #
- # Assumptions:
- #
- # . $vob_tag is already created
- # . $view_tag is already created
- # . View is set and we are in the vob
- # . There are no vob elements for @elements
- my @elements = (
- "cctest.h",
- "ccsetup.c",
- "cctest.c",
- "Makefile",
- );
-
- $log->msg ("Removing test files");
-
- unlink $_ foreach (@elements);
-
- $log->msg ("Creating view private files");
-
- CreateViewPrivateFiles $log, @elements;
-
- $log->msg ("Making elements");
-
- CheckOut '.';
- MakeElements @elements;
- CheckIn \@elements;
- CheckIn '.';
-
- $log->msg ("Checking out files");
-
- CheckOut \@elements;
-
- $log->msg ("Modifying files");
-
- CreateViewPrivateFiles @elements;
-
- $log->msg ("Checking in files");
-
- CheckIn \@elements;
-
- $log->msg ("Comparing files");
-
- ComparingFiles @elements;
-
- $log->msg ("$FindBin::Script: End Tests");
-
- return 0;
-} # RunTests
-
-sub Cleanup () {
- my $status = 0;
-
- $log->msg ("Cleaning up");
-
- if ($test_view && $test_view->exists) {
- $status += DestroyView;
- } # if
-
- if ($test_vob && $test_vob->exists) {
- $status += DestroyVob;
- } # if
-
- return $status;
-} # Cleanup
-
-sub SetupTest () {
- $log->msg ("Setup test environment");
-
- my $status += CreateVob;
-
- return $status if $status != 0;
-
- $status += MountVob;
-
- return $status if $status != 0;
-
- $status += CreateView;
-
- return $status if $status != 0;
-
- $status += $test_view->start;
-
- my $dir = $Clearcase::VIEWTAG_PREFIX . $test_view->tag . $test_vob->tag;
-
- chdir $dir
- or $log->err ("Unable to chdir to $dir", $status++);
-
- my @output;
-
- ($status, @output) = $Clearcase::CC->execute ("cd $dir");
-
- if ($status != 0) {
- $log->log ($_) foreach (@output);
- $log->err ("Unable to chdir to $dir", $status);
- } # if
-
- return $status;
-} # SetupTest
-
-my $conf_file = "$FindBin::Script.conf";
-
-GetOptions (
- \%opts,
- "v|verbose" => sub { set_verbose },
- "u|usage" => sub { Usage },
- "c|onfig=s",
- "n|etpath=s",
- "viewstore=s",
- "vobstore=s",
-) or Usage;
-
-# Read the config file
-if (-f $conf_file) {
- %default_opts = GetConfig $conf_file;
-} else {
- $log->err ("Unable to find config file $conf_file", 1);
-} # if
-
-# Overlay default opts if not specified
-foreach (keys %default_opts) {
- $opts{$_} = $default_opts{$_} if !$opts{$_};
-} # foreach
-
-$vws = "$opts{viewstore}/$view_tag.vws";
-$vbs = "$opts{vobstore}/$vob_tag.vbs";
-
-$log->msg ("START: $FindBin::Script (v$VERSION)");
-
-LogOpts;
-
-my $status = SetupTest;
-
-if ($status == 0) {
- $status += RunTests;
-} else {
- $log->err ("Tests not run. Failure occured in SetupTest - check logfile");
-} # if
-
-$status += Cleanup;
-
-if ($status != 0) {
- $log->err ("$FindBin::Script failed");
-} else {
- $log->msg ("$FindBin::Script passed");
-} # if
-
-$log->msg ("END: $FindBin::Script (v$VERSION)");
-
-exit $status;
-
-=pod
-
-=head1 CONFIGURATION AND ENVIRONMENT
-
-DEBUG: If set then $debug is set to this level.
-
-VERBOSE: If set then $verbose is set to this level.
-
-TRACE: If set then $trace is set to this level.
-
-=head1 DEPENDENCIES
-
-=head2 Perl Modules
-
-L<Cwd>
-
-L<FindBin>
-
-L<Getopt::Long|Getopt::Long>
-
-L<Term::ANSIColor|Term::ANSIColor>
-
-=head2 ClearSCM Perl Modules
-
-=begin man
-
- Clearcase
- Clearcase::Element
- Clearcase::View
- Clearcase::Views
- Clearcase::Vob
- Clearcase::Vobs
- DateUtils
- Display
- GetConfig
- Logger
- OSDep
- Utils
-
-=end man
-
-=begin html
-
-<blockquote>
-<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase.pm">Clearcase</a><br>
-<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/Element.pm">Element</a><br>
-<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/View.pm">View</a><br>
-<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/Views.pm">Views</a><br>
-<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/Vob.pm">Vob</a><br>
-<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/Vobspm">Vobs</a><br>
-<a href="http://clearscm.com/php/scm_man.php?file=lib/DateUtils.pm">DateUtils</a><br>
-<a href="http://clearscm.com/php/scm_man.php?file=lib/Display.pm">Display</a><br>
-<a href="http://clearscm.com/php/scm_man.php?file=lib/GetConfig.pm">GetConfig</a><br>
-<a href="http://clearscm.com/php/scm_man.php?file=lib/Logger.pm">Logger</a><br>
-<a href="http://clearscm.com/php/scm_man.php?file=lib/OSDep.pm">OSDep</a><br>
-<a href="http://clearscm.com/php/scm_man.php?file=lib/Utils.pm">Utils</a><br>
-</blockquote>
-
-=end html
-
-=head1 BUGS AND LIMITATIONS
-
-There are no known bugs in this script
-
-Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
-
-=head1 LICENSE AND COPYRIGHT
-
-Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-
-=cut
use OSDep;
use Display;
-my ($clearpid, $clearin, $clearout, $oldHandler);
+my ($clearpid, $clearin, $clearout, $oldHandler, $cleartool);
our $VIEW_DRIVE = 'M';
our $VOB_MOUNT = 'vob';
# installed under /opt/rational/clearcase/bin. This is needed in case we wish
# to use these Clearcase objects say in a web page where the server is often
# run as a plain user who does not have cleartool in their path.
- my $cleartool;
-
- if ($ARCHITECTURE =~ /Win/ or $ARCHITECTURE eq 'cygwin') {
- $cleartool = 'cleartool';
- } elsif (-x '/opt/rational/clearcase/bin/cleartool') {
- $cleartool = '/opt/rational/clearcase/bin/cleartool';
- } # if
+ unless ($cleartool) {
+ if ($ARCHITECTURE =~ /Win/ or $ARCHITECTURE eq 'cygwin') {
+ $cleartool = 'cleartool';
+ } elsif (-x '/opt/rational/clearcase/bin/cleartool') {
+ $cleartool = '/opt/rational/clearcase/bin/cleartool';
+ } # if
+ } # unless
# TODO: Need to catch SIGCHILD here in case the user does something like hit
# Ctrl-C. Such an action may interrupt the underlying cleartool process and
my ($self, %opts) = @_;
my $opts;
-
+
for (keys %opts) {
if ($_ eq 'cq' or $_ eq 'cqe' or $_ eq 'force' or $_ eq 'nc') {
$opts .= "-$_ ";
$opts .= "-$_ $opts{$_}";
} # if
} # for
-
-
+
return $opts;
} # _processOpts
name => $baseline,
pvob => $pvob,
}, $class; # bless
-
+
return $class;
} # new
sub name() {
my ($self) = @_;
-
+
=pod
=head2 name
sub pvob() {
my ($self) = @_;
-
+
=pod
=head2 pvob
return $self->{pvob};
} # pvob
-
+
sub create($;$$$) {
my ($self, $view, $comment, $opts) = @_;
=for html </blockquote>
=cut
-
+
$opts ||= '';
-
+
$comment = Clearcase::_setComment $comment;
return $Clearcase::CC->execute(
=cut
$opts ||= '';
-
+
return $Clearcase::CC->execute(
"rmbl $opts -force " . $self->{name} . '@' . $self->{pvob}->name
);
sub diff($;$$) {
my ($self, $type, $baseline, %opts) = @_;
-
+
=pod
=head2 diff
croak "Type must be one of activities, versions or baselines in "
. "Clearcase::UCM::Baseline::diff - not $type";
} # unless
-
+
my $myBaseline = "$self->{name}\@$self->{pvob}";
-
+
my $cmd = "diffbl -$type";
-
+
if ($baseline) {
if ($baseline =~ /(\S+):/) {
unless ($1 eq 'baseline' or $1 eq 'stream') {
. "just <baseline>";
} # unless
} # if
-
+
$baseline .= "\@$self->{pvob}" unless $baseline =~ /\@/;
-
+
$cmd .= " $myBaseline $baseline";
} else {
$cmd .= " -predeccsor";
} # if
-
+
$Clearcase::CC->execute($cmd);
-
+
return if $Clearcase::CC->status;
-
+
my @output = $Clearcase::CC->output;
my %info;
-
+
for (@output) {
next unless /^(\>\>|\<\<)/;
-
+
if (/(\>\>|\<\<)\s+(\S+)\@/) {
$info{$2} = Clearcase::UCM::Activity->new($2, $self->{pvob});
} # if
} # for
-
+
return %info;
} # diff
=cut
return $Clearcase::CC->execute
- ('rmcomp -f ' . $self->{name} . '@' . $self->{pvob}->name);
+ ('rmcomp -f ' . $self->name . '@' . $self->pvob->tag);
} # remove
sub exists() {
=cut
return $Clearcase::CC->execute(
- 'rmfolder -f ' . $self->{name} . "\@" . $self->{pvob});
+ 'rmfolder -f ' . $self->{name} . "\@" . $self->{pvob}->tag);
} # rmfolder
sub updateFolderInfo () {
=cut
return $Clearcase::CC->execute
- ('rmproject -f ' . $self->{name} . "\@" . $self->{pvob}->name);
-} # rmProject
+ ('rmproject -f ' . $self->{name} . "\@" . $self->{pvob}->tag);
+} # remove
+
+sub change($) {
+ my ($self, $opts) = @_;
+
+=pod
+
+=head2 change
+
+Changes UCM Project
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item opts
+
+Options
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item $status
+
+Status from cleartool
+
+=item @output
+
+Ouput from cleartool
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ $opts ||= '';
+
+ return $Clearcase::CC->execute
+ ("chproject $opts " . $self->{name} . "\@" . $self->{pvob}->name);
+} # change
sub exists() {
my ($self) = @_;
name => $name,
pvob => $pvob,
}, $class; # bless
-
+
return $class;
} # new
-
+
sub name () {
my ($self) = @_;
-
+
=pod
=head2 name
sub pvob () {
my ($self) = @_;
-
+
=pod
=head2 pvob
return $self->{pvob};
} # pvob
-
+
sub create ($;$) {
my ($self, $project, $opts) = @_;
} # rmStream
sub rebase($;$) {
- my ($self, $baseline, $opts) = @_;
+ my ($self, $opts) = @_;
=pod
$opts ||= '';
- $opts .= ' -baseline ' . $baseline .
- ' -stream ' . $self->name . '@' . $self->{pvob}->name;
+ $opts .= ' -stream ' . $self->name . '@' . $self->{pvob}->name;
return $Clearcase::CC->execute("rebase $opts");
} # rebase
);
} # recommend
+sub nrecommended() {
+ my ($self) = @_;
+
+=pod
+
+=head2 nrecommend
+
+Changes stream to not have a recommended baseline
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item $status
+
+Status from cleartool
+
+=item @output
+
+Ouput from cleartool
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return $Clearcase::CC->execute(
+ 'chstream -nrecommended ' . $self->name . '@' . $self->{pvob}->tag
+ );
+} # nrecommended
+
sub baselines () {
my ($self) = @_;
=cut
my $cmd = "lsbl -short -stream $self->{name}\@$self->{pvob}";
-
+
$Clearcase::CC->execute ($cmd);
return if $Clearcase::CC->status;
my @baselines;
-
+
for ($Clearcase::CC->output) {
my $baseline = Clearcase::UCM::Baseline->new ($_, $self->{pvob});
-
+
push @baselines, $baseline;
} # for
-
+
return @baselines;
} # baselines
=cut
+ # Watch here as $error can very well be 0 which "if $error" would evaluate
+ # to false leaving $self->{error} undefined
$self->{error} = $error if defined $error;
return $self->{error};
@fields = $self->_setFields ($table, @fields);
- return if @fields;
-
my $entity;
eval {$entity = $self->{session}->GetEntityByDbId ($table, $dbid)};
=cut
$action ||= 'Modify';
- my %values = %$values;
+ my %values = ();
+
+ %values = %$values if $values;
my $entity;
else
id=id
tr=tr
- TERM=xterm
+ if [ $ARCHITECTURE = 'cygwin' ]; then
+ TERM=cygwin
+ else
+ TERM=xterm
+ fi
fi
# Set colors
#
################################################################################
if [ $ARCHITECTURE = 'cygwin' ]; then
- export CCHOME=$(cygpath -u "$(regtool get '/machine/SOFTWARE/Rational Software/RSINSTALLDIR' 2>/dev/null)"/Clearcase 2>/dev/null);
+ # The following should work but fails because they are using /c to mount
+ # the C drive and that messes things up.
+ export CCHOME=$(cygpath -u "$(regtool get '/machine/SOFTWARE/Atria/ClearCase/CurrentVersion/ProductHome' 2>/dev/null)" 2>/dev/null)
+ export CCHOME=/opt/rational/clearcase
else
export CCHOME="/opt/rational/clearcase"
fi
append_to_path "/d/Program Files/IBM/RationalSDLC/Clearquest/cqcli/bin"
append_to_path "/c/Program Files/IBM/RationalSDLC/ClearCase/bin"
append_to_path "/d/Program Files/IBM/RationalSDLC/ClearCase/bin"
+
+# Common CDPATHS
+CDPATH=$CDPATH:/vobs/ranccadm
"$TERM" = "2392A" -o \
"$TERM" = "dtterm" -o \
"$TERM" = "vt100" -o \
+ "$TERM" = "cygwin" -o \
"$TERM" = "xterm" -o \
"$TERM" = "xtermc" -o \
"$TERM" = "xterm-256color" -o \
fi
if [ "$TERM" = "vt100" -o \
+ "$TERM" = "cygwin" -o \
"$TERM" = "xterm" -o \
"$TERM" = "xtermc" -o \
"$TERM" = "xterm-256color" -o \
echo -e "${INVERSE}Inverse$NORMAL"
fi
elif [ "$TERM" = "dtterm" -o \
+ "$TERM" = "cygwin" -o \
"$TERM" = "xterm" -o \
"$TERM" = "xtermc" ]; then
NORMAL="$esc[0;39m"
use Cwd;
use FindBin;
use Getopt::Long;
-use Term::ANSIColor qw(:constants);
+#use Term::ANSIColor qw(:constants);
use lib "$FindBin::Bin/../lib";
# Globals
my $VERSION = '2.1';
-my (@ucmobjs, $order);
-
my (
$test_vob,
$test_view,
$test_intview,
);
-my ($vbs, $vws, %default_opts, %opts);
+my (%default_opts, %opts);
my ($script) = ($FindBin::Script =~ /^(.*)\.pl/);
for (sort keys %opts) {
if (ref $opts{$_} eq 'ARRAY') {
my $name = $_;
- $log->msg("$name:\t$_") for (@{$opts{$_}});
+ $log->msg("$name:\t$_") for @{$opts{$_}};
} else {
$log->msg("$_:\t$opts{$_}");
} # if
} # for
-
+
return;
} # LogOpts
my ($status, @output) = $newvob->create($opts{vobhost}, "$opts{vobstore}/$vobname.vbs");
- $log->log($_) for (@output);
+ $log->log($_) for @output;
return ($status, $newvob);
} # CreateVob
#my ($status, @output) = $pvob->create($opts{vobhost}, "$opts{vobstore}/$vobname.vbs", 'A test Pvob');
my ($status, @output) = $pvob->create($opts{vobhost}, "$opts{vobstore}/$vobname.vbs");
- $log->log($_) for (@output);
-
- push @ucmobjs, $pvob unless $status;
+ $log->log($_) for @output;
return ($status, $pvob);
} # CreatePvob
# Create mount directory
my ($status, @output);
-
+
($status, @output) = Execute 'mkdir -p ' . $vob->tag . ' 2>&1' unless -d $vob->tag;
- $log->log($_) for (@output);
+ $log->log($_) for @output;
($status, @output) = $vob->mount;
- $log->log($_) for (@output);
+ $log->log($_) for @output;
return $status;
} # MountVob
($status, @output) = $vob->remove;
- $log->log($_) for (@output);
+ $log->log($_) for @output;
return $status;
} # DestroyVob
my ($status, @output) = $view->create($opts{viewhost}, "$opts{viewstore}/$tag.vws");
- $log->log($_) for (@output);
+ $log->log($_) for @output;
return ($status, $view);
} # CreateView
my ($status, @output) = $view->set;
- $log->log($_) for (@output);
+ $log->log($_) for @output;
return $status;
} # SetView
my ($status, @output) = $Clearcase::CC->execute('cd');
- $log->log($_) for (@output);
+ $log->log($_) for @output;
chdir $ENV{HOME}
or $log->err("Unable to chdir $ENV{HOME}", 1);
($status, @output) = $view->remove;
- $log->log($_) for (@output);
+ $log->log($_) for @output;
return $status;
} # DestroyView
close $file;
} # for
-
+
return;
} # CreateViewPrivateFiles
($status, @output) = $newElement->checkout;
- $log->log($_) for (@output);
+ $log->log($_) for @output;
$log->err("Unable to check out $_", $status) if $status;
} # for
($status, @output) = $newElement->checkout;
- $log->log($_) for (@output);
+ $log->log($_) for @output;
$log->err("Unable to check out $element", $status) if $status;
} # if
-
+
return;
} # CheckOut
($status, @output) = $newElement->checkin;
- $log->log($_) for (@output);
+ $log->log($_) for @output;
$log->err("Unable to check in $_", $status) if $status;
} # for
($status, @output) = $newElement->checkin;
- $log->log($_) for (@output);
+ $log->log($_) for @output;
$log->err("Unable to check in $element", $status) if $status;
} # if
-
+
return;
} # CheckIn
my ($status, @output) = $newElement->mkelem;
- $log->log($_) for (@output);
+ $log->log($_) for @output;
$log->err("Unable to make $_ an element", $status) if $status;
} # for
-
+
return;
} # MakeElements
$log->msg("$script: Start Base Clearcase Tests");
$log->msg('Removing test files');
- unlink $_ for (@elements);
+ unlink $_ for @elements;
$log->msg('Creating view private files');
} # Cleanup
sub CleanupUCM() {
- my $status = 0;
+ my ($rc, $status, @output);
- # Need to remove UCM objects in the opposite order in which we created them
- for (reverse @ucmobjs) {
- my ($rc, @output);
+ $log->msg('Removing ' . $test_activity->name);
- if (ref $_ eq 'Clearcase::UCM::Pvob') {
- $log->msg('Removing Pvob ' . $_->tag);
+ ($rc, @output) = $test_activity->remove;
- $status += DestroyVob $_;
- } else {
- $log->msg('Removing ' . ref ($_) . ' ' . $_->name);
+ $status += $rc;
+
+ $log->log($_) for @output;
- ($rc, @output) = $_->remove;
+ # Need to remove baselines from streams first using rebase (Devstream)
+ $log->msg('Rebasing ' . $test_devstream->name . ' to remove baseline');
- $status += $rc;
- } # if
- } # for
+ $status += RebaseStream(
+ $test_devstream,
+ ' -dbaseline ' . $test_baseline->name . '@' . $test_baseline->pvob->tag .
+ ' -view ' . $test_devview->name . ' -complete',
+ );
+
+ # Change intstream to not have a recommended baseline
+ $log->msg('Changing ' . $test_intstream->name . ' to remove recommended baseline');
+
+ ($rc, @output) = $test_intstream->nrecommended;
+
+ $status += $rc;
+
+ $log->log($_) for @output;
+
+ $status += DestroyView($test_devview);
+
+ $log->msg('Removing ' . $test_baseline->name);
+
+ ($rc, @output) = $test_baseline->remove;
+
+ $status += $rc;
+
+ $log->log($_) for @output;
+
+ $log->msg('Rebasing ' . $test_intstream->name . ' to remove INITIAL baseline');
+
+ $status += RebaseStream(
+ $test_intstream,
+ ' -dbaseline tc.component_INITIAL' . '@' . $test_intstream->pvob->tag .
+ ' -view ' . $test_intview->name . ' -complete',
+ );
+
+ $log->msg('Removing ' . $test_component->name . ' from ' . $test_project->name);
+
+ ($rc, @output) = $test_project->change(
+ '-dmodcomp ' . $test_component->name . '@' . $test_project->pvob->tag
+ );
+
+ $status += $rc;
+
+ $log->log($_) for @output;
+
+ $log->msg('Removing ' . $test_component->name);
+
+ ($rc, @output) = $test_component->remove;
+
+ $status += $rc;
+
+ $log->log($_) for @output;
+
+ $status += DestroyView($test_intview);
+
+ $log->msg('Removing '. $test_devstream->name);
+
+ ($rc, @output) = $test_devstream->remove;
+
+ $status += $rc;
+
+ $log->log($_) for @output;
+
+ $log->msg('Removing ' . $test_intstream->name);
+
+ ($rc, @output) = $test_intstream->remove;
+
+ $status += $rc;
+
+ $log->log($_) for @output;
+
+ $log->msg('Removing ' . $test_project->name);
+
+ ($rc, @output) = $test_project->remove;
+
+ $status += $rc;
+
+ $log->log($_) for @output;
+
+ $log->msg('Removing ' . $test_folder->name);
+
+ ($rc, @output) = $test_folder->remove;
+
+ $status += $rc;
+
+ $log->log($_) for @output;
+
+ $log->msg('Removing ' . $test_pvob->name);
+
+ ($rc, @output) = DestroyVob($test_pvob);
+
+ $log->log($_) for @output;
return $status;
} # CleanupUCM
sub SetupTest($$) {
my ($vob_tag, $view_tag) = @_;
-
+
my ($status, @output);
$log->msg('Setup test environment');
($status, @output) = $Clearcase::CC->execute("cd $dir");
if ($status != 0) {
- $log->log($_) for (@output);
+ $log->log($_) for @output;
} # if
return $status;
$log->msg("Creating UCM Pvob $Clearcase::VOBTAG_PREFIX/tc.pvob");
($status, $test_pvob) = CreatePvob("$Clearcase::VOBTAG_PREFIX/tc.pvob");
-
+
return $status;
} # SetupUCMTest
sub CreateUCMProject() {
# Get the root folder to put this project into (may create folders later)
- my $folder = Clearcase::UCM::Folder->new('tc.folder', $test_pvob);
+ $test_folder = Clearcase::UCM::Folder->new('tc.folder', $test_pvob);
- $test_project = Clearcase::UCM::Project->new('tc.project', $folder, $test_pvob);
+ $test_project = Clearcase::UCM::Project->new('tc.project', $test_folder, $test_pvob);
+ $test_project->remove if $test_project->exists;
+
$log->msg('Creating UCM Project tc.project');
- my ($status, @output) = $test_project->create();
+ my ($status, @output) = $test_project->create;
- $log->log($_) for (@output);
-
- push @ucmobjs, $test_project unless $status;
+ $log->log($_) for @output;
return $status;
} # CreateUCMProject
my ($status, @output) = $test_intstream->create($test_project, '-integration');
- $log->log($_) for (@output);
-
- push @ucmobjs, $test_intstream unless $status;
+ $log->log($_) for @output;
return $status;
} # CreateUCMIntStream
my ($status, @output) = $test_devstream->create($test_project);
- $log->log($_) for (@output);
-
- push @ucmobjs, $test_devstream unless $status;
+ $log->log($_) for @output;
return $status;
-} # CreateUCMIntStream
+} # CreateUCMDevStream
sub CreateUCMComponent() {
$test_component = Clearcase::UCM::Component->new('tc.component', $test_pvob);
"$Clearcase::VIEWTAG_PREFIX/" . $test_intview->tag . $test_vob->tag
);
- $log->log($_) for (@output);
-
- push @ucmobjs, $test_component unless $status;
+ $log->log($_) for @output;
return $status;
} # CreateUCMComponent
' ' . $test_project->name . '@' . $test_pvob->tag
);
- $log->log($_) for (@output);
+ $log->log($_) for @output;
return $status;
} # AddModifiableCOmponent
'-stream ' . $test_intstream->name . '@' . $test_pvob->tag
);
- $log->log($_) for (@output);
-
- push @ucmobjs, $test_intview unless $status;
+ $log->log($_) for @output;
$test_intview->start unless $status;
'-stream ' . $test_devstream->name . '@' . $test_pvob->tag
);
- $log->log($_) for (@output);
-
- push @ucmobjs, $test_devview unless $status;
+ $log->log($_) for @output;
$test_devview->start unless $status;
my ($status, @output) = $test_baseline->create($test_intview, undef, '-identical');
- $log->log($_) for (@output);
-
- push @ucmobjs, $test_baseline unless $status;
+ $log->log($_) for @output;
return $status;
} # CreateUCMBaseline
my ($status, @output) = $test_activity->create($test_devstream, 'A UCM Test Activity');
- $log->log($_) for (@output);
-
- push @ucmobjs, $test_activity unless $status;
+ $log->log($_) for @output;
return $status;
} # CreateUCMActivity
-sub RebaseStream($$;$) {
- my ($stream, $baseline, $opts) = @_;
+sub RebaseStream($$) {
+ my ($stream, $opts) = @_;
- my ($status, @output) = $stream->rebase($baseline, $opts);
+ my ($status, @output) = $stream->rebase($opts);
- $log->log($_) for (@output);
+ $log->log($_) for @output;
return $status;
} # RebaseStream
-sub RecommendBaseline($) {
- my ($baseline) = @_;
+sub RecommendBaseline($$) {
+ my ($stream, $baseline) = @_;
- my ($status, @output) = $test_intstream->recommend($baseline);
+ my ($status, @output) = $stream->recommend($baseline);
- $log->log($_) for (@output);
+ $log->log($_) for @output;
return $status;
} # RecommentBaseline
$status += CreateUCMDevView;
$status += CreateUCMComponent;
$status += AddModifiableComponent;
- $status += RebaseStream($test_intstream, 'tc.component_INITIAL', '-complete');
- $status += RecommendBaseline('tc.component_INITIAL');
+ $status += RebaseStream($test_intstream, '-baseline tc.component_INITIAL -complete');
+ $status += RecommendBaseline($test_intstream, 'tc.component_INITIAL');
$status += CreateUCMBaseline;
- $status += RebaseStream($test_devstream, 'tc.baseline', '-complete');
+ $status += RebaseStream($test_devstream, '-baseline tc.baseline -complete');
+ $status += RecommendBaseline($test_devstream, 'tc.baseline');
$status += CreateUCMActivity;
-
+
$log->msg("$script: End UCM Clearcase Tests");
return $status;
} # if
if ($status != 0) {
- $log->err("$script Failed (UCM Clearcase)");
+ $log->err("$script: Failed (UCM Clearcase)");
} else {
$log->msg("$script: Passed (UCM Clearcase)");
} # if
use lib "$FindBin::Bin/../lib";
use Clearquest;
+use Clearcase::View;
+use Clearcase::UCM::Activity;
+use Clearcase::UCM::Stream;
+use Clearcase::UCM::Project;
+use Clearcase::UCM::Pvob;
+use DateUtils;
use Display;
use Logger;
use TimeUtils;
use Utils;
-my ($cq, %opts, $log);
+my ($cq, %opts, $log, $createView, $test_pvob, $test_project);
-sub displayRecord (%) {
+my $status = 0;
+my $project = 'tc.project';
+
+sub displayRecord(%) {
my (%record) = @_;
- $log->msg ('-' x 79);
+ $log->msg('-' x 79);
for (keys %record) {
- $log->msg ("$_: ", 1);
+ $log->msg("$_: ", 1);
if (ref $record{$_} eq 'ARRAY') {
- $log->msg (join ", ", @{$record{$_}});
+ $log->msg(join ", ", @{$record{$_}});
} elsif ($record{$_}) {
- $log->msg ($record{$_});
+ $log->msg($record{$_});
} else {
- $log->msg ('<undef>');
+ $log->msg('<undef>');
} # if
} # for
return;
} # displayRecord
-sub displayResults (@) {
+sub displayResults(@) {
my (@records) = @_;
if (@records) {
displayRecord %$_ foreach (@records);
} else {
- $log->msg ('Did not find any records');
+ $log->msg('Did not find any records');
} # if
return;
} # displayResults
-sub testGetRecord ($$;@) {
+sub GetRecord($$;@) {
my ($table, $key, @fields) = @_;
- my $startTime = time;
-
- $log->msg ("Testing get table: $table key: $key");
-
- displayRecord $cq->get ($table, $key, @fields);
-
- display_duration $startTime, $log;
+ $log->msg("Gettng table: $table key: $key");
+
+ my %record = $cq->get($table, $key, @fields);
+
+ if ($cq->checkErr) {
+ $log->err($cq->errmsg);
+ } else {
+ displayRecord %record;
+ } # if
- return;
-} # testGetRecord
+ return $cq->error;
+} # GetRecord
-sub testFindRecord ($$;@) {
+sub FindRecord($$;@) {
my ($table, $condition, @fields) = @_;
- my $startTime = time;
+ my $status;
- $log->msg ("Testing find table: $table condition: $condition");
+ $log->msg("Finding table: $table condition: $condition");
- my ($result, $nbrRecs) = $cq->find ($table, $condition, @fields);
+ my ($result, $nbrRecs) = $cq->find($table, $condition, @fields);
- $log->msg ("$nbrRecs records qualified");
+ $log->msg("$nbrRecs records qualified");
while (my %record = $cq->getNext($result)) {
- displayRecord %record;
+ unless ($cq->error) {
+ # Store away the createView.pl script location
+ $createView = $record{ws_cr_view} if $table eq 'Platform_Options';
+
+ displayRecord %record;
+
+ $status += $cq->error;
+ } # unless
} # while
- display_duration $startTime, $log;
-
- return;
-} # testFindRecord
+ return $status
+} # FindRecord
-sub testModifyRecord ($$;%) {
+sub ModifyRecord($$;%) {
my ($table, $key, %update) = @_;
- my $startTime = time;
-
- $log->msg ("Testing modify table: $table key: $key");
-
- $cq->modify ($table, $key, undef, \%update);
+ $log->msg("Modifying table: $table key: $key");
- $cq->checkErr;
+ $cq->modify($table, $key, undef, \%update);
- display_duration $startTime, $log;
+ $log->err($cq->errmsg) if $cq->checkErr;
- return;
-} # testModifyRecord
+ return $cq->error;
+} # ModifyRecord
-sub testChangeState ($$) {
- my ($table, $key) = @_;
+sub AssignWOR($) {
+ my ($key) = @_;
- my $startTime = time;
+ my %record = $cq->get('WOR', $key, ('State'));
- my %record = $cq->get ($table, $key, ('State'));
+ return $cq->error if $cq->checkErr("Unable to find WOR where key = $key");
- $cq->checkErr ("Unable to find $table where key = $key");
-
- return if $cq->error;
-
my ($action, %update);
- if ($record{State} eq 'Assigned') {
- $action = 'AdminAssignToSubmit';
- $update{Stability_Issue} = 'User Fault';
- } else {
- $action = 'Assign';
- $update{Stability_Issue} = 'Assert';
+ if ($record{State} ne 'Submitted') {
+ $log->err("Cannot assign $key - not in submitted state");
+
+ return 1;
} # if
+
+ $action = 'Assign';
+ $update{PlannedStart} = Today2SQLDatetime;
+ $update{ucm_project} = $project;
- $log->msg ("Testing change state table: $table key: $key action: $action");
-
- $cq->modify ($table, $key, $action, \%update);
-
- $cq->checkErr;
-
- display_duration $startTime, $log;
+ $log->msg("Testing change WOR state of $key action: $action");
- return;
-} # testChangeState
+ $cq->modify('WOR', $key, $action, \%update);
+
+ $log->err($cq->errmsg) if $cq->checkErr;
+
+ return $cq->error;
+} # AssignWOR
-sub testAddRecord ($%) {
- my ($table, %record) = @_;
+sub ActivateWOR($) {
+ my ($key) = @_;
- my $startTime = time;
+ my %record = $cq->get('WOR', $key, ('State'));
- $log->msg ("Testing adding table: $table");
+ return $cq->error if $cq->checkErr("Unable to find WOR where key = $key");
- $cq->add ($table, \%record);
+ my ($action, %update);
- $cq->checkErr;
+ if ($record{State} ne 'Assessing') {
+ $log->err("Cannot activate $key - not in Assessing state");
+
+ return 1;
+ } # if
+
+ $action = 'Activate';
- display_duration $startTime, $log;
+ $log->msg("Testing change WOR state of $key action: $action");
- return;
-} # testAddRecord
+ $cq->modify('WOR', $key, $action);
-sub testDeleteRecord ($$) {
- my ($table, $key) = @_;
-
- my $startTime = time;
+ $log->err($cq->errmsg) if $cq->checkErr;
+
+ return $cq->error;
+} # ActivateWOR
+
+sub AddRecord($$;$$) {
+ my ($table, $record, $ordering, $returnField) = @_;
- $log->msg ("Testing deleting table: $table key: $key");
+ $returnField ||= 'id';
+
+ $log->msg("Adding table: $table");
- $cq->delete ($table, $key);
+ my $dbid = $cq->add($table, $record, @$ordering);
- $cq->checkErr;
+ if ($cq->checkErr) {
+ $log->err($cq->errmsg);
- display_duration $startTime, $log;
+ return;
+ } else {
+ my %record = $cq->getDBID($table, $dbid, ($returnField));
+
+ return $record{$returnField};
+ } # if
+} # AddRecord
+
+sub DeleteRecord($$) {
+ my ($table, $key) = @_;
- return;
-} # testDeleteRecord
+ $log->msg("Deleting table: $table key: $key");
+
+ $cq->delete($table, $key);
+
+ $log->err($cq->errmsg) if $cq->checkErr;
+
+ return $cq->error;
+} # DeleteRecord
+
+sub CreateWOR() {
+ # Try to add a WOR - the following fields are required and some may need
+ # to be added to stateless records in order for this to succeed. Once you
+ # can add a WOR through the Clearquest client successfully you should be
+ # able to come up with the values of these required fields. There are,
+ # however, sometimes when you need to specify ordering to have some fields
+ # set before other fields.
+ my %WOR = (
+ headline => 'Test WOR',
+ description => 'This is a test WOR created programmatically',
+ project => 'MUOS',
+ RCLC_name => 'Test RCLC',
+ Prod_Arch1 => 'testcode : N/A',
+ work_product_name => '10 - Software',
+ Engr_target => 'Test Engineering Target',
+ work_code_name => 'RAN-RW2',
+ );
+
+ return AddRecord('WOR', \%WOR, ['project', 'Prod_Arch1']);
+} # CreateWOR
+
+sub CreateView($) {
+ my ($WORID) = @_;
+
+ my ($status, @output) = Execute "$createView $WORID 2>&1";
+
+ $log->log($_) for @output;
+
+ return $status;
+} # CreateView
+
+sub Cleanup($) {
+ my ($WORID) = @_;
+
+ my ($status, @output) = (0, ());
+ my $rc = 0;
+
+ # Remove views created
+ my @tags = (
+ "$ENV{USER}_${project}_intview",
+ "$ENV{USER}_${WORID}_devview",
+ );
+
+ for (@tags) {
+ my $view = Clearcase::View->new($_);
+
+ $log->msg('Removing ' . $view->name);
+
+ ($rc, @output) = $view->remove;
+
+ $status++ if $rc;
+
+ $log->log($_) for @output;
+ } # for
+
+ # Remove streams that were created
+ my @streams = (
+ "$ENV{USER}_${WORID}_${project}_dev",
+ );
+
+ for my $stream (@streams) {
+ my $activity = Clearcase::UCM::Activity->new($WORID, $test_pvob);
+
+ $log->msg('Removing ' . $activity->name);
+
+ ($rc, @output) = $activity->remove;
+
+ $status += $rc;
+
+ $log->log($_) for @output;
+
+ # Streams are downshifted
+ my $stream = Clearcase::UCM::Stream->new(lc $stream, $test_pvob);
+
+ $log->msg('Removing ' . $stream->name);
+
+ ($rc, @output) = $stream->remove;
+
+ $log->log($_) for @output;
+
+ $status++ if $rc;
+ } # for
+
+ return $status;
+} # Cleanup
## Main
-GetOptions (
+GetOptions(
\%opts,
usage => sub { Usage },
verbose => sub { set_verbose },
debug => sub { set_debug },
+ 'verbose',
+ 'debug',
+ 'usage',
'get',
'add',
'modify',
my $processStartTime = time;
+# Since we are creating private vobs (to avoid complications with having to
+# know and code the registry password when making public vobs), we'll simply
+# change $Clearcase::VOBTAG_PREFIX
+$Clearcase::VOBTAG_PREFIX = $ENV{TMP} || '/tmp';
+
local $| = 1;
# Translate any options to ones that the lib understands
-$opts{CQ_USERNAME} = delete $opts{username};
-$opts{CQ_PASSWORD} = delete $opts{password};
-$opts{CQ_DATABASE} = delete $opts{database};
-$opts{CQ_DBSET} = delete $opts{dbset};
-$opts{CQ_SERVER} = delete $opts{server};
-$opts{CQ_PORT} = delete $opts{port};
-$opts{CQ_MODULE} = delete $opts{module};
+map {$opts{$_} = $Clearquest::OPTS{$_}} keys %Clearquest::OPTS;
+
+$opts{CQ_USERNAME} = delete $opts{username} if $opts{username};
+$opts{CQ_PASSWORD} = delete $opts{password} if $opts{password};
+$opts{CQ_DATABASE} = delete $opts{database} if $opts{database};
+$opts{CQ_DBSET} = delete $opts{dbset} if $opts{dbset};
+$opts{CQ_SERVER} = delete $opts{server} if $opts{server};
+$opts{CQ_PORT} = delete $opts{port} if $opts{port};
+$opts{CQ_MODULE} = delete $opts{module} if $opts{module};
# If nothing is set then do everything
unless ($opts{get} or
$log = Logger->new;
-$cq = Clearquest->new (%opts);
+$cq = Clearquest->new(%opts);
-$log->msg ('Connecting to Clearquest database ' . $cq->connection, 1);
+$log->msg('Connecting to Clearquest database ' . $cq->connection . '...', 1);
unless ($cq->connect) {
- $cq->checkErr ('Unable to connect to database ' . $cq->connection, undef, $log);
+ $cq->checkErr('Unable to connect to database ' . $cq->connection, undef, $log);
if ($cq->module eq 'client') {
- $log->msg ('Unable to connect to server ' . $cq->server () . ':' . $cq->port ());
+ $log->msg('Unable to connect to server ' . $cq->server() . ':' . $cq->port());
} # if
exit $cq->error;
} else {
- $log->msg ('');
+ $log->msg('connected');
display_duration $startTime, $log;
} # unless
-$cq->setOpts (emptyStringForUndef => 1);
+$cq->setOpts(emptyStringForUndef => 1);
+# Check a few required stateless records
if ($opts{get}) {
# Get record by key
- testGetRecord 'WOR', 'XTST100000019';
+ $status += GetRecord 'Project', 'MUOS- EC';
# Get record by condition
- testFindRecord 'WOR', 'Owner = "ccadm"';
-
- # Get record by key with field list
- testFindRecord 'WOR', 'Owner = "ccadm"', ('id', 'Headline', 'Owner');
+ $status += FindRecord 'Platform_Options', 'Platform = "Unix"';
# Get record by condition with field list
- testFindRecord 'WOR', 'Owner = "ccadm"', ('id', 'Headline', 'Owner');
+ $status += FindRecord 'Roles', 'Rank = "Supervisor"', ('user_name', 'teams.Name', 'Rank');
} # if
if ($opts{add}) {
- # Add a record
- testAddRecord 'Component', (
- Name => $FindBin::Script,
- Description => 'This is a test component',
+ my %component = (
+ Name => $FindBin::Script,
+ Description => 'This is a test component',
);
+
+ AddRecord('Component', \%component, undef, 'name');
+
+ $status++ if $cq->error;
} # if
if ($opts{modify}) {
# Modify a record
my $newDescription = 'This is a modified test component';
- testModifyRecord ('Component', $FindBin::Script, (Description => $newDescription));
+ $status += ModifyRecord('Component', $FindBin::Script, (Description => $newDescription));
# Make sure the modification happened
- my %component = $cq->get ('Component', $FindBin::Script, ('Description'));
+ my %component = $cq->get('Component', $FindBin::Script, ('Description'));
- if ($component{Description} ne $newDescription) {
- $log->err ('Modification of Component.Description failed!');
- } # if
+ $log->err('Modification of Component.Description failed!')
+ if $component{Description} ne $newDescription;
} # if
+DeleteRecord 'Component', $FindBin::Script if $opts{add};
+
+$log->msg('Enable tc.project for integration with Clearquest');
+
+$test_pvob = Clearcase::UCM::Pvob->new("$Clearcase::VOBTAG_PREFIX/tc.pvob");
+$test_project = Clearcase::UCM::Project->new('tc.project', 'tc.folder', $test_pvob);
+
+my ($rc, @output) = $test_project->change('-force -crmenable XTST1');
+
+$status += $rc;
+
+$log->log($_) for @output;
+
+$log->msg('Create WOR');
+
+my $WORID = CreateWOR;
+
+unless ($WORID) {
+ $status++;
+
+ exit $status;
+} else {
+ $log->msg("Created WOR $WORID");
+} # unless
+
if ($opts{change}) {
- # Change State
- testChangeState 'Defect', 'apd00000034';
+ $status += AssignWOR $WORID;
+ $status += ActivateWOR $WORID;
} # if
-if ($opts{add}) {
- # Delete that record
- testDeleteRecord 'Component', $FindBin::Script;
+$status += CreateView $WORID;
+
+$status += Cleanup($WORID);
+
+if ($status) {
+ $log->err('Clearquest tests FAILED');
+} else {
+ $log->msg('Clearquest tests PASSED');
} # if
-$log->msg ('Total process time ', 1);
+$log->msg('Total process time ', 1);
display_duration $processStartTime, $log;
+
+exit $status;
projects / clearscm.git / commitdiff