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>
1169 if (defined $error) {
1170 $self->{responseCode} = $error;
1172 # If the user has not yet called any underlying REST functionality yet (for
1173 # example, they could have called the find method but have not asked for the
1174 # $nbrRecs) then we cannot call $self->{rest}->responseCode because the
1175 # REST::Client object has not been instantiated yet. So we'll return no
1177 if ($self->{rest}{_res}) {
1178 $self->{responseCode} = $self->{rest}->responseCode;
1180 $self->{responseCode} = 0;
1184 return 0 if $self->{responseCode} >= 200 and $self->{responseCode} < 300;
1185 return $self->{responseCode};
1189 my ($self, $table) = @_;
1193 =head2 fields ($table)
1195 Returns an array of the fields in a table
1199 =for html <blockquote>
1205 Table to return field info from.
1209 =for html </blockquote>
1213 =for html <blockquote>
1219 Array of the fields names for $table
1223 =for html </blockquote>
1227 my $recordID = $self->_getRecordID ($table);
1229 return unless $recordID;
1231 my $url = "$self->{uri}/record-type/$recordID";
1233 $self->_callREST ('get', $url);
1235 return if $self->error;
1237 my %result = %{XMLin ($self->{rest}->responseContent)};
1239 my @fields = keys %{$result{element}{complexType}{choice}{element}};
1244 sub fieldType ($$) {
1245 my ($self, $table, $fieldName) = @_;
1249 =head2 fieldType ($table, $fieldname)
1251 Returns the field type for the $table, $fieldname combination.
1255 =for html <blockquote>
1261 Table to return field type from.
1265 Fieldname to return the field type from.
1269 =for html </blockquote>
1273 =for html <blockquote>
1283 =for html </blockquote>
1287 # If we've already computed the fieldTypes for the fields in this table then
1289 if ($FIELDS{$table}) {
1290 # If we already have this fieldType just return it
1291 if (defined $FIELDS{$table}{$fieldName}) {
1292 return $FIELDS{$table}{$fieldName}{FieldType};
1298 $self->_parseRecordDesc ($table);
1300 if (defined $FIELDS{$table}{$fieldName}) {
1301 return $FIELDS{$table}{$fieldName}{FieldType};
1307 sub fieldReference ($$) {
1308 my ($self, $table, $fieldName) = @_;
1312 =head2 fieldReference ($table, $fieldname)
1314 Returns the name of the table this reference or reference list field references
1315 or undef if this is not a reference or reference list field.
1319 =for html <blockquote>
1325 Table to return field reference from.
1329 Fieldname to return the field type from.
1333 =for html </blockquote>
1337 =for html <blockquote>
1343 Name of table this reference or reference list field references or undef if
1344 this is not a reference or reference list field.
1348 =for html </blockquote>
1352 # If we've already computed the fieldTypes for the fields in this table then
1354 return $FIELDS{$table}{$fieldName}{References} if $FIELDS{$table};
1356 $self->_parseRecordDesc ($table);
1358 return $FIELDS{$table}{$fieldName}{References};
1362 my ($self, $table, $condition, @fields) = @_;
1368 Find records in $table. You can specify a $condition and which fields you wish
1369 to retrieve. Specifying a smaller set of fields means less data transfered and
1370 quicker retrieval so only retrieve the fields you really need.
1374 =for html <blockquote>
1380 Name of the table to search
1384 Condition to use. If you want all records then pass in undef. Only simple
1385 conditions are supported. You can specify compound conditions (e.g. field1 ==
1386 'foo' and field1 == 'bar' or field2 is not null). No parenthesizing is
1391 An array of fieldnames to retrieve
1395 =for html </blockquote>
1399 =for html <blockquote>
1403 =item $result or ($result, $nbrRecs)
1405 Internal structure to be used with getNext. If in an array context then $nbrRecs
1410 =for html </blockquote>
1414 $self->{url} = "$self->{uri}/record/?rcm.type=$table&"
1415 . $self->_parseConditional ($table, $condition);
1417 @fields = $self->_setFields ($table, @fields);
1419 # Remove dbid for find
1420 @fields = grep { $_ ne 'dbid' } @fields;
1423 $self->{url} .= "&oslc_cm.properties=";
1424 $self->{url} .= join ',', @fields;
1427 # Save some fields for getNext
1428 $self->{fields} = \@fields;
1429 $self->{table} = $table;
1431 $self->{url} .= "&oslc_cm.pageSize=1";
1433 return $self->{url} unless wantarray;
1435 # If the user wants an array then he wants ($reesult, $nbrRecs) and so we need
1436 # to go out and get that info.
1437 $self->_callREST ('get', $self->{url});
1439 return (undef, 0) if $self->error;
1441 # Now parse the results
1442 my %result = %{XMLin ($self->{rest}->responseContent)};
1444 return ($self->{url}, $result{'oslc_cm:totalCount'}{content});
1448 my ($self, $table, $key, @fields) = @_;
1452 =head2 get ($table, $key, @fields)
1454 Retrieve records from $table matching $key. Note $key can be a condition (e.g.
1455 Project = 'Athena'). Return back @fields. If @fields is not specified then all
1456 fields are returned.
1458 Warning: Some Clearquest records are large. It's always better and faster to
1459 return only the fields that you need.
1463 =for html <blockquote>
1469 Table to get records from (e.g. 'Defect')
1473 Key to use to get the record. Key is the field that is designated to be the key
1478 An array of field names to return. It's usually better to specify only those
1479 fields that you need.
1483 =for html </blockquote>
1487 =for html <blockquote>
1493 An hash representing the qualifying record.
1497 =for html </blockquote>
1501 my $url = "$self->{uri}/record/?rcm.type=$table&rcm.name=$key";
1504 $url .= "&oslc_cm.properties=";
1505 $url .= 'dbid,' unless grep { /dbid/i } @fields;
1506 $url .= join ',', @fields;
1509 return $self->_getRecord ($table, $url, @fields);
1512 sub getDBID ($$;@) {
1513 my ($self, $table, $dbid, @fields) = @_;
1517 =head2 get ($table, $key, @fields)
1519 Retrieve records from $table matching $key. Note $key can be a condition (e.g.
1520 Project = 'Athena'). Return back @fields. If @fields is not specified then all
1521 fields are returned.
1523 Warning: Some Clearquest records are large. It's always better and faster to
1524 return only the fields that you need.
1528 =for html <blockquote>
1534 Table to get records from (e.g. 'Defect')
1538 Key to use to get the record. Key is the field that is designated to be the key
1543 An array of field names to return. It's usually better to specify only those
1544 fields that you need.
1548 =for html </blockquote>
1552 =for html <blockquote>
1558 An hash representing the qualifying record.
1562 =for html </blockquote>
1566 my $url = "$self->{uri}/record/";
1567 $url .= $self->_getRecordID ($table);
1572 $url .= "?oslc_cm.properties=";
1573 $url .= 'dbid,' unless grep { /dbid/i } @fields;
1574 $url .= join ',', @fields;
1577 return $self->_getRecord ($table, $url);
1580 sub getDynamicList () {
1581 croak ((caller(0))[3] . ' is not implemented');
1585 my ($self, $result) = @_;
1591 Return the next record that qualifies from a preceeding call to the find method.
1595 =for html <blockquote>
1601 The $result returned from find.
1605 =for html </blockquote>
1609 =for html <blockquote>
1615 Hash of name/value pairs for the @fields specified to find.
1619 =for html </blockquote>
1623 return unless $self->{url};
1625 my $url = $self->{url};
1627 $self->_callREST ('get', $url);
1629 return if $self->error;
1631 # Now parse the results
1632 my %result = %{XMLin ($self->{rest}->responseContent)};
1637 if (ref $result{link} eq 'ARRAY') {
1638 foreach (@{$result{link}}) {
1639 if ($$_{rel} eq 'next') {
1640 ($self->{url}) = ($$_{href} =~ /^http.*$self->{server}(.*)/);
1649 if (ref $result{entry}{content}{$self->{table}} eq 'HASH') {
1650 %record = $self->_parseFields ($self->{table}, %{$result{entry}{content}{$self->{table}}});
1651 } elsif (ref $result{entry} eq 'HASH') {
1652 if ($result{entry}{id}) {
1653 %record = $self->_getRecordURL ($self->{table}, $result{entry}{id}, @{$self->{fields}});
1658 if ($result{entry}{link}{href} =~ /-(\d+)$/) {
1666 my ($self, $table, $dbid) = @_;
1672 Return the key of the record given a $dbid
1674 NOTE: Not supported in REST implementation.
1678 =for html <blockquote>
1684 Name of the table to lookup
1688 Database ID of the record to retrieve
1692 =for html </blockquote>
1696 =for html <blockquote>
1704 =for html </blockquote>
1708 croak "The method key is not support in the REST interface";
1711 sub modify ($$$$;@) {
1712 my ($self, $table, $key, $action, $values, @ordering) = @_;
1716 =head2 modify ($table, $key, $action, $values, @ordering)
1718 Updates records from $table matching $key.
1722 =for html <blockquote>
1728 Table to modify records (e.g. 'Defect')
1732 The $key of the record to modify.
1736 Action to use for modification (Default: Modify). You can use this to change
1737 state for stateful records.
1741 Hash reference containing name/value that have the new values for the fields
1745 Array containing field names that need to be processed in order. Not all fields
1746 mentioned in the $values hash need be mentioned here. If you have fields that
1747 must be set in a particular order you can mention them here. So, if you're
1748 modifying the Defect record, but you need Project set before Platform, you need
1749 only pass in an @ordering of qw(Project Platform). They will be done first, then
1750 all of the rest of the fields in the $values hash. If you have no ordering
1751 dependencies then you can simply omit @ordering.
1753 Note that the best way to determine if you have an ordering dependency try using
1754 a Clearquest client and note the order that you set fields in. If at anytime
1755 setting one field negates another field via action hook code then you have just
1756 figured out that this field needs to be set before the file that just got
1761 =for html </blockquote>
1765 =for html <blockquote>
1771 Error message (if any)
1775 =for html </blockquote>
1779 my %values = %$values;
1780 my $xml = _startXML $table;
1782 $action ||= 'Modify';
1784 my $query = $self->_getInternalID ($table, $key);
1786 # Remove host portion
1787 $query =~ s/^http.*$self->{server}//;
1790 $query .= "?rcm.action=$action";
1792 # First process all fields in the @ordering, if specified
1793 $xml .= $self->_setFieldValue ($table, $_, $values{$_}) foreach (@ordering);
1795 foreach my $field (keys %values) {
1796 next if InArray $field, @ordering;
1798 $xml .= $self->_setFieldValue ($table, $field, $values{$field});
1801 $xml .= "</$table>";
1803 $self->_callREST ('put', $query, $xml);
1805 return $self->errmsg;
1808 sub modifyDBID ($$$$;@) {
1809 my ($self, $table, $dbid, $action, $values, @ordering) = @_;
1813 =head2 modifyDBID ($table, $dbid, $action, %update)
1815 Updates records from $table matching $dbid.
1819 =for html <blockquote>
1825 Table to modify records (e.g. 'Defect')
1829 The $dbid of the record to modify.
1833 Action to use for modification (Default: Modify). You can use this to change
1834 state for stateful records.
1838 Hash reference containing name/value that have the new values for the fields
1842 Array containing field names that need to be processed in order. Not all fields
1843 mentioned in the $values hash need be mentioned here. If you have fields that
1844 must be set in a particular order you can mention them here. So, if you're
1845 modifying the Defect record, but you need Project set before Platform, you need
1846 only pass in an @ordering of qw(Project Platform). They will be done first, then
1847 all of the rest of the fields in the $values hash. If you have no ordering
1848 dependencies then you can simply omit @ordering.
1850 Note that the best way to determine if you have an ordering dependency try using
1851 a Clearquest client and note the order that you set fields in. If at anytime
1852 setting one field negates another field via action hook code then you have just
1853 figured out that this field needs to be set before the file that just got
1858 =for html </blockquote>
1862 =for html <blockquote>
1868 Error message (if any)
1872 =for html </blockquote>
1876 my %values = %$values;
1877 my $xml = _startXML $table;
1879 $action ||= 'Modify';
1881 my $query = "$self->{uri}/record/";
1882 $query .= $self->_getRecordID ($table);
1887 $query .= "?rcm.action=$action";
1889 # First process all fields in the @ordering, if specified
1890 $xml .= $self->_setFieldValue ($table, $_, $values{$_}) foreach (@ordering);
1892 foreach my $field (keys %values) {
1893 next if InArray $field, @ordering;
1895 $xml .= $self->_setFieldValue ($table, $field, $values{$field});
1898 $xml .= "</$table>";
1900 $self->_callREST ('put', $query, $xml);
1902 return $self->errmsg;
1906 my ($class, $self) = @_;
1912 Instantiate a new REST object. You can override the standard options by passing
1913 them in as a hash in %parms.
1917 =for html <blockquote>
1923 Hash of overriding options
1927 =for html </blockquote>
1931 =for html <blockquote>
1939 =for html </blockquote>
1943 $self->{server} ||= $Clearquest::OPTS{CQ_SERVER};
1945 $$self{base_url} = "$self->{server}/cqweb/oslc",
1946 $$self{uri} = "/cqweb/oslc/repo/$self->{dbset}/db/$self->{database}",
1948 # 'OSLC-Core-Version' => '2.0',
1949 Accept => 'application/xml',
1950 Authorization => 'Basic '
1951 . encode_base64 "$self->{username}:$self->{password}",
1954 bless $self, $class;
1956 # We create this UserAgent and Cookie Jar so we can set cookies to be
1957 # remembered and passed back and forth automatically. By doing this we re-use
1958 # the JSESSIONID cookie we allows us to reuse our login and to dispose of the
1959 # login session properly when we are destroyed.
1960 my $userAgent = LWP::UserAgent->new;
1962 # Set the cookie jar to use in-memory cookie management, cookies can be
1963 # persisted to disk, see HTTP::Cookies for more info.
1964 $userAgent->cookie_jar (HTTP::Cookies->new);
1966 $self->{rest} = REST::Client->new (
1967 host => $self->{server},
1970 useragent => $userAgent,
1983 Returns a hash of all records and their record numbers
1987 =for html <blockquote>
1995 =for html </blockquote>
1999 =for html <blockquote>
2005 Hash of records and their record numbers
2009 =for html </blockquote>
2015 my $url = "$self->{uri}/record-type/";
2017 $self->_callREST ('get', $url);
2019 unless ($self->error) {
2020 my %result = %{XMLin ($self->{rest}->responseContent)};
2022 foreach my $uri (keys %{$result{entry}}) {
2023 my ($recordID) = ($uri =~ /\/(\d+)/);
2025 $RECORDS{$result{entry}{$uri}{title}} = $recordID;
2039 Returns the response content
2043 =for html <blockquote>
2051 =for html </blockquote>
2055 =for html <blockquote>
2059 =item $respondContent
2061 Response content from the last REST call
2065 =for html </blockquote>
2069 return $self->{rest}->responseContent;
2079 Returns the current username (or the username that would be used)
2083 =for html <blockquote>
2091 =for html </blockquote>
2095 =for html <blockquote>
2103 =for html </blockquote>
2107 return $self->{username};
2114 =head1 CONFIGURATION AND ENVIRONMENT
2116 DEBUG: If set then $debug is set to this level.
2118 VERBOSE: If set then $verbose is set to this level.
2120 TRACE: If set then $trace is set to this level.
2130 L<File::Basename|File::Basename>
2132 L<HTTP::Cookies|HTTP::Cookies>
2134 L<LWP::UserAgent|LWP::UserAgent>
2136 L<MIME::Base64|MIME::Base64>
2138 L<REST::Client|REST::Client>
2140 L<XML::Simple|XML::Simple>
2142 L<MIME::Base64|MIME::Base64>
2144 =head2 ClearSCM Perl Modules
2155 <a href="http://clearscm.com/php/scm_man.php?file=lib/GetConfig.pm">GetConf</a><br>
2162 =head1 BUGS AND LIMITATIONS
2164 There are no known bugs in this module.
2166 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
2168 =head1 LICENSE AND COPYRIGHT
2170 Copyright (c) 2012, ClearSCM, Inc. All rights reserved.