3 =head1 NAME $RCSfile: REST.pm,v $
5 Clearquest REST client - Provide access to Clearquest via the REST interface
13 Andrew DeFaria <Andrew@ClearSCM.com>
21 Wed May 30 11:43:41 PDT 2011
25 $Date: 2013/03/26 02:24:01 $
31 Provides a RESTful interface to Clearquest
35 This module implements a simple interface to Clearquest. The backend uses REST
36 however this module hides all of the ugly details of the REST implementation.
37 Since REST is used, however, this module can be used by any normal Perl. See
38 Perl Modules below of a list of Perl modules required.
40 This module is object oriented so you need to instantiate an object. Be careful
41 to make sure that you properly disconect from this object (See disconnect
44 The methods exported are simple: add, delete, get, modify... In most cases you
45 simply need to supply the table name and a hash of name value pairs to perform
46 actions. Record hashes representing name/value parts for the fields in the
47 records are returned to you.
49 Here's an example of use:
56 $cq->disconnect if $cq;
59 $cq = Clearquest->new (CQ_MODULE => 'rest');
63 my %record = $cq->get ('Project', 'Athena');
67 Projects => 'Island', '21331', 'Hera' ],
70 $cq->modify ('VersionInfo', '1.0', 'Modify', \%update);
73 die "Unable to modify record\n" . $cq->errmsg;
78 Multiline text strings are limited to only 2000 characters by default. In order
79 to expand this you need to change the cqrest.properties file in:
81 C:\Program Files (x86)\IBM\RationalSDLC\common\CM\profiles\cmprofile\installedApps\dfltCell\TeamEAR.ear\cqweb.war\WEB-INF\classes
83 on the web server. Multiline text strings can theoretically grow to 2 gig,
84 however when set even as small as 10 meg REST messes up!
88 The following methods are available:
92 package Clearquest::REST;
100 use CGI qw (escapeHTML);
112 use parent 'Clearquest';
114 our $VERSION = '$Revision: 2.16 $';
115 ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
121 Options are keep in the cq.conf file in the etc directory. They specify the
122 default options listed below. Or you can export the option name to the env(1) to
123 override the defaults in cq.conf. Finally you can programmatically set the
124 options when you call new by passing in a %parms hash. The items below are the
125 key values for the hash.
127 =for html <blockquote>
133 The web host to contact with leading http://
137 User name to connect as (Default: From cq.conf)
141 Password for CQ_USERNAME
145 Name of database to connect to (Default: From cq.conf)
149 Database Set name (Default: From cq.conf)
155 our (%RECORDS, %FIELDS);
160 my $MULTILINE_STRING = 1;
162 my $REFERENCE_LIST = 3;
164 my $ATTACHMENT_LIST = 5;
170 sub _callREST ($$$;%) {
171 my ($self, $type, $url, $body, %parms) = @_;
173 # Set error and errmsg to no error
175 $self->{errmsg} = '';
177 # Upshift the call type as the calls are actually like 'GET' and not 'get'
180 # We only support these call types
181 croak "Unknown call type \"$type\""
182 unless $type eq 'GET' or
185 $type eq 'OPTIONS' or
190 # If the caller did not give us authorization then use the login member we
191 # already have in the object
192 unless ($parms{Authorization}) {
193 $parms{$_} = $self->{login}{$_} foreach (keys %{$self->{login}});
196 # We need to use OSLC 2.0 for the conditional "is not null". So if we see a
197 # "oslc.where" in the URL then add OSLC-Core-Version => '2.0' to %parms.
198 if ($url =~ /oslc.where/) {
199 $parms{'OSLC-Core-Version'} = '2.0';
202 # Remove the host portion if any
203 $url =~ s/^http.*$self->{server}//;
205 # Call the REST call (Different calls have different numbers of parameters)
206 if ($type eq 'GET' or
208 $type eq 'OPTIONS' or
210 $self->{rest}->$type ($url, \%parms);
212 $self->{rest}->$type ($url, $body, \%parms);
218 sub _getRecordName ($) {
219 my ($self, $query) = @_;
221 $self->_callREST ('get', $query);
224 $self->errmsg ("Unable to get record name for $query");
229 my %record = %{XMLin ($self->{rest}->responseContent)};
231 return $record{element}{name};
234 sub _getAttachmentList ($$) {
235 my ($self, $result, $fields) = @_;
237 croak ((caller(0))[3] . ' is not implemented');
240 } # _getAttachmentList
242 sub _getInternalID ($$) {
243 my ($self, $table, $key) = @_;
245 my $query = "/cqweb/oslc/repo/$self->{dbset}/db/$self->{database}/record/?rcm.type=$table&";
247 $query .= "rcm.name=$key";
249 $self->_callREST ('get', $query);
251 unless ($self->error) {
252 my %result = %{XMLin ($self->{rest}->responseContent)};
254 return $result{entry}{id};
256 $self->errmsg ("Record not found (Table: $table, Key: \"$key\")");
258 return $self->errmsg;
262 sub _getRecord ($$@) {
263 my ($self, $table, $url, @fields) = @_;
265 $self->{fields} = [$self->_setFields ($table, @fields)];
267 $self->_callREST ('get', $url);
269 return if $self->error;
271 # Now parse the results
272 my %result = %{XMLin ($self->{rest}->responseContent)};
274 if ($result{entry}{content}{$table}) {
275 return $self->_parseFields ($table, %{$result{entry}{content}{$table}});
276 } elsif (ref \%result eq 'HASH') {
277 # The if test above will create an empty $result{entry}{content}. We need
279 delete $result{entry};
281 return $self->_parseFields ($table, %result);
287 sub _getRecordID ($) {
288 my ($self, $table) = @_;
292 return $RECORDS{$table};
295 sub _getRecordURL ($$;@) {
296 my ($self, $table, $url, @fields) = @_;
298 $self->{fields} = [$self->_setFields ($table, @fields)];
300 $self->error ($self->_callREST ('get', $url));
302 return if $self->error;
304 return $self->_parseFields ($table, %{XMLin ($self->{rest}->responseContent)});
307 sub _getReferenceList ($$) {
308 my ($self, $url, $field) = @_;
310 $self->error ($self->_callREST ('get', $url));
312 return if $self->error;
314 my %result = %{XMLin ($self->{rest}->responseContent)};
318 # Need to find the field array here...
319 foreach my $key (keys %result) {
320 if (ref $result{$key} eq 'ARRAY') {
321 foreach (@{$result{$key}}) {
322 push @values, $$_{'oslc_cm:label'};
326 } elsif (ref $result{$key} eq 'HASH' and $result{$key}{'oslc_cm:label'}) {
327 push @values, $result{$key}{'oslc_cm:label'};
332 } # _getReferenceList
334 sub _parseCondition ($$) {
335 my ($self, $table, $condition) = @_;
337 # Parse simple conditions only
338 my ($field, $operator, $value);
340 if ($condition =~ /(\w+)\s*(==|=|!=|<>|<=|>=|<|>|in|is\s+null|is\s+not\s+null)\s*(.*)/i) {
345 if ($operator eq '==') {
347 } elsif ($operator eq '<>') {
349 } elsif ($operator =~ /is\s+null/i) {
350 return "$field in [\"\"]";
351 } elsif ($operator =~ /is\s+not\s+null/i) {
352 return "$field in [*]";
353 } elsif ($operator =~ /in/i) {
354 return "$field in [$value]"
358 if ($operator eq '=' and $value =~ /^null$/i) {
359 return "$field in [\"\"]";
360 } elsif ($operator eq '!=' and $value =~ /^null$/i) {
361 return "$field in [*]";
364 # Trim quotes if any:
365 if ($value =~ /^\s*\'/) {
366 $value =~ s/^\s*\'//;
367 $value =~ s/\'\s*$//;
368 } elsif ($value =~ /^\s*\"/) {
369 $value =~ s/^\s*\"//;
370 $value =~ s/\"\s*$//;
373 # Trim leading and trailing whitespace
377 # Convert datetimes to Zulu
378 if ($self->fieldType ($table, $field) == $DATE_TIME and
379 $value !~ /\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2}Z/) {
380 $value = Clearquest::_UTCTime ($value);
383 return "$field $operator \"$value\"";
386 sub _parseConditional ($$) {
387 my ($self, $table, $condition) = @_;
389 return 'oslc_cm.query=' unless $condition;
391 my $parsedConditional;
393 # Special case when the condition is ultra simple
394 if ($condition !~ /(\w+)\s*(==|=|!=|<>|<|>|<=|>=|in|is\s+null|is\s+not\s+null)\s*(.*)/i) {
395 return "rcm.name=$condition";
398 # TODO: This section needs improvement to handle more complex conditionals
400 if ($condition =~ /(.+?)\s+(and|or)\s+(.+)/i) {
401 my $leftSide = $self->_parseCondition ($table, $1);
403 $parsedConditional .= "$leftSide $2 ";
406 $parsedConditional .= $self->_parseCondition ($table, $condition);
412 # TODO: How would this work if we have a condition like 'f1 = "value" and
414 if ($parsedConditional =~ /in \[\*\]/) {
415 return "oslc.where=$parsedConditional";
417 return "oslc_cm.query=$parsedConditional";
419 } # _parseConditional
421 sub _parseFields ($%) {
422 my ($self, $table, %record) = @_;
424 foreach my $field (keys %record) {
427 grep {/^$field$/} @{$self->{fields}} == 0) {
428 delete $record{$field};
433 my $fieldType = $self->fieldType ($table, $field);
435 if (ref $record{$field} eq 'HASH') {
436 if ($fieldType == $REFERENCE) {
437 $record{$field} = $record{$field}{'oslc_cm:label'};
438 } elsif ($fieldType == $REFERENCE_LIST) {
439 my @values = $self->_getReferenceList ($record{$field}{'oslc_cm:collref'}, $field);
441 $record{$field} = \@values;
442 } elsif ($fieldType == $ATTACHMENT_LIST) {
443 my @attachments = $self->_getAttachmentList ($record{$field}{'oslc_cm:collref'}, $field);
445 $record{$field} = \@attachments;
446 } elsif ($fieldType == $RECORD_TYPE) {
447 $record{$field} = $record{$field}{'oslc_cm:label'};
448 } elsif (!%{$record{$field}}) {
449 $record{$field} = undef;
453 $record{$field} ||= '' if $self->{emptyStringForUndef};
455 if ($fieldType == $DATE_TIME) {
456 $record{$field} = Clearquest::_UTC2Localtime $record{$field};
463 sub _parseRecordDesc ($) {
464 my ($self, $table) = @_;
466 # Need to get fieldType info
467 my $recordID = $self->_getRecordID ($table);
469 return unless $recordID;
471 my $url = "$self->{uri}/record-type/$recordID";
473 $self->_callREST ('get', $url);
475 return if $self->error;
477 my %result = %{XMLin ($self->{rest}->responseContent)};
479 # Reach in deep for field definitions
480 my %fields = %{$result{element}{complexType}{choice}{element}};
482 foreach (keys %fields) {
483 if ($fields{$_}{type} and $fields{$_}{type} eq 'cqf:reference') {
484 $FIELDS{$table}{$_}{FieldType} = $REFERENCE;
485 $FIELDS{$table}{$_}{References} = $self->_getRecordName ($fields{$_}{'cq:refURI'});
486 } elsif ($fields{$_}{type} and $fields{$_}{type} eq 'cqf:multilineString') {
487 $FIELDS{$table}{$_}{FieldType} = $MULTILINE_STRING;
488 } elsif ($fields{$_}{simpleType}) {
489 if ($fields{$_}{simpleType}{restriction}{base}) {
490 if ($fields{$_}{simpleType}{restriction}{base} eq 'string') {
491 $FIELDS{$table}{$_}{FieldType} = $STRING;
492 } elsif ($fields{$_}{simpleType}{union}{simpleType}[0]{restriction}{base} eq 'string') {
493 $FIELDS{$table}{$_}{FieldType} = $STRING;
495 $FIELDS{$table}{$_}{FieldType} = $UNKNOWN;
497 } elsif ($fields{$_}{simpleType}{union}{simpleType}[0]{restriction}{base} eq 'string') {
498 $FIELDS{$table}{$_}{FieldType} = $STRING;
499 } elsif ($fields{$_}{simpleType}{union}{simpleType}[0]{restriction}{base} eq 'cqf:integer') {
500 $FIELDS{$table}{$_}{FieldType} = $INT;
502 $FIELDS{$table}{$_} = $UNKNOWN;
504 } elsif ($fields{$_}{complexType} and $fields{$_}{'cq:refURI'}) {
505 $FIELDS{$table}{$_}{FieldType} = $REFERENCE_LIST;
506 $FIELDS{$table}{$_}{References} = $self->_getRecordName ($fields{$_}{'cq:refURI'});
507 } elsif ($fields{$_}{complexType} and
508 $fields{Symptoms}{complexType}{sequence}{element}{simpleType}{union}{simpleType}[1]{restriction}{base} eq 'string') {
509 $FIELDS{$table}{$_}{FieldType} = $MULTILINE_STRING;
510 } elsif ($fields{$_}{type} and $fields{$_}{type} eq 'cqf:journal') {
511 $FIELDS{$table}{$_}{FieldType} = $JOURNAL;
512 } elsif ($fields{$_}{type} and $fields{$_}{type} eq 'cqf:attachmentList') {
513 $FIELDS{$table}{$_}{FieldType} = $ATTACHMENT_LIST;
514 } elsif ($fields{$_}{type} and $fields{$_}{type} eq 'cqf:integer') {
515 $FIELDS{$table}{$_}{FieldType} = $INT;
516 } elsif ($fields{$_}{type} and $fields{$_}{type} eq 'cqf:dateTime') {
517 $FIELDS{$table}{$_}{FieldType} = $DATE_TIME;
518 } elsif ($fields{$_}{type} and $fields{$_}{type} eq 'cqf:recordType') {
519 $FIELDS{$table}{$_}{FieldType} = $RECORD_TYPE;
521 $FIELDS{$table}{$_}{FieldType} = $UNKNOWN;
524 if ($fields{$_}{'cq:systemOwned'} and $fields{$_}{'cq:systemOwned'} eq 'true') {
525 $FIELDS{$table}{$_}{SystemField} = 1;
527 $FIELDS{$table}{$_}{SystemField} = 0;
534 sub _isSystemField ($$) {
535 my ($self, $table, $fieldName) = @_;
537 if ($FIELDS{$table}) {
538 # If we already have this fieldType just return it
539 if (defined $FIELDS{$table}{$fieldName}) {
540 return $FIELDS{$table}{$fieldName}{SystemField};
546 $self->_parseRecordDesc ($table);
548 if (defined $FIELDS{$table}{$fieldName}) {
549 return $FIELDS{$table}{$fieldName}{SystemField};
555 sub _setFields ($@) {
556 my ($self, $table, @fields) = @_;
558 # Cause %FIELDS to be expanded for $table
559 $self->_parseRecordDesc ($table);
562 foreach ($self->fields ($table)) {
563 unless ($self->{returnSystemFields}) {
564 next if $FIELDS{$table}{$_}{SystemField}
571 push @fields, 'dbid' unless grep { /dbid/ } @fields;
576 sub _setFieldValue ($$$) {
577 my ($self, $table, $fieldName, $fieldValue) = @_;
579 return if $self->_isSystemField ($table, $fieldName);
581 my $xml .= "<$fieldName>";
583 my $fieldType = $self->fieldType ($table, $fieldName);
585 if ($fieldType == $STRING or
586 $fieldType == $MULTILINE_STRING or
587 $fieldType == $INT or
588 $fieldType == $DATE_TIME) {
589 # Fix MULTILINE_STRINGs
590 if ($fieldType == $MULTILINE_STRING and ref $fieldValue eq 'ARRAY') {
593 $fieldValue= join "\n", @$fieldValue;
596 $xml .= escapeHTML $fieldValue;
597 } elsif ($fieldType == $REFERENCE) {
598 my $tableReferenced = $self->fieldReference ($table, $fieldName);
600 if ($tableReferenced) {
601 $xml .= $self->_getInternalID ($tableReferenced, $fieldValue);
604 $self->errmsg ("Could not determine reference for $fieldName");
608 } elsif ($fieldType == $REFERENCE_LIST) {
609 # We'll allow either an array reference or a single value, which we will
613 @values = ref $fieldValue eq 'ARRAY' ? @$fieldValue
616 my $tableReferenced = $self->fieldReference ($table, $fieldName);
618 unless ($tableReferenced) {
620 $self->errmsg ("Could not determine reference for $fieldName");
626 my $internalID = $self->_getInternalID ($tableReferenced, $_);
629 $xml .= "<value rdf:resource=\"$internalID\" oslc_cm:label=\"$_\"/>\n";
632 $self->errmsg ("Could not find a valid/active $tableReferenced with a key of \"$_\"");
638 croak "Unable to handle field $fieldName fieldType: " . $self->fieldTypeName ($table, $fieldName);
641 $xml .= "</$fieldName>\n";
650 <?xml version="1.0" encoding="UTF-8"?>
652 xmlns="http://www.ibm.com/xmlns/prod/rational/clearquest/1.0/"
653 xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
654 xmlns:dc="http://purl.org/dc/terms/"
655 xmlns:oslc_cm="http://open-services.net/xmlns/cm/1.0/">
662 my ($self, $table, $record, @ordering) = @_;
666 =head2 add ($table, %record)
668 Adds a %record to $table.
672 =for html <blockquote>
678 Table to add a record to (e.g. 'Defect')
682 Hash reference of name/value pairs for the insertion
686 Array containing field names that need to be processed in order. Not all fields
687 mentioned in the $values hash need be mentioned here. If you have fields that
688 must be set in a particular order you can mention them here. So, if you're
689 adding the Defect record, but you need Project set before Platform, you need
690 only pass in an @ordering of qw(Project Platform). They will be done first, then
691 all of the rest of the fields in the $values hash. If you have no ordering
692 dependencies then you can simply omit @ordering.
694 Note that the best way to determine if you have an ordering dependency try using
695 a Clearquest client and note the order that you set fields in. If at anytime
696 setting one field negates another field via action hook code then you have just
697 figured out that this field needs to be set before the file that just got
702 =for html </blockquote>
706 =for html <blockquote>
712 Error message (if any)
716 =for html </blockquote>
720 my %record = %$record;
721 my $xml = _startXML $table;
722 my $uri = $self->{uri} . '/record';
724 # First process all fields in the @ordering, if specified
725 $xml .= $self->_setFieldValue ($table, $_, $record{$_}) foreach (@ordering);
727 foreach my $field (keys %record) {
728 next if InArray $field, @ordering;
730 $xml .= $self->_setFieldValue ($table, $field, $record{$field});
735 $self->_callREST ('post', $uri, $xml);
737 # Get the DBID of the newly created record
738 if ($self->{rest}{_res}{_headers}{location} =~ /-(\d+)$/) {
745 sub connect (;$$$$) {
746 my ($self, $username, $password, $database, $dbset) = @_;
750 =head2 connect (;$$$$)
752 This method doesn't really connect but is included to be similar to the
753 Clearquest::connect method. It does set any of the username, password,
754 database and/or dbset members
758 =for html <blockquote>
764 Username to use to connect to the database
768 Password to use to connect to the database
772 Clearquest database to connect to
776 Database set to connect to (Default: Connect to the default dbset)
780 =for html </blockquote>
784 =for html <blockquote>
792 =for html </blockquote>
796 if (ref $username eq 'HASH') {
797 my %opts = %$username;
799 $self->{username} = delete $opts{CQ_USERNAME};
800 $self->{password} = delete $opts{CQ_PASSWORD};
801 $self->{database} = delete $opts{CQ_DATABASE};
802 $self->{dbset} = delete $opts{CQ_DBSET};
804 $self->{username} = $username if $username;
805 $self->{password} = $password if $password;
806 $self->{database} = $database if $database;
807 $self->{dbset} = $dbset if $dbset;
810 # Set URI in case anything changed
811 $self->{uri} = "/cqweb/oslc/repo/$self->{dbset}/db/$self->{database}";
812 $self->{loggedin} = 1;
824 Returns 1 if we are currently connected to Clearquest
828 =for html <blockquote>
836 =for html </blockquote>
840 =for html <blockquote>
844 =item 1 if logged in - 0 if not
848 =for html </blockquote>
852 return $self->{loggedin};
862 Returns the current database (or the database that would be used)
866 =for html <blockquote>
874 =for html </blockquote>
878 =for html <blockquote>
886 =for html </blockquote>
890 return $self->{database};
900 Returns the current dbset (or the dbset that would be used)
904 =for html <blockquote>
912 =for html </blockquote>
916 =for html <blockquote>
924 =for html </blockquote>
928 return $self->{dbset};
932 croak ((caller(0))[3] . ' is not implemented');
936 my ($self, $table, $key) = @_;
940 =head2 delete ($table, $key)
942 Deletes a %record from $table.
946 =for html <blockquote>
952 Table from which to delete a record from (e.g. 'Defect')
956 Key of the record to delete
960 =for html </blockquote>
964 =for html <blockquote>
970 Error message (if any)
974 =for html </blockquote>
978 my $query = $self->_getInternalID ($table, $key);
980 # Need to remove $self->{server} from beginning of $query
981 $query =~ s/^http.*$self->{server}//;
983 $self->_callREST ('delete', $query);
985 return $self->errmsg;
991 # Attempt to delete session if we still have a rest object. Note that during
992 # global destruction (like when you die or exit), the ordering of destruction
993 # is unpredictable so we might not succeed.
994 return unless $self->{rest};
996 # Delete session - ignore error as there's really nothing we can do if this
998 $self->_callREST ('delete', '/cqweb/oslc/session/');
1000 croak "Unable to release REST session in destructor" if $self->error;
1010 =head2 disconnect ()
1012 Disconnects from REST. Note you should take care to call disconnect or use undef
1013 to undefine your instantiated Clearquest::REST object. If your script dies or
1014 exits without disconnecting you may cause web sessions to remain. You might try
1017 use Clearquest::REST;
1019 my $cq = Clearquest::REST->new;
1022 $cq->disconnect if $cq;
1027 =for html <blockquote>
1035 =for html </blockquote>
1039 =for html <blockquote>
1045 Error number (if any)
1049 =for html </blockquote>
1053 return unless $self->{rest};
1055 $self->_callREST ('delete', '/cqweb/oslc/session/');
1057 return $self->error;
1061 my ($self, $errmsg) = @_;
1065 =head2 errmsg ($errmsg)
1067 Returns the last error message. Optionally sets the error message if specified.
1071 =for html <blockquote>
1077 Error message to set
1081 =for html </blockquote>
1085 =for html <blockquote>
1095 =for html </blockquote>
1100 $self->{errmsg} = $errmsg;
1102 # User defined errors are in the 600 series. If we have a user defined
1103 # error and the caller did not supply us an errmsg to set then they want
1104 # the user defined error we set so just return that.
1105 if ($self->{responseCode} >= 600) {
1106 return $self->{errmsg};
1108 my $response = $self->response;
1110 if ($response and $response ne '') {
1111 my %xml = %{XMLin ($self->response)};
1113 if ($xml{Error}{message}) {
1114 $self->{errmsg} = $xml{Error}{message};
1115 } elsif (ref $xml{message} ne 'HASH' and $xml{message}) {
1116 $self->{errmsg} = $xml{message};
1118 $self->{errmsg} = 'Unknown error';
1121 $self->{errmsg} = '';
1126 return $self->{errmsg};
1130 my ($self, $error) = @_;
1134 =head2 error ($error)
1136 Returns the last error number. Optional set the error number if specified
1140 =for html <blockquote>
1150 =for html </blockquote>
1154 =for html <blockquote>
1164 =for html </blockquote>
1168 if (defined $error) {
1169 $self->{responseCode} = $error;
1171 # If the user has not yet called any underlying REST functionality yet (for
1172 # example, they could have called the find method but have not asked for the
1173 # $nbrRecs) then we cannot call $self->{rest}->responseCode because the
1174 # REST::Client object has not been instantiated yet. So we'll return no
1176 if ($self->{rest}{_res}) {
1177 $self->{responseCode} = $self->{rest}->responseCode;
1179 $self->{responseCode} = 0;
1183 return 0 if $self->{responseCode} >= 200 and $self->{responseCode} < 300;
1184 return $self->{responseCode};
1188 my ($self, $table) = @_;
1192 =head2 fields ($table)
1194 Returns an array of the fields in a table
1198 =for html <blockquote>
1204 Table to return field info from.
1208 =for html </blockquote>
1212 =for html <blockquote>
1218 Array of the fields names for $table
1222 =for html </blockquote>
1226 my $recordID = $self->_getRecordID ($table);
1228 return unless $recordID;
1230 my $url = "$self->{uri}/record-type/$recordID";
1232 $self->_callREST ('get', $url);
1234 return if $self->error;
1236 my %result = %{XMLin ($self->{rest}->responseContent)};
1238 my @fields = keys %{$result{element}{complexType}{choice}{element}};
1243 sub fieldType ($$) {
1244 my ($self, $table, $fieldName) = @_;
1248 =head2 fieldType ($table, $fieldname)
1250 Returns the field type for the $table, $fieldname combination.
1254 =for html <blockquote>
1260 Table to return field type from.
1264 Fieldname to return the field type from.
1268 =for html </blockquote>
1272 =for html <blockquote>
1282 =for html </blockquote>
1286 # If we've already computed the fieldTypes for the fields in this table then
1288 if ($FIELDS{$table}) {
1289 # If we already have this fieldType just return it
1290 if (defined $FIELDS{$table}{$fieldName}) {
1291 return $FIELDS{$table}{$fieldName}{FieldType};
1297 $self->_parseRecordDesc ($table);
1299 if (defined $FIELDS{$table}{$fieldName}) {
1300 return $FIELDS{$table}{$fieldName}{FieldType};
1306 sub fieldReference ($$) {
1307 my ($self, $table, $fieldName) = @_;
1311 =head2 fieldReference ($table, $fieldname)
1313 Returns the name of the table this reference or reference list field references
1314 or undef if this is not a reference or reference list field.
1318 =for html <blockquote>
1324 Table to return field reference from.
1328 Fieldname to return the field type from.
1332 =for html </blockquote>
1336 =for html <blockquote>
1342 Name of table this reference or reference list field references or undef if
1343 this is not a reference or reference list field.
1347 =for html </blockquote>
1351 # If we've already computed the fieldTypes for the fields in this table then
1353 return $FIELDS{$table}{$fieldName}{References} if $FIELDS{$table};
1355 $self->_parseRecordDesc ($table);
1357 return $FIELDS{$table}{$fieldName}{References};
1361 my ($self, $table, $condition, @fields) = @_;
1367 Find records in $table. You can specify a $condition and which fields you wish
1368 to retrieve. Specifying a smaller set of fields means less data transfered and
1369 quicker retrieval so only retrieve the fields you really need.
1373 =for html <blockquote>
1379 Name of the table to search
1383 Condition to use. If you want all records then pass in undef. Only simple
1384 conditions are supported. You can specify compound conditions (e.g. field1 ==
1385 'foo' and field1 == 'bar' or field2 is not null). No parenthesizing is
1390 An array of fieldnames to retrieve
1394 =for html </blockquote>
1398 =for html <blockquote>
1402 =item $result or ($result, $nbrRecs)
1404 Internal structure to be used with getNext. If in an array context then $nbrRecs
1409 =for html </blockquote>
1413 $self->{url} = "$self->{uri}/record/?rcm.type=$table&"
1414 . $self->_parseConditional ($table, $condition);
1416 @fields = $self->_setFields ($table, @fields);
1418 # Remove dbid for find
1419 @fields = grep { $_ ne 'dbid' } @fields;
1422 $self->{url} .= "&oslc_cm.properties=";
1423 $self->{url} .= join ',', @fields;
1426 # Save some fields for getNext
1427 $self->{fields} = \@fields;
1428 $self->{table} = $table;
1430 $self->{url} .= "&oslc_cm.pageSize=1";
1432 return $self->{url} unless wantarray;
1434 # If the user wants an array then he wants ($reesult, $nbrRecs) and so we need
1435 # to go out and get that info.
1436 $self->_callREST ('get', $self->{url});
1438 return (undef, 0) if $self->error;
1440 # Now parse the results
1441 my %result = %{XMLin ($self->{rest}->responseContent)};
1443 return ($self->{url}, $result{'oslc_cm:totalCount'}{content});
1447 my ($self, $table, $key, @fields) = @_;
1451 =head2 get ($table, $key, @fields)
1453 Retrieve records from $table matching $key. Note $key can be a condition (e.g.
1454 Project = 'Athena'). Return back @fields. If @fields is not specified then all
1455 fields are returned.
1457 Warning: Some Clearquest records are large. It's always better and faster to
1458 return only the fields that you need.
1462 =for html <blockquote>
1468 Table to get records from (e.g. 'Defect')
1472 Key to use to get the record. Key is the field that is designated to be the key
1477 An array of field names to return. It's usually better to specify only those
1478 fields that you need.
1482 =for html </blockquote>
1486 =for html <blockquote>
1492 An hash representing the qualifying record.
1496 =for html </blockquote>
1500 my $url = "$self->{uri}/record/?rcm.type=$table&rcm.name=$key";
1503 $url .= "&oslc_cm.properties=";
1504 $url .= 'dbid,' unless grep { /dbid/i } @fields;
1505 $url .= join ',', @fields;
1508 return $self->_getRecord ($table, $url, @fields);
1511 sub getDBID ($$;@) {
1512 my ($self, $table, $dbid, @fields) = @_;
1516 =head2 get ($table, $key, @fields)
1518 Retrieve records from $table matching $key. Note $key can be a condition (e.g.
1519 Project = 'Athena'). Return back @fields. If @fields is not specified then all
1520 fields are returned.
1522 Warning: Some Clearquest records are large. It's always better and faster to
1523 return only the fields that you need.
1527 =for html <blockquote>
1533 Table to get records from (e.g. 'Defect')
1537 Key to use to get the record. Key is the field that is designated to be the key
1542 An array of field names to return. It's usually better to specify only those
1543 fields that you need.
1547 =for html </blockquote>
1551 =for html <blockquote>
1557 An hash representing the qualifying record.
1561 =for html </blockquote>
1565 my $url = "$self->{uri}/record/";
1566 $url .= $self->_getRecordID ($table);
1571 $url .= "?oslc_cm.properties=";
1572 $url .= 'dbid,' unless grep { /dbid/i } @fields;
1573 $url .= join ',', @fields;
1576 return $self->_getRecord ($table, $url);
1579 sub getDynamicList () {
1580 croak ((caller(0))[3] . ' is not implemented');
1584 my ($self, $result) = @_;
1590 Return the next record that qualifies from a preceeding call to the find method.
1594 =for html <blockquote>
1600 The $result returned from find.
1604 =for html </blockquote>
1608 =for html <blockquote>
1614 Hash of name/value pairs for the @fields specified to find.
1618 =for html </blockquote>
1622 return unless $self->{url};
1624 my $url = $self->{url};
1626 $self->_callREST ('get', $url);
1628 return if $self->error;
1630 # Now parse the results
1631 my %result = %{XMLin ($self->{rest}->responseContent)};
1636 if (ref $result{link} eq 'ARRAY') {
1637 foreach (@{$result{link}}) {
1638 if ($$_{rel} eq 'next') {
1639 ($self->{url}) = ($$_{href} =~ /^http.*$self->{server}(.*)/);
1648 if (ref $result{entry}{content}{$self->{table}} eq 'HASH') {
1649 %record = $self->_parseFields ($self->{table}, %{$result{entry}{content}{$self->{table}}});
1650 } elsif (ref $result{entry} eq 'HASH') {
1651 if ($result{entry}{id}) {
1652 %record = $self->_getRecordURL ($self->{table}, $result{entry}{id}, @{$self->{fields}});
1657 if ($result{entry}{link}{href} =~ /-(\d+)$/) {
1665 my ($self, $table, $dbid) = @_;
1671 Return the key of the record given a $dbid
1673 NOTE: Not supported in REST implementation.
1677 =for html <blockquote>
1683 Name of the table to lookup
1687 Database ID of the record to retrieve
1691 =for html </blockquote>
1695 =for html <blockquote>
1703 =for html </blockquote>
1707 croak "The method key is not support in the REST interface";
1710 sub modify ($$$$;@) {
1711 my ($self, $table, $key, $action, $values, @ordering) = @_;
1715 =head2 modify ($table, $key, $action, $values, @ordering)
1717 Updates records from $table matching $key.
1721 =for html <blockquote>
1727 Table to modify records (e.g. 'Defect')
1731 The $key of the record to modify.
1735 Action to use for modification (Default: Modify). You can use this to change
1736 state for stateful records.
1740 Hash reference containing name/value that have the new values for the fields
1744 Array containing field names that need to be processed in order. Not all fields
1745 mentioned in the $values hash need be mentioned here. If you have fields that
1746 must be set in a particular order you can mention them here. So, if you're
1747 modifying the Defect record, but you need Project set before Platform, you need
1748 only pass in an @ordering of qw(Project Platform). They will be done first, then
1749 all of the rest of the fields in the $values hash. If you have no ordering
1750 dependencies then you can simply omit @ordering.
1752 Note that the best way to determine if you have an ordering dependency try using
1753 a Clearquest client and note the order that you set fields in. If at anytime
1754 setting one field negates another field via action hook code then you have just
1755 figured out that this field needs to be set before the file that just got
1760 =for html </blockquote>
1764 =for html <blockquote>
1770 Error message (if any)
1774 =for html </blockquote>
1778 my %values = %$values;
1779 my $xml = _startXML $table;
1781 $action ||= 'Modify';
1783 my $query = $self->_getInternalID ($table, $key);
1785 # Remove host portion
1786 $query =~ s/^http.*$self->{server}//;
1789 $query .= "?rcm.action=$action";
1791 # First process all fields in the @ordering, if specified
1792 $xml .= $self->_setFieldValue ($table, $_, $values{$_}) foreach (@ordering);
1794 foreach my $field (keys %values) {
1795 next if InArray $field, @ordering;
1797 $xml .= $self->_setFieldValue ($table, $field, $values{$field});
1800 $xml .= "</$table>";
1802 $self->_callREST ('put', $query, $xml);
1804 return $self->errmsg;
1807 sub modifyDBID ($$$$;@) {
1808 my ($self, $table, $dbid, $action, $values, @ordering) = @_;
1812 =head2 modifyDBID ($table, $dbid, $action, %update)
1814 Updates records from $table matching $dbid.
1818 =for html <blockquote>
1824 Table to modify records (e.g. 'Defect')
1828 The $dbid of the record to modify.
1832 Action to use for modification (Default: Modify). You can use this to change
1833 state for stateful records.
1837 Hash reference containing name/value that have the new values for the fields
1841 Array containing field names that need to be processed in order. Not all fields
1842 mentioned in the $values hash need be mentioned here. If you have fields that
1843 must be set in a particular order you can mention them here. So, if you're
1844 modifying the Defect record, but you need Project set before Platform, you need
1845 only pass in an @ordering of qw(Project Platform). They will be done first, then
1846 all of the rest of the fields in the $values hash. If you have no ordering
1847 dependencies then you can simply omit @ordering.
1849 Note that the best way to determine if you have an ordering dependency try using
1850 a Clearquest client and note the order that you set fields in. If at anytime
1851 setting one field negates another field via action hook code then you have just
1852 figured out that this field needs to be set before the file that just got
1857 =for html </blockquote>
1861 =for html <blockquote>
1867 Error message (if any)
1871 =for html </blockquote>
1875 my %values = %$values;
1876 my $xml = _startXML $table;
1878 $action ||= 'Modify';
1880 my $query = "$self->{uri}/record/";
1881 $query .= $self->_getRecordID ($table);
1886 $query .= "?rcm.action=$action";
1888 # First process all fields in the @ordering, if specified
1889 $xml .= $self->_setFieldValue ($table, $_, $values{$_}) foreach (@ordering);
1891 foreach my $field (keys %values) {
1892 next if InArray $field, @ordering;
1894 $xml .= $self->_setFieldValue ($table, $field, $values{$field});
1897 $xml .= "</$table>";
1899 $self->_callREST ('put', $query, $xml);
1901 return $self->errmsg;
1905 my ($class, $self) = @_;
1911 Instantiate a new REST object. You can override the standard options by passing
1912 them in as a hash in %parms.
1916 =for html <blockquote>
1922 Hash of overriding options
1926 =for html </blockquote>
1930 =for html <blockquote>
1938 =for html </blockquote>
1942 $self->{server} ||= $Clearquest::OPTS{CQ_SERVER};
1944 $$self{base_url} = "$self->{server}/cqweb/oslc",
1945 $$self{uri} = "/cqweb/oslc/repo/$self->{dbset}/db/$self->{database}",
1947 # 'OSLC-Core-Version' => '2.0',
1948 Accept => 'application/xml',
1949 Authorization => 'Basic '
1950 . encode_base64 "$self->{username}:$self->{password}",
1953 bless $self, $class;
1955 # We create this UserAgent and Cookie Jar so we can set cookies to be
1956 # remembered and passed back and forth automatically. By doing this we re-use
1957 # the JSESSIONID cookie we allows us to reuse our login and to dispose of the
1958 # login session properly when we are destroyed.
1959 my $userAgent = LWP::UserAgent->new;
1961 # Set the cookie jar to use in-memory cookie management, cookies can be
1962 # persisted to disk, see HTTP::Cookies for more info.
1963 $userAgent->cookie_jar (HTTP::Cookies->new);
1965 $self->{rest} = REST::Client->new (
1966 host => $self->{server},
1969 useragent => $userAgent,
1982 Returns a hash of all records and their record numbers
1986 =for html <blockquote>
1994 =for html </blockquote>
1998 =for html <blockquote>
2004 Hash of records and their record numbers
2008 =for html </blockquote>
2014 my $url = "$self->{uri}/record-type/";
2016 $self->_callREST ('get', $url);
2018 unless ($self->error) {
2019 my %result = %{XMLin ($self->{rest}->responseContent)};
2021 foreach my $uri (keys %{$result{entry}}) {
2022 my ($recordID) = ($uri =~ /\/(\d+)/);
2024 $RECORDS{$result{entry}{$uri}{title}} = $recordID;
2038 Returns the response content
2042 =for html <blockquote>
2050 =for html </blockquote>
2054 =for html <blockquote>
2058 =item $respondContent
2060 Response content from the last REST call
2064 =for html </blockquote>
2068 return $self->{rest}->responseContent;
2078 Returns the current username (or the username that would be used)
2082 =for html <blockquote>
2090 =for html </blockquote>
2094 =for html <blockquote>
2102 =for html </blockquote>
2106 return $self->{username};
2113 =head1 CONFIGURATION AND ENVIRONMENT
2115 DEBUG: If set then $debug is set to this level.
2117 VERBOSE: If set then $verbose is set to this level.
2119 TRACE: If set then $trace is set to this level.
2129 L<File::Basename|File::Basename>
2131 L<HTTP::Cookies|HTTP::Cookies>
2133 L<LWP::UserAgent|LWP::UserAgent>
2135 L<MIME::Base64|MIME::Base64>
2137 L<REST::Client|REST::Client>
2139 L<XML::Simple|XML::Simple>
2141 L<MIME::Base64|MIME::Base64>
2143 =head2 ClearSCM Perl Modules
2154 <a href="http://clearscm.com/php/scm_man.php?file=lib/GetConfig.pm">GetConf</a><br>
2161 =head1 BUGS AND LIMITATIONS
2163 There are no known bugs in this module.
2165 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
2167 =head1 LICENSE AND COPYRIGHT
2169 Copyright (c) 2012, ClearSCM, Inc. All rights reserved.