test/testclearquest.pl

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