3 =head1 NAME $RCSfile: Client.pm,v $
5 Clearquest client - Provide access to a running Clearquest server
13 Andrew DeFaria <Andrew@ClearSCM.com>
21 Monday, October 10, 2011 5:02:07 PM PDT
25 $Date: 2013/05/30 15:43:28 $
31 Provides an interface to a running Clearquest Server over the network. This
32 means that you can use any Perl you like, not just cqperl, and you don't need
33 to have Clearquest installed locally. In fact you can run from say Linux and
34 talk to the Clearquest Server running on Windows.
38 The server allows both read and write access to a Clearquest database as defined
39 in cqdservice.conf file. Note the username/password must be of a user who can
40 write to the Clearquest database for write access to succeed.
42 A hash is passed into to the execute method, which the client should use to talk
43 to the server, that describes relatively simple protocol to tell the server what
44 action to perform. In both the read case and the read/write case a field named
45 id should be defined that has a value of "<record>=<id>" (e.g.
46 "defect=BUGDB00034429").
48 For the read case the rest of the keys are the names of the fields to retrieve
49 with values that are undef'ed. For read/write, the rest of hash contains name
50 value pairs of fields to set and their values.
52 Execute returns a status and a hash of name value pairs for the read case and an
53 array of lines for any error messages for the read/write case.
57 The following methods are available:
61 package Clearquest::Client;
71 use POSIX ":sys_wait_h";
76 use parent 'Clearquest';
78 $Data::Dumper::Indent = 0;
80 our $VERSION = '$Revision: 2.8 $';
81 ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
87 Options are keep in the cq.conf file in the etc directory. They specify the
88 default options listed below. Or you can export the option name to the env(1) to
89 override the defaults in cq.conf. Finally you can programmatically set the
90 options when you call new by passing in a %parms hash. The items below are the
91 key values for the hash.
93 =for html <blockquote>
99 The CQ Server host to connect to
103 Port number to contact the server at (Default: From cq.conf)
107 User name to connect as (Default: From cq.conf)
111 Password for CQ_USERNAME
115 Name of database to connect to (Default: From cq.conf)
119 Database Set name (Default: From cq.conf)
126 my ($self, $cmd) = @_;
130 my ($self, $call, @parms) = @_;
132 my $server = $self->{socket};
137 $request .= Dumper \@parms;
141 print $server $request;
144 my ($response, $status, @output);
146 while (defined ($response = <$server>)) {
147 if ($response =~ /Clearquest::Server Status: (-*\d+)/) {
152 chomp $response; chop $response if $response =~ /\r$/;
154 push @output, $response;
158 push @output, 'Unknown or unhandled error';
163 $self->_setError (join ("\n", @output), $status) if $status;
165 return ($status, @output);
169 my ($self, $table, $values, @ordering) = @_;
173 push @parms, $table, Dumper ($values), @ordering;
175 $self->_request ('add', @parms);
177 return $self->errmsg;
180 sub connect (;$$$$) {
181 my ($self, $username, $password, $database, $dbset) = @_;
183 return $self->connectToServer;
186 sub connectToServer (;$$) {
187 my ($self, $server, $port) = @_;
189 $self->{socket} = IO::Socket::INET->new (
191 PeerAddr => $self->{server},
192 PeerPort => $self->{port},
195 unless ($self->{socket}) {
196 $self->_setError ($!, 1);
201 $self->{socket}->autoflush;
203 # Now tell the server what database we wish to use
204 my ($status, @output) = $self->_request (
212 $self->{loggedin} = $status == 0;
214 $self->_setError (@output, $status);
216 return $self->connected;
222 my ($status, @output) = $self->_request ('dbsets');
228 my ($self, $table, $key) = @_;
235 my ($status, @output) = $self->_request ('delete', @parms);
237 return $self->errmsg;
243 $self->disconnectFromServer;
249 $self->disconnectFromServer;
251 $self->{loggedin} = 0;
256 sub disconnectFromServer () {
259 if ($self->{socket}) {
260 $self->_request ('end');
262 close $self->{socket};
264 undef $self->{socket};
268 } # disconnectFromServer
271 my ($self, $table, $condition, @fields) = @_;
275 # TODO: Need to return nbrrecs
276 my ($status, @output) = $self->_request ('find', $table, $condition, @fields);
279 return (undef, $self->errmsg);
281 return ($status, $output[1]);
286 my ($self, $table, $key, @fields) = @_;
290 $self->_setError ('', 0);
292 my ($status, @output) = $self->_request ('get', $table, $key, @fields);
297 my ($field, $value) = split /\@\@/;
299 $value =~ s/ /\n/g;
301 if ($record{$field}) {
302 if (ref $record{$field} ne 'ARRAY') {
303 my $valueOne = $record{$field};
305 $record{$field} = ();
307 push @{$record{$field}}, $valueOne, $value;
309 push @{$record{$field}}, $value;
312 $record{$field} = $value;
320 my ($self, $table, $dbid, @fields) = @_;
324 my ($status, @output) = $self->_request ('getDBID', $table, $dbid, @fields);
326 return ($status, %record) if $status;
329 my ($field, $value) = split /\@\@/;
331 $value =~ s/ /\n/g;
333 if ($record{$field}) {
334 if (ref $record{$field} ne 'ARRAY') {
335 my $valueOne = $record{$field};
337 $record{$field} = ();
339 push @{$record{$field}}, $valueOne, $value;
341 push @{$record{$field}}, $value;
344 $record{$field} = $value;
351 sub getDynamicList ($) {
352 my ($self, $list) = @_;
354 my ($status, @output) = $self->_request ('getDynamicList', $list);
360 my ($self, $result) = @_;
362 my ($status, @output) = $self->_request ('getNext', ());
369 my ($field, $value) = split /\@\@/;
371 $value =~ s/ /\n/g;
373 if ($record{$field}) {
374 if (ref $record{$field} ne 'ARRAY') {
375 push @{$record{$field}}, $record{$field}, $value;
377 push @{$record{$field}}, $value;
380 $record{$field} = $value;
390 my ($status, @output) = $self->_request ('key', @_);
395 sub modify ($$$$;@) {
396 my ($self, $table, $key, $action, $values, @ordering) = @_;
398 $action ||= 'Modify';
402 push @parms, $table, $key, $action, Dumper ($values), @ordering;
404 $self->_request ('modify', @parms);
406 return $self->errmsg;
409 sub modifyDBID ($$$$;@) {
410 my ($self, $table, $dbid, $action, $values, @ordering) = @_;
414 push @parms, $table, $dbid, $action, Dumper ($values), @ordering;
416 $self->_request ('modifyDBID', @parms);
418 return $self->errmsg;
424 return $self->{port};
428 my ($class, $self) = @_;
430 $$self{server} ||= $Clearquest::OPTS{CQ_SERVER};
431 $$self{port} ||= $Clearquest::OPTS{CQ_PORT};
439 if ($self->{socket}) {
440 $self->_request ('shutdown');
448 =head1 CONFIGURATION AND ENVIRONMENT
450 DEBUG: If set then $debug is set to this level.
452 VERBOSE: If set then $verbose is set to this level.
454 TRACE: If set then $trace is set to this level.
462 L<File::Basename|File::Basename>
466 L<IO::Socket|IO::Socket>
468 L<Net::hostent|Net::hostent>
472 =head2 ClearSCM Perl Modules
485 <a href="http://clearscm.com/php/scm_man.php?file=lib/DateUtils.pm">DateUtils</a><br>
486 <a href="http://clearscm.com/php/scm_man.php?file=lib/Display.pm">Display</a><br>
487 <a href="http://clearscm.com/php/scm_man.php?file=lib/GetConfig.pm">GetConf</a><br>
494 =head1 BUGS AND LIMITATIONS
496 There are no known bugs in this module.
498 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
500 =head1 LICENSE AND COPYRIGHT
502 Copyright (c) 2011, ClearSCM, Inc. All rights reserved.