test/testclearquest.pl

   1 #!/usr/bin/env cqperl
   2 use strict;
   3 use warnings;
   4
   5 =pod
   6
   7 =head1 NAME $RCSfile: testclearquest.pl,v $
   8
   9 Test the Clearquest libary
  10
  11 This script tests various functions of the Clearquest library
  12
  13 =head1 VERSION
  14
  15 =over
  16
  17 =item Author
  18
  19 Andrew DeFaria <Andrew@ClearSCM.com>
  20
  21 =item Revision
  22
  23 $Revision: 2.8 $
  24
  25 =item Created:
  26
  27 Mon Nov 12 16:50:44 PST 2012
  28
  29 =item Modified:
  30
  31 $Date: 2013/03/14 23:39:39 $
  32
  33 =back
  34
  35 =head1 SYNOPSIS
  36
  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>]
  42
  43  Where:
  44    -usa|ge:     Displays usage
  45    -v|erbose:   Be verbose
  46    -de|bug:     Output debug messages
  47
  48    -get:        Test get
  49    -add:        Test add
  50    -modify:     Test modify
  51    -change:     Test change
  52    -delete:     Test delete
  53
  54    -use|rname:  Username to open database with (Default: CQ_USERNAME or from
  55                 config file)
  56    -p|assword:  Password to open database with (Default: CQ_PASSWORD or from
  57                 config file)
  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)
  60
  61
  62
  63 =head1 Options
  64
  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.
  70
  71 =for html <blockquote>
  72
  73 =over
  74
  75 =item CQ_SERVER
  76
  77 Clearquest server to talk to (Default: From cq.conf)
  78
  79 =item CQ_PORT
  80
  81 Port to connect to (Default: From cq.conf)
  82
  83 =item CQ_WEBHOST
  84
  85 The web host to contact with leading http:// (Default: From cq.conf)
  86
  87 =item CQ_DATABASE
  88
  89 Name of database to connect to (Default: From cq.conf)
  90
  91 =item CQ_USERNAME
  92
  93 User name to connect as (Default: From cq.conf)
  94
  95 =item CQ_PASSWORD
  96
  97 Password for CQREST_USERNAME (Default: From cq.conf)
  98
  99 =item CQ_DBSET
 100
 101 Database Set name (Default: From cq.conf)
 102
 103 =back
 104
 105 =cut
 106
 107 use FindBin;
 108 use Getopt::Long;
 109 use Pod::Usage;
 110
 111 use lib "$FindBin::Bin/../lib";
 112
 113 use Clearquest;
 114 use Clearcase::View;
 115 use Clearcase::UCM::Activity;
 116 use Clearcase::UCM::Stream;
 117 use Clearcase::UCM::Project;
 118 use Clearcase::UCM::Pvob;
 119 use DateUtils;
 120 use Display;
 121 use Logger;
 122 use OSDep;
 123 use TimeUtils;
 124 use Utils;
 125
 126 my ($cq, %opts, $log, $createView, $test_pvob, $test_project);
 127
 128 my $status  = 0;
 129 my $project = 'tc.project';
 130
 131 sub displayRecord(%) {
 132   my (%record) = @_;
 133
 134   $log->msg('-' x 79);
 135
 136   for (keys %record) {
 137     $log->msg("$_: ", 1);
 138
 139     if (ref $record{$_} eq 'ARRAY') {
 140       $log->msg(join ", ", @{$record{$_}});
 141     } elsif ($record{$_}) {
 142       $log->msg($record{$_});
 143     } else {
 144       $log->msg('<undef>');
 145     } # if
 146   } # for
 147
 148   return;
 149 } # displayRecord
 150
 151 sub displayResults(@) {
 152   my (@records) = @_;
 153
 154   if (@records) {
 155     displayRecord %$_ foreach (@records);
 156   } else {
 157     $log->msg('Did not find any records');
 158   } # if
 159
 160   return;
 161 } # displayResults
 162
 163 sub GetRecord($$;@) {
 164   my ($table, $key, @fields) = @_;
 165
 166   $log->msg("Gettng table: $table key: $key");
 167
 168   my %record = $cq->get($table, $key, @fields);
 169
 170   if ($cq->checkErr) {
 171         $log->err($cq->errmsg);
 172   } else {
 173     displayRecord %record;
 174   } # if
 175
 176   return $cq->error;
 177 } # GetRecord
 178
 179 sub FindRecord($$;@) {
 180   my ($table, $condition, @fields) = @_;
 181
 182   my $status;
 183
 184   $log->msg("Finding table: $table condition: $condition");
 185
 186   my ($result, $nbrRecs) = $cq->find($table, $condition, @fields);
 187
 188   $log->msg("$nbrRecs records qualified");
 189
 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';
 194
 195       displayRecord %record;
 196
 197       $status += $cq->error;
 198     } # unless
 199   } # while
 200
 201   return $status
 202 } # FindRecord
 203
 204 sub ModifyRecord($$;%) {
 205   my ($table, $key, %update) = @_;
 206
 207   $log->msg("Modifying table: $table key: $key");
 208
 209   $cq->modify($table, $key, undef, \%update);
 210
 211   $log->err($cq->errmsg) if $cq->checkErr;
 212
 213   return $cq->error;
 214 } # ModifyRecord
 215
 216 sub AssignWOR($) {
 217   my ($key) = @_;
 218
 219   my %record = $cq->get('WOR', $key, ('State'));
 220
 221   return $cq->error if $cq->checkErr("Unable to find WOR where key = $key");
 222
 223   my ($action, %update);
 224
 225   if ($record{State} ne 'Submitted') {
 226     $log->err("Cannot assign $key - not in submitted state");
 227
 228     return 1;
 229   } # if
 230
 231   $action               = 'Assign';
 232   $update{PlannedStart} = Today2SQLDatetime;
 233   $update{ucm_project}  = $project;
 234
 235   $log->msg("Testing change WOR state of $key action: $action");
 236
 237   $cq->modify('WOR', $key, $action, \%update);
 238
 239   $log->err($cq->errmsg) if $cq->checkErr;
 240
 241   return $cq->error;
 242 } # AssignWOR
 243
 244 sub ActivateWOR($) {
 245   my ($key) = @_;
 246
 247   my %record = $cq->get('WOR', $key, ('State'));
 248
 249   return $cq->error if $cq->checkErr("Unable to find WOR where key = $key");
 250
 251   my ($action, %update);
 252
 253   if ($record{State} ne 'Assessing') {
 254     $log->err("Cannot activate $key - not in Assessing state");
 255
 256     return 1;
 257   } # if
 258
 259   $action = 'Activate';
 260
 261   $log->msg("Testing change WOR state of $key action: $action");
 262
 263   $cq->modify('WOR', $key, $action);
 264
 265   $log->err($cq->errmsg) if $cq->checkErr;
 266
 267   return $cq->error;
 268 } # ActivateWOR
 269
 270 sub AddRecord($$;$$) {
 271   my ($table, $record, $ordering, $returnField) = @_;
 272
 273   $returnField ||= 'id';
 274
 275   $log->msg("Adding table: $table");
 276
 277   my $dbid = $cq->add($table, $record, @$ordering);
 278
 279   if ($cq->checkErr) {
 280     $log->err($cq->errmsg);
 281
 282     return;
 283   } else {
 284     my %record = $cq->getDBID($table, $dbid, ($returnField));
 285
 286     return $record{$returnField};
 287   } # if
 288 } # AddRecord
 289
 290 sub DeleteRecord($$) {
 291   my ($table, $key) = @_;
 292
 293   $log->msg("Deleting table: $table key: $key");
 294
 295   $cq->delete($table, $key);
 296
 297   $log->err($cq->errmsg) if $cq->checkErr;
 298
 299   return $cq->error;
 300 } # DeleteRecord
 301
 302 sub CreateWOR() {
 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.
 309   my %WOR = (
 310     headline           => 'Test WOR',
 311     description        => 'This is a test WOR created programmatically',
 312     project            => 'MUOS',
 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',
 318   );
 319
 320   return AddRecord('WOR', \%WOR, ['project', 'Prod_Arch1']);
 321 } # CreateWOR
 322
 323 sub CreateView($) {
 324   my ($WORID) = @_;
 325
 326   my ($status, @output) = Execute "$createView $WORID 2>&1";
 327
 328   $log->log($_) for @output;
 329
 330   return $status;
 331 } # CreateView
 332
 333 sub Cleanup($) {
 334   my ($WORID) = @_;
 335
 336   my ($status, @output) = (0, ());
 337   my $rc = 0;
 338
 339   # Remove views created
 340   my @tags = (
 341     "$ENV{USER}_${project}_intview",
 342     "$ENV{USER}_${WORID}_devview",
 343   );
 344
 345   for (@tags) {
 346     my $view = Clearcase::View->new($_);
 347
 348     $log->msg('Removing ' . $view->name);
 349
 350     ($rc, @output) = $view->remove;
 351
 352     $status++ if $rc;
 353
 354     $log->log($_) for @output;
 355   } # for
 356
 357   # Remove streams that were created
 358   my @streams = (
 359     "$ENV{USER}_${WORID}_${project}_dev",
 360   );
 361
 362   for my $stream (@streams) {
 363     my $activity = Clearcase::UCM::Activity->new($WORID, $test_pvob);
 364
 365     $log->msg('Removing ' . $activity->name);
 366
 367     ($rc, @output) = $activity->remove;
 368
 369     $status += $rc;
 370
 371     $log->log($_) for @output;
 372
 373     # Streams are downshifted
 374     my $stream = Clearcase::UCM::Stream->new(lc $stream, $test_pvob);
 375
 376     $log->msg('Removing ' . $stream->name);
 377
 378     ($rc, @output) = $stream->remove;
 379
 380     $log->log($_) for @output;
 381
 382     $status++ if $rc;
 383   } # for
 384
 385   return $status;
 386 } # Cleanup
 387
 388 ## Main
 389 GetOptions(
 390   \%opts,
 391   usage   => sub { pod2usage },
 392   help    => sub { pod2usage (-verbose => 2)},
 393   verbose => sub { set_verbose },
 394   debug   => sub { set_debug },
 395   'get',
 396   'add',
 397   'modify',
 398   'change',
 399   'delete',
 400   'username=s',
 401   'password=s',
 402   'database=s',
 403   'dbset=s',
 404 ) || pod2usage;
 405
 406 my $processStartTime = time;
 407
 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';
 413 } # if
 414
 415 local $| = 1;
 416
 417 # Translate any options to ones that the lib understands
 418 map {$opts{$_} = $Clearquest::OPTS{$_}} keys %Clearquest::OPTS;
 419
 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};
 427
 428 # If nothing is set then do everything
 429 unless ($opts{get}    or
 430         $opts{add}    or
 431         $opts{modify} or
 432         $opts{change} or
 433         $opts{delete}
 434   ) {
 435   $opts{get} = $opts{add} = $opts{modify} = $opts{change} = 1;
 436 } # unless
 437
 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};
 441
 442 my $startTime = time;
 443
 444 $log = Logger->new;
 445
 446 $cq = Clearquest->new(%opts);
 447
 448 $log->msg('Connecting to Clearquest database ' . $cq->connection . '...', 1);
 449
 450 unless ($cq->connect) {
 451   $cq->checkErr('Unable to connect to database ' . $cq->connection, undef, $log);
 452
 453   if ($cq->module eq 'client') {
 454     $log->msg('Unable to connect to server ' . $cq->server() . ':' . $cq->port());
 455   } # if
 456
 457   exit $cq->error;
 458 } else {
 459   $log->msg('connected');
 460   display_duration $startTime, $log;
 461 } # unless
 462
 463 $cq->setOpts(emptyStringForUndef => 1);
 464
 465 # Check a few required stateless records
 466 if ($opts{get}) {
 467   # Get record by key
 468   $status += GetRecord 'Project', 'MUOS- EC';
 469
 470   # Get record by condition
 471   $status += FindRecord 'Platform_Options', 'Platform = "Unix"';
 472
 473   # Get record by condition with field list
 474   $status += FindRecord 'Roles', 'Rank = "Supervisor"', ('user_name', 'teams.Name',   'Rank');
 475 } # if
 476
 477 if ($opts{add}) {
 478   my %component = (
 479     Name        => $FindBin::Script,
 480     Description => 'This is a test component',
 481   );
 482
 483   AddRecord('Component', \%component, undef, 'name');
 484
 485   $status++ if $cq->error;
 486 } # if
 487
 488 if ($opts{modify}) {
 489   # Modify a record
 490   my $newDescription = 'This is a modified test component';
 491
 492   $status += ModifyRecord('Component', $FindBin::Script, (Description => $newDescription));
 493
 494   # Make sure the modification happened
 495   my %component = $cq->get('Component', $FindBin::Script, ('Description'));
 496
 497   $log->err('Modification of Component.Description failed!')
 498     if $component{Description} ne $newDescription;
 499 } # if
 500
 501 DeleteRecord 'Component', $FindBin::Script if $opts{add};
 502
 503 $log->msg('Enable tc.project for integration with Clearquest');
 504
 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);
 507
 508 my ($rc, @output) = $test_project->change("-force -crmenable $opts{CQ_DATABASE}");
 509
 510 $status += $rc;
 511
 512 $log->log($_) for @output;
 513
 514 $log->msg('Create WOR');
 515
 516 my $WORID = CreateWOR;
 517
 518 unless ($WORID) {
 519   $status++;
 520
 521   exit $status;
 522 } else {
 523   $log->msg("Created WOR $WORID");
 524 } # unless
 525
 526 if ($opts{change}) {
 527   my $worStatus;
 528
 529   $worStatus += AssignWOR   $WORID;
 530   $worStatus += ActivateWOR $WORID;
 531
 532   $status += $worStatus;
 533
 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;
 538
 539     $status += Cleanup($WORID) unless $worStatus;
 540
 541     $status += $worStatus;
 542   } # unless
 543 } # if
 544
 545 if ($status) {
 546   $log->err('Clearquest tests FAILED');
 547 } else {
 548   $log->msg('Clearquest tests PASSED');
 549 } # if
 550
 551 $log->msg('Total process time ', 1);
 552
 553 display_duration $processStartTime, $log;
 554
 555 exit $status;