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: from config file)
  55    -p|assword:  Password to open database with (Default: from config file)
  56    -da|tabase:  Database to open (Default: from config file)
  57    -db|set:     Database Set to use (Default: from config file)
  58    -m|odule:    Type of Clearquest module to use. Must be one of 'api',
  59                 'client', or 'rest'. The 'api' module can only be used if
  60                 Clearquest is installed locally. The 'client' module can only
  61                 be successful if a corresponding server is running. And the
  62                 'rest' module can only be used if a CQ Web server has been set
  63                 up and configured (Default: rest)
  64    -s|erver:    For module = client or rest this is the name of the server that
  65                 will be providing the service
  66    -p|ort:      For module = client, this is the point on the server to talk
  67                 through.
  68
  69
  70 =head1 Options
  71
  72 Options are keep in the cq.conf file in etc. They specify the default options
  73 listed below. Or you can export the option name to the env(1) to override the
  74 defaults in cq.conf. Finally you can programmatically set the options when you
  75 call new by passing in a %parms hash. To specify the %parms hash key remove the
  76 CQ_ portion and lc the rest.
  77
  78 =for html <blockquote>
  79
  80 =over
  81
  82 =item CQ_SERVER
  83
  84 Clearquest server to talk to (Default: From cq.conf)
  85
  86 =item CQ_PORT
  87
  88 Port to connect to (Default: From cq.conf)
  89
  90 =item CQ_WEBHOST
  91
  92 The web host to contact with leading http:// (Default: From cq.conf)
  93
  94 =item CQ_DATABASE
  95
  96 Name of database to connect to (Default: From cq.conf)
  97
  98 =item CQ_USERNAME
  99
 100 User name to connect as (Default: From cq.conf)
 101
 102 =item CQ_PASSWORD
 103
 104 Password for CQREST_USERNAME (Default: From cq.conf)
 105
 106 =item CQ_DBSET
 107
 108 Database Set name (Default: From cq.conf)
 109
 110 =back
 111
 112 =cut
 113
 114 use FindBin;
 115 use Getopt::Long;
 116
 117 use lib "$FindBin::Bin/../lib";
 118
 119 use Clearquest;
 120 use Clearcase::View;
 121 use Clearcase::UCM::Activity;
 122 use Clearcase::UCM::Stream;
 123 use Clearcase::UCM::Project;
 124 use Clearcase::UCM::Pvob;
 125 use DateUtils;
 126 use Display;
 127 use Logger;
 128 use TimeUtils;
 129 use Utils;
 130
 131 my ($cq, %opts, $log, $createView, $test_pvob, $test_project);
 132
 133 my $status = 0;
 134 my $project = 'tc.project';
 135
 136 sub displayRecord(%) {
 137   my (%record) = @_;
 138
 139   $log->msg('-' x 79);
 140
 141   for (keys %record) {
 142     $log->msg("$_: ", 1);
 143
 144     if (ref $record{$_} eq 'ARRAY') {
 145       $log->msg(join ", ", @{$record{$_}});
 146     } elsif ($record{$_}) {
 147       $log->msg($record{$_});
 148     } else {
 149       $log->msg('<undef>');
 150     } # if
 151   } # for
 152
 153   return;
 154 } # displayRecord
 155
 156 sub displayResults(@) {
 157   my (@records) = @_;
 158
 159   if (@records) {
 160     displayRecord %$_ foreach (@records);
 161   } else {
 162     $log->msg('Did not find any records');
 163   } # if
 164
 165   return;
 166 } # displayResults
 167
 168 sub GetRecord($$;@) {
 169   my ($table, $key, @fields) = @_;
 170
 171   $log->msg("Gettng table: $table key: $key");
 172
 173   my %record = $cq->get($table, $key, @fields);
 174
 175   if ($cq->checkErr) {
 176         $log->err($cq->errmsg);
 177   } else {
 178     displayRecord %record;
 179   } # if
 180
 181   return $cq->error;
 182 } # GetRecord
 183
 184 sub FindRecord($$;@) {
 185   my ($table, $condition, @fields) = @_;
 186
 187   my $status;
 188
 189   $log->msg("Finding table: $table condition: $condition");
 190
 191   my ($result, $nbrRecs) = $cq->find($table, $condition, @fields);
 192
 193   $log->msg("$nbrRecs records qualified");
 194
 195   while (my %record = $cq->getNext($result)) {
 196     unless ($cq->error) {
 197       # Store away the createView.pl script location
 198       $createView = $record{ws_cr_view} if $table eq 'Platform_Options';
 199
 200       displayRecord %record;
 201
 202       $status += $cq->error;
 203     } # unless
 204   } # while
 205
 206   return $status
 207 } # FindRecord
 208
 209 sub ModifyRecord($$;%) {
 210   my ($table, $key, %update) = @_;
 211
 212   $log->msg("Modifying table: $table key: $key");
 213
 214   $cq->modify($table, $key, undef, \%update);
 215
 216   $log->err($cq->errmsg) if $cq->checkErr;
 217
 218   return $cq->error;
 219 } # ModifyRecord
 220
 221 sub AssignWOR($) {
 222   my ($key) = @_;
 223
 224   my %record = $cq->get('WOR', $key, ('State'));
 225
 226   return $cq->error if $cq->checkErr("Unable to find WOR where key = $key");
 227
 228   my ($action, %update);
 229
 230   if ($record{State} ne 'Submitted') {
 231     $log->err("Cannot assign $key - not in submitted state");
 232
 233     return 1;
 234   } # if
 235
 236   $action               = 'Assign';
 237   $update{PlannedStart} = Today2SQLDatetime;
 238   $update{ucm_project}  = $project;
 239
 240   $log->msg("Testing change WOR state of $key action: $action");
 241
 242   $cq->modify('WOR', $key, $action, \%update);
 243
 244   $log->err($cq->errmsg) if $cq->checkErr;
 245
 246   return $cq->error;
 247 } # AssignWOR
 248
 249 sub ActivateWOR($) {
 250   my ($key) = @_;
 251
 252   my %record = $cq->get('WOR', $key, ('State'));
 253
 254   return $cq->error if $cq->checkErr("Unable to find WOR where key = $key");
 255
 256   my ($action, %update);
 257
 258   if ($record{State} ne 'Assessing') {
 259     $log->err("Cannot activate $key - not in Assessing state");
 260
 261     return 1;
 262   } # if
 263
 264   $action = 'Activate';
 265
 266   $log->msg("Testing change WOR state of $key action: $action");
 267
 268   $cq->modify('WOR', $key, $action);
 269
 270   $log->err($cq->errmsg) if $cq->checkErr;
 271
 272   return $cq->error;
 273 } # ActivateWOR
 274
 275 sub AddRecord($$;$$) {
 276   my ($table, $record, $ordering, $returnField) = @_;
 277
 278   $returnField ||= 'id';
 279
 280   $log->msg("Adding table: $table");
 281
 282   my $dbid = $cq->add($table, $record, @$ordering);
 283
 284   if ($cq->checkErr) {
 285     $log->err($cq->errmsg);
 286
 287     return;
 288   } else {
 289     my %record = $cq->getDBID($table, $dbid, ($returnField));
 290
 291     return $record{$returnField};
 292   } # if
 293 } # AddRecord
 294
 295 sub DeleteRecord($$) {
 296   my ($table, $key) = @_;
 297
 298   $log->msg("Deleting table: $table key: $key");
 299
 300   $cq->delete($table, $key);
 301
 302   $log->err($cq->errmsg) if $cq->checkErr;
 303
 304   return $cq->error;
 305 } # DeleteRecord
 306
 307 sub CreateWOR() {
 308   # Try to add a WOR - the following fields are required and some may need
 309   # to be added to stateless records in order for this to succeed. Once you
 310   # can add a WOR through the  Clearquest client successfully you should be
 311   # able to come up with the values of these  required fields. There are,
 312   # however, sometimes when you need to specify ordering to have some fields
 313   # set before other fields.
 314   my %WOR = (
 315     headline           => 'Test WOR',
 316     description        => 'This is a test WOR created programmatically',
 317     project            => 'MUOS',
 318     RCLC_name          => 'Test RCLC',
 319     Prod_Arch1         => 'testcode : N/A',
 320     work_product_name  => '10 - Software',
 321     Engr_target        => 'Test Engineering Target',
 322     work_code_name     => 'RAN-RW2',
 323   );
 324
 325   return AddRecord('WOR', \%WOR, ['project', 'Prod_Arch1']);
 326 } # CreateWOR
 327
 328 sub CreateView($) {
 329   my ($WORID) = @_;
 330
 331   my ($status, @output) = Execute "$createView $WORID 2>&1";
 332
 333   $log->log($_) for @output;
 334
 335   return $status;
 336 } # CreateView
 337
 338 sub Cleanup($) {
 339   my ($WORID) = @_;
 340
 341   my ($status, @output) = (0, ());
 342   my $rc = 0;
 343
 344   # Remove views created
 345   my @tags = (
 346     "$ENV{USER}_${project}_intview",
 347     "$ENV{USER}_${WORID}_devview",
 348   );
 349
 350   for (@tags) {
 351     my $view = Clearcase::View->new($_);
 352
 353     $log->msg('Removing ' . $view->name);
 354
 355     ($rc, @output) = $view->remove;
 356
 357     $status++ if $rc;
 358
 359     $log->log($_) for @output;
 360   } # for
 361
 362   # Remove streams that were created
 363   my @streams = (
 364     "$ENV{USER}_${WORID}_${project}_dev",
 365   );
 366
 367   for my $stream (@streams) {
 368     my $activity = Clearcase::UCM::Activity->new($WORID, $test_pvob);
 369
 370     $log->msg('Removing ' . $activity->name);
 371
 372     ($rc, @output) = $activity->remove;
 373
 374     $status += $rc;
 375
 376     $log->log($_) for @output;
 377
 378     # Streams are downshifted
 379     my $stream = Clearcase::UCM::Stream->new(lc $stream, $test_pvob);
 380
 381     $log->msg('Removing ' . $stream->name);
 382
 383     ($rc, @output) = $stream->remove;
 384
 385     $log->log($_) for @output;
 386
 387     $status++ if $rc;
 388   } # for
 389
 390   return $status;
 391 } # Cleanup
 392
 393 ## Main
 394 GetOptions(
 395   \%opts,
 396   usage   => sub { Usage },
 397   verbose => sub { set_verbose },
 398   debug   => sub { set_debug },
 399   'verbose',
 400   'debug',
 401   'usage',
 402   'get',
 403   'add',
 404   'modify',
 405   'change',
 406   'delete',
 407   'module=s',
 408   'username=s',
 409   'password=s',
 410   'database=s',
 411   'dbset=s',
 412   'server=s',
 413   'port=i',
 414 ) || Usage;
 415
 416 my $processStartTime = time;
 417
 418 # Since we are creating private vobs (to avoid complications with having to
 419 # know and code the registry password when making public vobs), we'll simply
 420 # change $Clearcase::VOBTAG_PREFIX
 421 $Clearcase::VOBTAG_PREFIX = $ENV{TMP} || '/tmp';
 422
 423 local $| = 1;
 424
 425 # Translate any options to ones that the lib understands
 426 map {$opts{$_} = $Clearquest::OPTS{$_}} keys %Clearquest::OPTS;
 427
 428 $opts{CQ_USERNAME} = delete $opts{username} if $opts{username};
 429 $opts{CQ_PASSWORD} = delete $opts{password} if $opts{password};
 430 $opts{CQ_DATABASE} = delete $opts{database} if $opts{database};
 431 $opts{CQ_DBSET}    = delete $opts{dbset}    if $opts{dbset};
 432 $opts{CQ_SERVER}   = delete $opts{server}   if $opts{server};
 433 $opts{CQ_PORT}     = delete $opts{port}     if $opts{port};
 434 $opts{CQ_MODULE}   = delete $opts{module}   if $opts{module};
 435
 436 # If nothing is set then do everything
 437 unless ($opts{get}    or
 438         $opts{add}    or
 439         $opts{modify} or
 440         $opts{change} or
 441         $opts{delete}
 442   ) {
 443   $opts{get} = $opts{add} = $opts{modify} = $opts{change} = 1;
 444 } # unless
 445
 446 # If we are testing add or delete then toggle on the other one
 447 $opts{delete} = 1 if $opts{add};
 448 $opts{add}    = 1 if $opts{delete};
 449
 450 my $startTime = time;
 451
 452 $log = Logger->new;
 453
 454 $cq = Clearquest->new(%opts);
 455
 456 $log->msg('Connecting to Clearquest database ' . $cq->connection . '...', 1);
 457
 458 unless ($cq->connect) {
 459   $cq->checkErr('Unable to connect to database ' . $cq->connection, undef, $log);
 460
 461   if ($cq->module eq 'client') {
 462     $log->msg('Unable to connect to server ' . $cq->server() . ':' . $cq->port());
 463   } # if
 464
 465   exit $cq->error;
 466 } else {
 467   $log->msg('connected');
 468   display_duration $startTime, $log;
 469 } # unless
 470
 471 $cq->setOpts(emptyStringForUndef => 1);
 472
 473 # Check a few required stateless records
 474 if ($opts{get}) {
 475   # Get record by key
 476   $status += GetRecord 'Project', 'MUOS- EC';
 477
 478   # Get record by condition
 479   $status += FindRecord 'Platform_Options', 'Platform = "Unix"';
 480
 481   # Get record by condition with field list
 482   $status += FindRecord 'Roles', 'Rank = "Supervisor"', ('user_name', 'teams.Name',   'Rank');
 483 } # if
 484
 485 if ($opts{add}) {
 486   my %component = (
 487     Name        => $FindBin::Script,
 488     Description => 'This is a test component',
 489   );
 490
 491   AddRecord('Component', \%component, undef, 'name');
 492
 493   $status++ if $cq->error;
 494 } # if
 495
 496 if ($opts{modify}) {
 497   # Modify a record
 498   my $newDescription = 'This is a modified test component';
 499
 500   $status += ModifyRecord('Component', $FindBin::Script, (Description => $newDescription));
 501
 502   # Make sure the modification happened
 503   my %component = $cq->get('Component', $FindBin::Script, ('Description'));
 504
 505   $log->err('Modification of Component.Description failed!')
 506     if $component{Description} ne $newDescription;
 507 } # if
 508
 509 DeleteRecord 'Component', $FindBin::Script if $opts{add};
 510
 511 $log->msg('Enable tc.project for integration with Clearquest');
 512
 513 $test_pvob    = Clearcase::UCM::Pvob->new("$Clearcase::VOBTAG_PREFIX/tc.pvob");
 514 $test_project = Clearcase::UCM::Project->new('tc.project', 'tc.folder', $test_pvob);
 515
 516 my ($rc, @output) = $test_project->change('-force -crmenable XTST1');
 517
 518 $status += $rc;
 519
 520 $log->log($_) for @output;
 521
 522 $log->msg('Create WOR');
 523
 524 my $WORID = CreateWOR;
 525
 526 unless ($WORID) {
 527   $status++;
 528
 529   exit $status;
 530 } else {
 531   $log->msg("Created WOR $WORID");
 532 } # unless
 533
 534 if ($opts{change}) {
 535   $status += AssignWOR   $WORID;
 536   $status += ActivateWOR $WORID;
 537 } # if
 538
 539 $status += CreateView $WORID;
 540
 541 $status += Cleanup($WORID);
 542
 543 if ($status) {
 544   $log->err('Clearquest tests FAILED');
 545 } else {
 546   $log->msg('Clearquest tests PASSED');
 547 } # if
 548
 549 $log->msg('Total process time ', 1);
 550
 551 display_duration $processStartTime, $log;
 552
 553 exit $status;