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 Display;
 121 use Logger;
 122 use TimeUtils;
 123 use Utils;
 124
 125 my ($cq, %opts, $log);
 126
 127 sub displayRecord (%) {
 128   my (%record) = @_;
 129
 130   $log->msg ('-' x 79);
 131
 132   for (keys %record) {
 133     $log->msg ("$_: ", 1);
 134
 135     if (ref $record{$_} eq 'ARRAY') {
 136       $log->msg (join ", ", @{$record{$_}});
 137     } elsif ($record{$_}) {
 138       $log->msg ($record{$_});
 139     } else {
 140       $log->msg ('<undef>');
 141     } # if
 142   } # for
 143
 144   return;
 145 } # displayRecord
 146
 147 sub displayResults (@) {
 148   my (@records) = @_;
 149
 150   if (@records) {
 151     displayRecord %$_ foreach (@records);
 152   } else {
 153     $log->msg ('Did not find any records');
 154   } # if
 155
 156   return;
 157 } # displayResults
 158
 159 sub testGetRecord ($$;@) {
 160   my ($table, $key, @fields) = @_;
 161
 162   my $startTime = time;
 163
 164   $log->msg ("Testing get table: $table key: $key");
 165
 166   displayRecord $cq->get ($table, $key, @fields);
 167
 168   display_duration $startTime, $log;
 169
 170   return;
 171 } # testGetRecord
 172
 173 sub testFindRecord ($$;@) {
 174   my ($table, $condition, @fields) = @_;
 175
 176   my $startTime = time;
 177
 178   $log->msg ("Testing find table: $table condition: $condition");
 179
 180   my ($result, $nbrRecs) = $cq->find ($table, $condition, @fields);
 181
 182   $log->msg ("$nbrRecs records qualified");
 183
 184   while (my %record = $cq->getNext($result)) {
 185     displayRecord %record;
 186   } # while
 187
 188   display_duration $startTime, $log;
 189
 190   return;
 191 } # testFindRecord
 192
 193 sub testModifyRecord ($$;%) {
 194   my ($table, $key, %update) = @_;
 195
 196   my $startTime = time;
 197
 198   $log->msg ("Testing modify table: $table key: $key");
 199
 200   $cq->modify ($table, $key, undef, \%update);
 201
 202   $cq->checkErr;
 203
 204   display_duration $startTime, $log;
 205
 206   return;
 207 } # testModifyRecord
 208
 209 sub testChangeState ($$) {
 210   my ($table, $key) = @_;
 211
 212   my $startTime = time;
 213
 214   my %record = $cq->get ($table, $key, ('State'));
 215
 216   $cq->checkErr ("Unable to find $table where key = $key");
 217
 218   return if $cq->error;
 219
 220   my ($action, %update);
 221
 222   if ($record{State} eq 'Assigned') {
 223     $action                  = 'AdminAssignToSubmit';
 224     $update{Stability_Issue} = 'User Fault';
 225   } else {
 226     $action                  = 'Assign';
 227     $update{Stability_Issue} = 'Assert';
 228   } # if
 229
 230   $log->msg ("Testing change state table: $table key: $key action: $action");
 231
 232   $cq->modify ($table, $key, $action, \%update);
 233
 234   $cq->checkErr;
 235
 236   display_duration $startTime, $log;
 237
 238   return;
 239 } # testChangeState
 240
 241 sub testAddRecord ($%) {
 242   my ($table, %record) = @_;
 243
 244   my $startTime = time;
 245
 246   $log->msg ("Testing adding table: $table");
 247
 248   $cq->add ($table, \%record);
 249
 250   $cq->checkErr;
 251
 252   display_duration $startTime, $log;
 253
 254   return;
 255 } # testAddRecord
 256
 257 sub testDeleteRecord ($$) {
 258   my ($table, $key) = @_;
 259
 260   my $startTime = time;
 261
 262   $log->msg ("Testing deleting table: $table key: $key");
 263
 264   $cq->delete ($table, $key);
 265
 266   $cq->checkErr;
 267
 268   display_duration $startTime, $log;
 269
 270   return;
 271 } # testDeleteRecord
 272
 273 ## Main
 274 GetOptions (
 275   \%opts,
 276   usage   => sub { Usage },
 277   verbose => sub { set_verbose },
 278   debug   => sub { set_debug },
 279   'get',
 280   'add',
 281   'modify',
 282   'change',
 283   'delete',
 284   'module=s',
 285   'username=s',
 286   'password=s',
 287   'database=s',
 288   'dbset=s',
 289   'server=s',
 290   'port=i',
 291 ) || Usage;
 292
 293 my $processStartTime = time;
 294
 295 local $| = 1;
 296
 297 # Translate any options to ones that the lib understands
 298 $opts{CQ_USERNAME} = delete $opts{username};
 299 $opts{CQ_PASSWORD} = delete $opts{password};
 300 $opts{CQ_DATABASE} = delete $opts{database};
 301 $opts{CQ_DBSET}    = delete $opts{dbset};
 302 $opts{CQ_SERVER}   = delete $opts{server};
 303 $opts{CQ_PORT}     = delete $opts{port};
 304 $opts{CQ_MODULE}   = delete $opts{module};
 305
 306 # If nothing is set then do everything
 307 unless ($opts{get}    or
 308         $opts{add}    or
 309         $opts{modify} or
 310         $opts{change} or
 311         $opts{delete}
 312   ) {
 313   $opts{get} = $opts{add} = $opts{modify} = $opts{change} = 1;
 314 } # unless
 315
 316 # If we are testing add or delete then toggle on the other one
 317 $opts{delete} = 1 if $opts{add};
 318 $opts{add}    = 1 if $opts{delete};
 319
 320 my $startTime = time;
 321
 322 $log = Logger->new;
 323
 324 $cq = Clearquest->new (%opts);
 325
 326 $log->msg ('Connecting to Clearquest database ' . $cq->connection, 1);
 327
 328 unless ($cq->connect) {
 329   $cq->checkErr ('Unable to connect to database ' . $cq->connection, undef, $log);
 330
 331   if ($cq->module eq 'client') {
 332     $log->msg ('Unable to connect to server ' . $cq->server () . ':' . $cq->port ());
 333   } # if
 334
 335   exit $cq->error;
 336 } else {
 337   $log->msg ('');
 338   display_duration $startTime, $log;
 339 } # unless
 340
 341 $cq->setOpts (emptyStringForUndef => 1);
 342
 343 if ($opts{get}) {
 344   # Get record by key
 345   testGetRecord 'WOR', 'XTST100000019';
 346
 347   # Get record by condition
 348   testFindRecord 'WOR', 'Owner = "ccadm"';
 349
 350   # Get record by key with field list
 351   testFindRecord 'WOR', 'Owner = "ccadm"', ('id', 'Headline',   'Owner');
 352
 353   # Get record by condition with field list
 354   testFindRecord 'WOR', 'Owner = "ccadm"', ('id', 'Headline', 'Owner');
 355 } # if
 356
 357 if ($opts{add}) {
 358   # Add a record
 359   testAddRecord    'Component', (
 360     Name          => $FindBin::Script,
 361     Description   => 'This is a test component',
 362   );
 363 } # if
 364
 365 if ($opts{modify}) {
 366   # Modify a record
 367   my $newDescription = 'This is a modified test component';
 368
 369   testModifyRecord ('Component', $FindBin::Script, (Description => $newDescription));
 370
 371   # Make sure the modification happened
 372   my %component = $cq->get ('Component', $FindBin::Script, ('Description'));
 373
 374   if ($component{Description} ne $newDescription) {
 375     $log->err ('Modification of Component.Description failed!');
 376   } # if
 377 } # if
 378
 379 if ($opts{change}) {
 380   # Change State
 381   testChangeState 'Defect', 'apd00000034';
 382 } # if
 383
 384 if ($opts{add}) {
 385   # Delete that record
 386   testDeleteRecord 'Component', $FindBin::Script;
 387 } # if
 388
 389 $log->msg ('Total process time ', 1);
 390
 391 display_duration $processStartTime, $log;