7 =head1 NAME $RCSfile: testclearquest.pl,v $
9 Test the Clearquest libary
11 This script tests various functions of the Clearquest library
19 Andrew DeFaria <Andrew@ClearSCM.com>
27 Mon Nov 12 16:50:44 PST 2012
31 $Date: 2013/03/14 23:39:39 $
37 Usage: testclearquest.pl [-u|sage] [-v|erbose] [-d|ebug]
38 [-get] [-add] [-modify] [-change] [-delete]
39 [-username <username>] [-password <password>]
40 [-database <dbname>] [-dbset <dbset>]
41 [-module] [-server <server>] [-port <port>]
44 -usa|ge: Displays usage
46 -de|bug: Output debug messages
54 -use|rname: Username to open database with (Default: CQ_USERNAME or from
56 -p|assword: Password to open database with (Default: CQ_PASSWORD or from
58 -da|tabase: Database to open (Default: CQ_DATABASE or from config file)
59 -db|set: Database Set to use (Default: CQ_DBSET or from config file)
65 Options are keep in the cq.conf file in etc. They specify the default options
66 listed below. Or you can export the option name to the env(1) to override the
67 defaults in cq.conf. Finally you can programmatically set the options when you
68 call new by passing in a %parms hash. To specify the %parms hash key remove the
69 CQ_ portion and lc the rest.
71 =for html <blockquote>
77 Clearquest server to talk to (Default: From cq.conf)
81 Port to connect to (Default: From cq.conf)
85 The web host to contact with leading http:// (Default: From cq.conf)
89 Name of database to connect to (Default: From cq.conf)
93 User name to connect as (Default: From cq.conf)
97 Password for CQREST_USERNAME (Default: From cq.conf)
101 Database Set name (Default: From cq.conf)
111 use lib "$FindBin::Bin/../lib";
115 use Clearcase::UCM::Activity;
116 use Clearcase::UCM::Stream;
117 use Clearcase::UCM::Project;
118 use Clearcase::UCM::Pvob;
126 my ($cq, %opts, $log, $createView, $test_pvob, $test_project);
129 my $project = 'tc.project';
131 sub displayRecord(%) {
137 $log->msg("$_: ", 1);
139 if (ref $record{$_} eq 'ARRAY') {
140 $log->msg(join ", ", @{$record{$_}});
141 } elsif ($record{$_}) {
142 $log->msg($record{$_});
144 $log->msg('<undef>');
151 sub displayResults(@) {
155 displayRecord %$_ foreach (@records);
157 $log->msg('Did not find any records');
163 sub GetRecord($$;@) {
164 my ($table, $key, @fields) = @_;
166 $log->msg("Gettng table: $table key: $key");
168 my %record = $cq->get($table, $key, @fields);
171 $log->err($cq->errmsg);
173 displayRecord %record;
179 sub FindRecord($$;@) {
180 my ($table, $condition, @fields) = @_;
184 $log->msg("Finding table: $table condition: $condition");
186 my ($result, $nbrRecs) = $cq->find($table, $condition, @fields);
188 $log->msg("$nbrRecs records qualified");
190 while (my %record = $cq->getNext($result)) {
191 unless ($cq->error) {
192 # Store away the createView.pl script location
193 $createView = $record{ws_cr_view} if $table eq 'Platform_Options';
195 displayRecord %record;
197 $status += $cq->error;
204 sub ModifyRecord($$;%) {
205 my ($table, $key, %update) = @_;
207 $log->msg("Modifying table: $table key: $key");
209 $cq->modify($table, $key, undef, \%update);
211 $log->err($cq->errmsg) if $cq->checkErr;
219 my %record = $cq->get('WOR', $key, ('State'));
221 return $cq->error if $cq->checkErr("Unable to find WOR where key = $key");
223 my ($action, %update);
225 if ($record{State} ne 'Submitted') {
226 $log->err("Cannot assign $key - not in submitted state");
232 $update{PlannedStart} = Today2SQLDatetime;
233 $update{ucm_project} = $project;
235 $log->msg("Testing change WOR state of $key action: $action");
237 $cq->modify('WOR', $key, $action, \%update);
239 $log->err($cq->errmsg) if $cq->checkErr;
247 my %record = $cq->get('WOR', $key, ('State'));
249 return $cq->error if $cq->checkErr("Unable to find WOR where key = $key");
251 my ($action, %update);
253 if ($record{State} ne 'Assessing') {
254 $log->err("Cannot activate $key - not in Assessing state");
259 $action = 'Activate';
261 $log->msg("Testing change WOR state of $key action: $action");
263 $cq->modify('WOR', $key, $action);
265 $log->err($cq->errmsg) if $cq->checkErr;
270 sub AddRecord($$;$$) {
271 my ($table, $record, $ordering, $returnField) = @_;
273 $returnField ||= 'id';
275 $log->msg("Adding table: $table");
277 my $dbid = $cq->add($table, $record, @$ordering);
280 $log->err($cq->errmsg);
284 my %record = $cq->getDBID($table, $dbid, ($returnField));
286 return $record{$returnField};
290 sub DeleteRecord($$) {
291 my ($table, $key) = @_;
293 $log->msg("Deleting table: $table key: $key");
295 $cq->delete($table, $key);
297 $log->err($cq->errmsg) if $cq->checkErr;
303 # Try to add a WOR - the following fields are required and some may need
304 # to be added to stateless records in order for this to succeed. Once you
305 # can add a WOR through the Clearquest client successfully you should be
306 # able to come up with the values of these required fields. There are,
307 # however, sometimes when you need to specify ordering to have some fields
308 # set before other fields.
310 headline => 'Test WOR',
311 description => 'This is a test WOR created programmatically',
313 RCLC_name => 'Test RCLC',
314 Prod_Arch1 => 'testcode : N/A',
315 work_product_name => '10 - Software',
316 Engr_target => 'Test Engineering Target',
317 work_code_name => 'RAN-RW2',
320 return AddRecord('WOR', \%WOR, ['project', 'Prod_Arch1']);
326 my ($status, @output) = Execute "$createView $WORID 2>&1";
328 $log->log($_) for @output;
336 my ($status, @output) = (0, ());
339 # Remove views created
341 "$ENV{USER}_${project}_intview",
342 "$ENV{USER}_${WORID}_devview",
346 my $view = Clearcase::View->new($_);
348 $log->msg('Removing ' . $view->name);
350 ($rc, @output) = $view->remove;
354 $log->log($_) for @output;
357 # Remove streams that were created
359 "$ENV{USER}_${WORID}_${project}_dev",
362 for my $stream (@streams) {
363 my $activity = Clearcase::UCM::Activity->new($WORID, $test_pvob);
365 $log->msg('Removing ' . $activity->name);
367 ($rc, @output) = $activity->remove;
371 $log->log($_) for @output;
373 # Streams are downshifted
374 my $stream = Clearcase::UCM::Stream->new(lc $stream, $test_pvob);
376 $log->msg('Removing ' . $stream->name);
378 ($rc, @output) = $stream->remove;
380 $log->log($_) for @output;
391 usage => sub { pod2usage },
392 help => sub { pod2usage (-verbose => 2)},
393 verbose => sub { set_verbose },
394 debug => sub { set_debug },
406 my $processStartTime = time;
408 # Since we are creating private vobs (to avoid complications with having to
409 # know and code the registry password when making public vobs), we'll simply
410 # change $Clearcase::VOBTAG_PREFIX
411 if ($ARCHITECTURE !~ /win/i) {
412 $Clearcase::VOBTAG_PREFIX = $ENV{TMP} || '/tmp';
417 # Translate any options to ones that the lib understands
418 map {$opts{$_} = $Clearquest::OPTS{$_}} keys %Clearquest::OPTS;
420 $opts{CQ_USERNAME} = delete $opts{username} if $opts{username};
421 $opts{CQ_PASSWORD} = delete $opts{password} if $opts{password};
422 $opts{CQ_DATABASE} = delete $opts{database} if $opts{database};
423 $opts{CQ_DBSET} = delete $opts{dbset} if $opts{dbset};
424 $opts{CQ_SERVER} = delete $opts{server} if $opts{server};
425 $opts{CQ_PORT} = delete $opts{port} if $opts{port};
426 $opts{CQ_MODULE} = delete $opts{module} if $opts{module};
428 # If nothing is set then do everything
429 unless ($opts{get} or
435 $opts{get} = $opts{add} = $opts{modify} = $opts{change} = 1;
438 # If we are testing add or delete then toggle on the other one
439 $opts{delete} = 1 if $opts{add};
440 $opts{add} = 1 if $opts{delete};
442 my $startTime = time;
446 $cq = Clearquest->new(%opts);
448 $log->msg('Connecting to Clearquest database ' . $cq->connection . '...', 1);
450 unless ($cq->connect) {
451 $cq->checkErr('Unable to connect to database ' . $cq->connection, undef, $log);
453 if ($cq->module eq 'client') {
454 $log->msg('Unable to connect to server ' . $cq->server() . ':' . $cq->port());
459 $log->msg('connected');
460 display_duration $startTime, $log;
463 $cq->setOpts(emptyStringForUndef => 1);
465 # Check a few required stateless records
468 $status += GetRecord 'Project', 'MUOS- EC';
470 # Get record by condition
471 $status += FindRecord 'Platform_Options', 'Platform = "Unix"';
473 # Get record by condition with field list
474 $status += FindRecord 'Roles', 'Rank = "Supervisor"', ('user_name', 'teams.Name', 'Rank');
479 Name => $FindBin::Script,
480 Description => 'This is a test component',
483 AddRecord('Component', \%component, undef, 'name');
485 $status++ if $cq->error;
490 my $newDescription = 'This is a modified test component';
492 $status += ModifyRecord('Component', $FindBin::Script, (Description => $newDescription));
494 # Make sure the modification happened
495 my %component = $cq->get('Component', $FindBin::Script, ('Description'));
497 $log->err('Modification of Component.Description failed!')
498 if $component{Description} ne $newDescription;
501 DeleteRecord 'Component', $FindBin::Script if $opts{add};
503 $log->msg('Enable tc.project for integration with Clearquest');
505 $test_pvob = Clearcase::UCM::Pvob->new("${Clearcase::VOBTAG_PREFIX}/tc.pvob");
506 $test_project = Clearcase::UCM::Project->new('tc.project', 'tc.folder', $test_pvob);
508 my ($rc, @output) = $test_project->change("-force -crmenable $opts{CQ_DATABASE}");
512 $log->log($_) for @output;
514 $log->msg('Create WOR');
516 my $WORID = CreateWOR;
523 $log->msg("Created WOR $WORID");
529 $worStatus += AssignWOR $WORID;
530 $worStatus += ActivateWOR $WORID;
532 $status += $worStatus;
534 unless ($worStatus) {
535 # If we weren't able to assign and activate the WOR then there's no need
536 # to create the view and no need to clean up unless we created the view.
537 $worStatus = CreateView $WORID;
539 $status += Cleanup($WORID) unless $worStatus;
541 $status += $worStatus;
546 $log->err('Clearquest tests FAILED');
548 $log->msg('Clearquest tests PASSED');
551 $log->msg('Total process time ', 1);
553 display_duration $processStartTime, $log;