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 / blobdiff