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: 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
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.
78 =for html <blockquote>
84 Clearquest server to talk to (Default: From cq.conf)
88 Port to connect to (Default: From cq.conf)
92 The web host to contact with leading http:// (Default: From cq.conf)
96 Name of database to connect to (Default: From cq.conf)
100 User name to connect as (Default: From cq.conf)
104 Password for CQREST_USERNAME (Default: From cq.conf)
108 Database Set name (Default: From cq.conf)
117 use lib "$FindBin::Bin/../lib";
126 sub displayRecord (%) {
131 foreach (keys %record) {
134 if (ref $record{$_} eq 'ARRAY') {
135 display join ", ", @{$record{$_}};
136 } elsif ($record{$_}) {
146 sub displayResults (@) {
150 displayRecord %$_ foreach (@records);
152 display "Did not find any records";
158 sub testGetRecord ($$;@) {
159 my ($table, $key, @fields) = @_;
161 my $startTime = time;
163 display "Testing get table: $table key: $key";
165 displayRecord $cq->get ($table, $key, @fields);
167 display_duration $startTime;
172 sub testFindRecord ($$;@) {
173 my ($table, $condition, @fields) = @_;
175 my $startTime = time;
177 display "Testing find table: $table condition: $condition";
179 my ($result, $nbrRecs) = $cq->find ($table, $condition, @fields);
181 display "$nbrRecs records qualified";
183 while (my %record = $cq->getNext ($result)) {
184 displayRecord %record;
187 display_duration $startTime;
192 sub testModifyRecord ($$;%) {
193 my ($table, $key, %update) = @_;
195 my $startTime = time;
197 display "Testing modify table: $table key: $key";
199 $cq->modify ($table, $key, undef, \%update);
203 display_duration $startTime;
208 sub testChangeState ($$) {
209 my ($table, $key) = @_;
211 my $startTime = time;
213 my %record = $cq->get ($table, $key, ('State'));
215 $cq->checkErr ("Unable to find $table where key = $key");
217 return if $cq->error;
219 my ($action, %update);
221 if ($record{State} eq 'Assigned') {
222 $action = 'AdminAssignToSubmit';
223 $update{Stability_Issue} = 'User Fault';
226 $update{Stability_Issue} = 'Assert';
229 display "Testing change state table: $table key: $key action: $action";
231 $cq->modify ($table, $key, $action, \%update);
235 display_duration $startTime;
240 sub testAddRecord ($%) {
241 my ($table, %record) = @_;
243 my $startTime = time;
245 display "Testing adding table: $table";
247 $cq->add ($table, \%record, qw(Projects VersionStr));
251 display_duration $startTime;
256 sub testDeleteRecord ($$) {
257 my ($table, $key) = @_;
259 my $startTime = time;
261 display "Testing deleting table: $table key: $key";
263 $cq->delete ($table, $key);
267 display_duration $startTime;
275 usage => sub { Usage },
276 verbose => sub { set_verbose },
277 debug => sub { set_debug },
292 my $processStartTime = time;
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};
305 # If nothing is set then do everything
306 unless ($opts{get} or
312 $opts{get} = $opts{add} = $opts{modify} = $opts{change} = 1;
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};
319 my $startTime = time;
321 $cq = Clearquest->new (%opts);
323 display_nolf 'Connecting to Clearquest database ' . $cq->connection;
325 unless ($cq->connect) {
326 $cq->checkErr ('Unable to connect to database ' . $cq->connection);
328 if ($cq->module eq 'client') {
329 display 'Unable to connect to server '
338 display_duration $startTime;
341 $cq->setOpts (emptyStringForUndef => 1);
345 testGetRecord 'Project', 'Athena';
347 # Get record by condition
348 testFindRecord 'VersionInfo', 'Deprecated = 1';
350 # Get record by key with field list
351 testFindRecord 'VersionInfo', 'VersionStr = 1.0', ('VersionStr', 'Deprecated');
353 # Get record by condition with field list
354 testFindRecord 'CategorySub', 'Category="Software"', ('Category', 'CategoryType', 'SubCategory');
359 testAddRecord 'VersionInfo', (
361 Projects => ['Island', '21331', 'Hera'],
362 Visibility => 'Nokia Corporation',
368 testModifyRecord ('VersionInfo', '1.0', (
370 Projects => ['Island', 'Athena'],
376 testChangeState 'Defect', 'apd00000034';
381 testDeleteRecord 'VersionInfo', '2.0';
384 display_nolf 'Total process time ';
386 display_duration $processStartTime;