From: Andrew DeFaria Date: Thu, 26 Apr 2018 04:12:24 +0000 (-0700) Subject: More changes from GD development X-Git-Url: https://defaria.com/gitweb/?a=commitdiff_plain;h=6cf0d2cda8a454c46c0cd44fc2edd2093cd8c83a;p=clearscm.git More changes from GD development --- diff --git a/aws/Display.pyc b/aws/Display.pyc deleted file mode 100644 index efbc9ff..0000000 Binary files a/aws/Display.pyc and /dev/null differ diff --git a/cc/etf.pl b/cc/etf.pl index 5975409..bae1728 100755 --- a/cc/etf.pl +++ b/cc/etf.pl @@ -70,7 +70,7 @@ trigger. 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. @@ -167,8 +167,8 @@ sub reportDir (%) { $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 @@ -231,7 +231,7 @@ sub processDir ($) { 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 @@ -287,7 +287,7 @@ sub processDir ($) { 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 @@ -380,7 +380,7 @@ sub processDirs ($) { close $dirs or $log->err ("Unable to close $cmd - $!"); - + return $total{'evil twins'}; } # processDirs diff --git a/cc/testcc.conf b/cc/testcc.conf deleted file mode 100644 index a2d4c2b..0000000 --- a/cc/testcc.conf +++ /dev/null @@ -1,21 +0,0 @@ -################################################################################ -# -# 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 diff --git a/cc/testcc.pl b/cc/testcc.pl deleted file mode 100644 index 659e7ef..0000000 --- a/cc/testcc.pl +++ /dev/null @@ -1,562 +0,0 @@ -#!/bin/bin/perl - -=pod - -=head1 NAME $RCSfile: testcc.pl,v $ - -Test Clearcase - -=head1 VERSION - -=over - -=item Author - -Andrew DeFaria - -=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 ] [-vi|ewstore ] - [-vo|bstore ] - - Where: - -u|sage: Displays usage - - -ve|rbose: Be verbose - -d|ebug: Output debug messages - - -c|onfig : 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 - -L - -L - -L - -=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 - -
-Clearcase
-Element
-View
-Views
-Vob
-Vobs
-DateUtils
-Display
-GetConfig
-Logger
-OSDep
-Utils
-
- -=end html - -=head1 BUGS AND LIMITATIONS - -There are no known bugs in this script - -Please report problems to Andrew DeFaria . - -=head1 LICENSE AND COPYRIGHT - -Copyright (c) 2010, ClearSCM, Inc. All rights reserved. - -=cut diff --git a/lib/Clearcase.pm b/lib/Clearcase.pm index 651d33c..a845184 100644 --- a/lib/Clearcase.pm +++ b/lib/Clearcase.pm @@ -80,7 +80,7 @@ use IPC::Open3; use OSDep; use Display; -my ($clearpid, $clearin, $clearout, $oldHandler); +my ($clearpid, $clearin, $clearout, $oldHandler, $cleartool); our $VIEW_DRIVE = 'M'; our $VOB_MOUNT = 'vob'; @@ -578,13 +578,13 @@ Array of output lines from the cleartool command execution. # 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 diff --git a/lib/Clearcase/UCM/Baseline.pm b/lib/Clearcase/UCM/Baseline.pm index bf67d94..389fd63 100644 --- a/lib/Clearcase/UCM/Baseline.pm +++ b/lib/Clearcase/UCM/Baseline.pm @@ -53,7 +53,7 @@ sub _processOpts(%) { my ($self, %opts) = @_; my $opts; - + for (keys %opts) { if ($_ eq 'cq' or $_ eq 'cqe' or $_ eq 'force' or $_ eq 'nc') { $opts .= "-$_ "; @@ -61,8 +61,7 @@ sub _processOpts(%) { $opts .= "-$_ $opts{$_}"; } # if } # for - - + return $opts; } # _processOpts @@ -107,13 +106,13 @@ Returns: name => $baseline, pvob => $pvob, }, $class; # bless - + return $class; } # new sub name() { my ($self) = @_; - + =pod =head2 name @@ -151,7 +150,7 @@ Returns: sub pvob() { my ($self) = @_; - + =pod =head2 pvob @@ -186,7 +185,7 @@ Returns: return $self->{pvob}; } # pvob - + sub create($;$$$) { my ($self, $view, $comment, $opts) = @_; @@ -229,9 +228,9 @@ Ouput from cleartool =for html =cut - + $opts ||= ''; - + $comment = Clearcase::_setComment $comment; return $Clearcase::CC->execute( @@ -281,7 +280,7 @@ Remember to check status method for error, and/or output method for output. =cut $opts ||= ''; - + return $Clearcase::CC->execute( "rmbl $opts -force " . $self->{name} . '@' . $self->{pvob}->name ); @@ -332,7 +331,7 @@ Hash of attributes for this baseline sub diff($;$$) { my ($self, $type, $baseline, %opts) = @_; - + =pod =head2 diff @@ -390,11 +389,11 @@ value. 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') { @@ -402,30 +401,30 @@ value. . "just "; } # 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 diff --git a/lib/Clearcase/UCM/Component.pm b/lib/Clearcase/UCM/Component.pm index 640cecb..9727763 100644 --- a/lib/Clearcase/UCM/Component.pm +++ b/lib/Clearcase/UCM/Component.pm @@ -280,7 +280,7 @@ Ouput from cleartool =cut return $Clearcase::CC->execute - ('rmcomp -f ' . $self->{name} . '@' . $self->{pvob}->name); + ('rmcomp -f ' . $self->name . '@' . $self->pvob->tag); } # remove sub exists() { diff --git a/lib/Clearcase/UCM/Folder.pm b/lib/Clearcase/UCM/Folder.pm index 26661a5..d606d62 100644 --- a/lib/Clearcase/UCM/Folder.pm +++ b/lib/Clearcase/UCM/Folder.pm @@ -392,7 +392,7 @@ Output from cleartool =cut return $Clearcase::CC->execute( - 'rmfolder -f ' . $self->{name} . "\@" . $self->{pvob}); + 'rmfolder -f ' . $self->{name} . "\@" . $self->{pvob}->tag); } # rmfolder sub updateFolderInfo () { diff --git a/lib/Clearcase/UCM/Project.pm b/lib/Clearcase/UCM/Project.pm index 8db0f86..350df52 100644 --- a/lib/Clearcase/UCM/Project.pm +++ b/lib/Clearcase/UCM/Project.pm @@ -270,8 +270,55 @@ Ouput from cleartool =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
+ +=over + +=item opts + +Options + +=for html
+ +Returns: + +=for html
+ +=over + +=item $status + +Status from cleartool + +=item @output + +Ouput from cleartool + +=back + +=for html
+ +=cut + + $opts ||= ''; + + return $Clearcase::CC->execute + ("chproject $opts " . $self->{name} . "\@" . $self->{pvob}->name); +} # change sub exists() { my ($self) = @_; diff --git a/lib/Clearcase/UCM/Stream.pm b/lib/Clearcase/UCM/Stream.pm index 496bee3..618e661 100644 --- a/lib/Clearcase/UCM/Stream.pm +++ b/lib/Clearcase/UCM/Stream.pm @@ -92,13 +92,13 @@ Returns: name => $name, pvob => $pvob, }, $class; # bless - + return $class; } # new - + sub name () { my ($self) = @_; - + =pod =head2 name @@ -136,7 +136,7 @@ Returns: sub pvob () { my ($self) = @_; - + =pod =head2 pvob @@ -171,7 +171,7 @@ Returns: return $self->{pvob}; } # pvob - + sub create ($;$) { my ($self, $project, $opts) = @_; @@ -276,7 +276,7 @@ Ouput from cleartool } # rmStream sub rebase($;$) { - my ($self, $baseline, $opts) = @_; + my ($self, $opts) = @_; =pod @@ -324,8 +324,7 @@ Ouput from cleartool $opts ||= ''; - $opts .= ' -baseline ' . $baseline . - ' -stream ' . $self->name . '@' . $self->{pvob}->name; + $opts .= ' -stream ' . $self->name . '@' . $self->{pvob}->name; return $Clearcase::CC->execute("rebase $opts"); } # rebase @@ -378,6 +377,52 @@ Ouput from cleartool ); } # recommend +sub nrecommended() { + my ($self) = @_; + +=pod + +=head2 nrecommend + +Changes stream to not have a recommended baseline + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item $status + +Status from cleartool + +=item @output + +Ouput from cleartool + +=back + +=for html
+ +=cut + + return $Clearcase::CC->execute( + 'chstream -nrecommended ' . $self->name . '@' . $self->{pvob}->tag + ); +} # nrecommended + sub baselines () { my ($self) = @_; @@ -416,19 +461,19 @@ An array of baseline objects for this stream =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 diff --git a/lib/Clearquest.pm b/lib/Clearquest.pm index a31cb88..b863874 100644 --- a/lib/Clearquest.pm +++ b/lib/Clearquest.pm @@ -1344,6 +1344,8 @@ Last error =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}; @@ -1846,8 +1848,6 @@ Hash of name/value pairs for all the fields in $table @fields = $self->_setFields ($table, @fields); - return if @fields; - my $entity; eval {$entity = $self->{session}->GetEntityByDbId ($table, $dbid)}; @@ -2312,7 +2312,9 @@ The $errmsg, if any, when performing the update (empty string for success) =cut $action ||= 'Modify'; - my %values = %$values; + my %values = (); + + %values = %$values if $values; my $entity; diff --git a/rc/bash_login b/rc/bash_login index 39677cc..8207eae 100644 --- a/rc/bash_login +++ b/rc/bash_login @@ -56,7 +56,11 @@ if [ $ARCHITECTURE = 'sun' ]; then else id=id tr=tr - TERM=xterm + if [ $ARCHITECTURE = 'cygwin' ]; then + TERM=cygwin + else + TERM=xterm + fi fi # Set colors diff --git a/rc/clearcase b/rc/clearcase index 3317a01..14a3d88 100644 --- a/rc/clearcase +++ b/rc/clearcase @@ -15,7 +15,10 @@ # ################################################################################ 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 diff --git a/rc/client_scripts/GD b/rc/client_scripts/GD index 2d00db9..b1d2f56 100644 --- a/rc/client_scripts/GD +++ b/rc/client_scripts/GD @@ -60,3 +60,6 @@ append_to_path "/c/Program Files/IBM/RationalSDLC/Clearquest/cqcli/bin" 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 diff --git a/rc/functions b/rc/functions index 1f8dcdc..ec2f311 100644 --- a/rc/functions +++ b/rc/functions @@ -119,6 +119,7 @@ function set_prompt { "$TERM" = "2392A" -o \ "$TERM" = "dtterm" -o \ "$TERM" = "vt100" -o \ + "$TERM" = "cygwin" -o \ "$TERM" = "xterm" -o \ "$TERM" = "xtermc" -o \ "$TERM" = "xterm-256color" -o \ @@ -132,6 +133,7 @@ function set_prompt { fi if [ "$TERM" = "vt100" -o \ + "$TERM" = "cygwin" -o \ "$TERM" = "xterm" -o \ "$TERM" = "xtermc" -o \ "$TERM" = "xterm-256color" -o \ diff --git a/rc/set_colors b/rc/set_colors index b9e5425..10bd8aa 100644 --- a/rc/set_colors +++ b/rc/set_colors @@ -30,6 +30,7 @@ if [ "$TERM" = "vt100" -o \ echo -e "${INVERSE}Inverse$NORMAL" fi elif [ "$TERM" = "dtterm" -o \ + "$TERM" = "cygwin" -o \ "$TERM" = "xterm" -o \ "$TERM" = "xtermc" ]; then NORMAL="$esc[0;39m" diff --git a/test/testclearcase.pl b/test/testclearcase.pl index 42e3152..512d372 100755 --- a/test/testclearcase.pl +++ b/test/testclearcase.pl @@ -58,7 +58,7 @@ use warnings; use Cwd; use FindBin; use Getopt::Long; -use Term::ANSIColor qw(:constants); +#use Term::ANSIColor qw(:constants); use lib "$FindBin::Bin/../lib"; @@ -89,8 +89,6 @@ use Utils; # Globals my $VERSION = '2.1'; -my (@ucmobjs, $order); - my ( $test_vob, $test_view, @@ -106,7 +104,7 @@ my ( $test_intview, ); -my ($vbs, $vws, %default_opts, %opts); +my (%default_opts, %opts); my ($script) = ($FindBin::Script =~ /^(.*)\.pl/); @@ -124,12 +122,12 @@ sub LogOpts() { 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 @@ -144,7 +142,7 @@ sub CreateVob($) { my ($status, @output) = $newvob->create($opts{vobhost}, "$opts{vobstore}/$vobname.vbs"); - $log->log($_) for (@output); + $log->log($_) for @output; return ($status, $newvob); } # CreateVob @@ -159,9 +157,7 @@ sub CreatePvob($) { #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 @@ -173,14 +169,14 @@ sub MountVob($) { # 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 @@ -200,7 +196,7 @@ sub DestroyVob($) { ($status, @output) = $vob->remove; - $log->log($_) for (@output); + $log->log($_) for @output; return $status; } # DestroyVob @@ -214,7 +210,7 @@ sub CreateView($) { my ($status, @output) = $view->create($opts{viewhost}, "$opts{viewstore}/$tag.vws"); - $log->log($_) for (@output); + $log->log($_) for @output; return ($status, $view); } # CreateView @@ -226,7 +222,7 @@ sub SetView($) { my ($status, @output) = $view->set; - $log->log($_) for (@output); + $log->log($_) for @output; return $status; } # SetView @@ -238,14 +234,14 @@ sub DestroyView($) { 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 @@ -267,7 +263,7 @@ sub CreateViewPrivateFiles(@) { close $file; } # for - + return; } # CreateViewPrivateFiles @@ -284,7 +280,7 @@ sub CheckOut($) { ($status, @output) = $newElement->checkout; - $log->log($_) for (@output); + $log->log($_) for @output; $log->err("Unable to check out $_", $status) if $status; } # for @@ -295,11 +291,11 @@ sub CheckOut($) { ($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 @@ -316,7 +312,7 @@ sub CheckIn($) { ($status, @output) = $newElement->checkin; - $log->log($_) for (@output); + $log->log($_) for @output; $log->err("Unable to check in $_", $status) if $status; } # for @@ -327,11 +323,11 @@ sub CheckIn($) { ($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 @@ -357,11 +353,11 @@ sub MakeElements(@) { 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 @@ -390,7 +386,7 @@ sub RunTests() { $log->msg("$script: Start Base Clearcase Tests"); $log->msg('Removing test files'); - unlink $_ for (@elements); + unlink $_ for @elements; $log->msg('Creating view private files'); @@ -443,31 +439,116 @@ sub Cleanup(;$$$) { } # 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'); @@ -514,7 +595,7 @@ sub SetupTest($$) { ($status, @output) = $Clearcase::CC->execute("cd $dir"); if ($status != 0) { - $log->log($_) for (@output); + $log->log($_) for @output; } # if return $status; @@ -526,23 +607,23 @@ sub SetupUCMTest() { $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 @@ -554,9 +635,7 @@ sub CreateUCMIntStream() { 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 @@ -568,12 +647,10 @@ sub CreateUCMDevStream() { 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); @@ -584,9 +661,7 @@ sub CreateUCMComponent() { "$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 @@ -597,7 +672,7 @@ sub AddModifiableComponent() { ' ' . $test_project->name . '@' . $test_pvob->tag ); - $log->log($_) for (@output); + $log->log($_) for @output; return $status; } # AddModifiableCOmponent @@ -612,9 +687,7 @@ sub CreateUCMIntView() { '-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; @@ -631,9 +704,7 @@ sub CreateUCMDevView() { '-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; @@ -647,9 +718,7 @@ sub CreateUCMBaseline() { 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 @@ -661,29 +730,27 @@ sub CreateUCMActivity() { 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 @@ -700,12 +767,13 @@ sub RunUCMTests() { $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; @@ -785,7 +853,7 @@ if ($opts{ucm}) { } # if if ($status != 0) { - $log->err("$script Failed (UCM Clearcase)"); + $log->err("$script: Failed (UCM Clearcase)"); } else { $log->msg("$script: Passed (UCM Clearcase)"); } # if diff --git a/test/testclearquest.pl b/test/testclearquest.pl index 9870e21..4197a87 100755 --- a/test/testclearquest.pl +++ b/test/testclearquest.pl @@ -117,165 +117,288 @@ use Getopt::Long; 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 (''); + $log->msg(''); } # 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', @@ -292,16 +415,23 @@ GetOptions ( 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 @@ -321,71 +451,103 @@ my $startTime = time; $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;