3 =head1 NAME $RCSfile: Clearquest.pm,v $
5 Object oriented interface to Clearquest.
13 Andrew DeFaria <Andrew@ClearSCM.com>
21 Fri Sep 22 09:21:18 CDT 2006
25 $Date: 2013/03/28 22:48:07 $
31 Provides access to Clearquest database in an object oriented manner.
33 # Create Clearquest object
34 my $cq = Clearquest->new;
36 # Connect to database (using all the defaults in cq.conf)
39 # Connect as non standard user;
41 $cq->connect (CQ_USERNAME => 'me', CQ_PASSWORD => 'mypassword');
43 # Get record (Default: all fields)
44 my %record = $cq->get ($recordName, $key);
46 # Get record with specific field list
47 my %record =$cq->get ($recordName, $key, qw(field1 field2))
51 Description => 'This is a new description',
54 $cq->modify ($recordName, $key, 'Modify', \%update);
56 # Change state using modify with an alternate action. Note the use of @ordering
57 my %fieldsToUpdate = (
59 Category => 'New Functionality',
60 Groups => [ 'Group1', 'Group2' ],
63 my @ordering qw(Project Category);
65 $cq->modify ($recordName, $key, 'Open', \%fieldsToUpdate, @ordering);
68 error "Unable to update $key to Opened state\n"
74 This module provides a simple interface to Clearquest in a Perl like fashion.
75 There are three modes of talking to Clearquest using this module - api, rest
78 With module = 'api' you must have Clearquest installed locally and you must use
79 cqperl to execute your script. This mode of operation has the benefit of speed -
80 note that initial connection to the Clearquest database is not very speedy, but
81 all subsequent calls will operate at full speed. The 'api' module is free to
82 use. For the other modules contact ClearSCM, Inc.
84 With module = 'rest' you can access Clearquest by using a RESTFull interface.
85 You can use any Perl which has the required CPAN modules (REST, XML::Simple -
86 see Clearquest::REST for a list of required CPAN modules). The REST interface is
87 a slower than the native api and requires the setup of Clearquest Web (cqweb) on
88 your network. To use the REST interface set CQ_MODULE to 'rest'.
90 With module = 'client' you access Clearquest through the companion
91 Clearquest::Server module and the cqd.pl server script. The server process is
92 started on a machine that has Clearquest installed locally. It uses the api
93 interface for speed and can operate in a multithreaded manner, spawning
94 processes which open and handle requests from Clearquest::Client requests. To
95 use the Client interface set CQ_MODULE to 'client'.
97 Other than setting CQ_MODULE to one of the three modes described above, the rest
98 of your script's usage of the Clearquest module should be exactly the same.
102 This module uses GetConfig to read in a configuration file (../etc/cq.conf)
103 which sets default values described below. Or you can export the option name to
104 the env(1) to override the defaults in cq.conf. Finally you can programmatically
105 set the options when you call new by passing in a %parms hash. To specify the
106 %parms hash key remove the CQ_ portion and lc the rest.
108 =for html <blockquote>
114 Clearquest server to talk to. Also used for rest server (Default: From cq.conf)
118 Port to connect to (Default: From cq.conf)
122 The web host to contact with leading http:// (Default: From cq.conf)
126 Name of database to connect to (Default: From cq.conf)
130 User name to connect as (Default: From cq.conf)
134 Password for CQREST_USERNAME (Default: From cq.conf)
138 Database Set name (Default: From cq.conf)
142 One of 'api', 'rest' or 'client' (Default: From cq.conf)
148 The following methods are available:
163 # Seed options from config file
164 my $config = $ENV{CQ_CONF} || dirname (__FILE__) . '/../etc/cq.conf';
166 croak "Unable to find config file $config" unless -r $config;
168 our %OPTS = GetConfig $config;
170 my $DEFAULT_DBSET = $OPTS{CQ_DBSET};
172 our $VERSION = '$Revision: 2.23 $';
173 ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
175 # Override options if in the environment
176 $OPTS{CQ_DATABASE} = $ENV{CQ_DATABASE} if $ENV{CQ_DATABASE};
177 $OPTS{CQ_DBSET} = $ENV{CQ_DBSET} if $ENV{CQ_DBSET};
178 $OPTS{CQ_MODULE} = $ENV{CQ_MODULE} if $ENV{CQ_MODULE};
179 $OPTS{CQ_PASSWORD} = $ENV{CQ_PASSWORD} if $ENV{CQ_PASSWORD};
180 $OPTS{CQ_PORT} = $ENV{CQ_PORT} if $ENV{CQ_PORT};
181 $OPTS{CQ_SERVER} = $ENV{CQ_SERVER} if $ENV{CQ_SERVER};
182 $OPTS{CQ_USERNAME} = $ENV{CQ_USERNAME} if $ENV{CQ_USERNAME};
187 our $MULTILINE_STRING = 2;
191 our $REFERENCE_LIST = 6;
192 our $ATTACHMENT_LIST = 7;
198 our $RECORD_TYPE = 13;
204 my $SECS_IN_MIN = 60;
205 my $SECS_IN_HOUR = $SECS_IN_MIN * 60;
206 my $SECS_IN_DAY = $SECS_IN_HOUR * 24;
215 |<> # the other not equal
216 |<= # less than or equal
217 |>= # greater than or equal
221 |not\s+like # not like
223 |not\s*between # not between
225 |is\s+not\s+null # is not null
234 # Insure all instaniated objects have been destroyed
235 $_->DESTROY foreach (@objects);
239 sub _commitRecord ($) {
240 my ($self, $entity) = @_;
242 $self->{errmsg} = $entity->Validate;
244 if ($self->{errmsg} eq '') {
245 $self->{errmsg} = $entity->Commit;
246 $self->{error} = $self->{errmsg} eq '' ? 0 : 1;
248 return $self->{errmsg};
254 return $self->{errmsg};
258 sub _is_leap_year ($) {
261 return 0 if $year % 4;
262 return 1 if $year % 100;
263 return 0 if $year % 400;
268 sub _dateToEpoch ($) {
271 my $year = substr $date, 0, 4;
272 my $month = substr $date, 5, 2;
273 my $day = substr $date, 8, 2;
274 my $hour = substr $date, 11, 2;
275 my $minute = substr $date, 14, 2;
276 my $seconds = substr $date, 17, 2;
280 for (my $i = 1970; $i < $year; $i++) {
281 $days += _is_leap_year ($i) ? 366 : 365;
299 $days += $monthDays[$month - 1];
302 if _is_leap_year ($year) and $month > 2;
306 return ($days * $SECS_IN_DAY)
307 + ($hour * $SECS_IN_HOUR)
308 + ($minute * $SECS_IN_MIN)
312 sub _epochToDate ($) {
316 my ($month, $day, $hour, $minute, $seconds);
317 my $leapYearSecs = 366 * $SECS_IN_DAY;
318 my $yearSecs = $leapYearSecs - $SECS_IN_DAY;
321 my $amount = _is_leap_year ($year) ? $leapYearSecs : $yearSecs;
330 my $leapYearAdjustment = _is_leap_year ($year) ? 1 : 0;
332 if ($epoch >= (334 + $leapYearAdjustment) * $SECS_IN_DAY) {
334 $epoch -= (334 + $leapYearAdjustment) * $SECS_IN_DAY;
335 } elsif ($epoch >= (304 + $leapYearAdjustment) * $SECS_IN_DAY) {
337 $epoch -= (304 + $leapYearAdjustment) * $SECS_IN_DAY;
338 } elsif ($epoch >= (273 + $leapYearAdjustment) * $SECS_IN_DAY) {
340 $epoch -= (273 + $leapYearAdjustment) * $SECS_IN_DAY;
341 } elsif ($epoch >= (243 + $leapYearAdjustment) * $SECS_IN_DAY) {
343 $epoch -= (243 + $leapYearAdjustment) * $SECS_IN_DAY;
344 } elsif ($epoch >= (212 + $leapYearAdjustment) * $SECS_IN_DAY) {
346 $epoch -= (212 + $leapYearAdjustment) * $SECS_IN_DAY;
347 } elsif ($epoch >= (181 + $leapYearAdjustment) * $SECS_IN_DAY) {
349 $epoch -= (181 + $leapYearAdjustment) * $SECS_IN_DAY;
350 } elsif ($epoch >= (151 + $leapYearAdjustment) * $SECS_IN_DAY) {
352 $epoch -= (151 + $leapYearAdjustment) * $SECS_IN_DAY;
353 } elsif ($epoch >= (120 + $leapYearAdjustment) * $SECS_IN_DAY) {
355 $epoch -= (120 + $leapYearAdjustment) * $SECS_IN_DAY;
356 } elsif ($epoch >= (90 + $leapYearAdjustment) * $SECS_IN_DAY) {
358 $epoch -= (90 + $leapYearAdjustment) * $SECS_IN_DAY;
359 } elsif ($epoch >= (59 + $leapYearAdjustment) * $SECS_IN_DAY) {
361 $epoch -= (59 + $leapYearAdjustment) * $SECS_IN_DAY;
362 } elsif ($epoch >= 31 * $SECS_IN_DAY) {
364 $epoch -= 31 * $SECS_IN_DAY;
369 $day = int (($epoch / $SECS_IN_DAY) + 1);
370 $epoch = $epoch % $SECS_IN_DAY;
371 $hour = int ($epoch / $SECS_IN_HOUR);
372 $epoch = $epoch % $SECS_IN_HOUR;
373 $minute = int ($epoch / $SECS_IN_MIN);
374 $seconds = $epoch % $SECS_IN_MIN;
376 $day = "0$day" if $day < 10;
377 $hour = "0$hour" if $hour < 10;
378 $minute = "0$minute" if $minute < 10;
379 $seconds = "0$seconds" if $seconds < 10;
381 return "$year-$month-$day $hour:$minute:$seconds";
384 sub _parseCondition ($) {
385 my ($self, $condition) = @_;
387 # Parse simple conditions only
388 my ($field, $operator, $value);
390 if ($condition =~ $operatorRE) {
395 if ($operator eq '==' or $operator eq '=') {
396 if ($value !~ /^null$/i) {
397 $operator = $CQPerlExt::CQ_COMP_OP_EQ;
399 $operator = $CQPerlExt::CQ_COMP_OP_IS_NULL;
401 } elsif ($operator eq '!=' or $operator eq '<>') {
402 if ($value !~ /^null$/i) {
403 $operator = $CQPerlExt::CQ_COMP_OP_NEQ;
405 $operator = $CQPerlExt::CQ_COMP_OP_IS_NOT_NULL;
407 } elsif ($operator eq '<') {
408 $operator = $CQPerlExt::CQ_COMP_OP_LT;
409 } elsif ($operator eq '>') {
410 $operator = $CQPerlExt::CQ_COMP_OP_GT;
411 } elsif ($operator eq '<=') {
412 $operator = $CQPerlExt::CQ_COMP_OP_LTE;
413 } elsif ($operator eq '>=') {
414 $operator = $CQPerlExt::CQ_COMP_OP_GTE;
415 } elsif ($operator =~ /^like$/i) {
416 $operator = $CQPerlExt::CQ_COMP_OP_LIKE;
417 } elsif ($operator =~ /^not\s+like$/i) {
418 $operator = $CQPerlExt::CQ_COMP_OP_NOT_LIKE;
419 } elsif ($operator =~ /^between$/i) {
420 $operator = $CQPerlExt::CQ_COMP_OP_BETWEEN;
421 } elsif ($operator =~ /^not\s+between$/i) {
422 $operator = $CQPerlExt::CQ_COMP_OP_NOT_BETWEEN;
423 } elsif ($operator =~ /^is\s+null$/i) {
424 $operator = $CQPerlExt::CQ_COMP_OP_IS_NULL;
425 } elsif ($operator =~ /^is\s+not\s+null$/i) {
426 $operator = $CQPerlExt::CQ_COMP_OP_IS_NOT_NULL;
427 } elsif ($operator =~ /^in$/i) {
428 $operator = $CQPerlExt::CQ_COMP_OP_IN;
429 } elsif ($operator =~ /^not\s+in$/) {
430 $operator = $CQPerlExt::CQ_COMP_OP_NOT_IN;
432 $self->_setError ("I can't understand the operator $operator");
439 # TODO: How to handle more complicated $condition....
440 $self->_setError ("I can't understand the conditional expression "
448 # Trim quotes if any:
449 if ($value =~ /^\s*\'/) {
450 $value =~ s/^\s*\'//;
451 $value =~ s/\'\s*$//;
452 } elsif ($value =~ /^\s*\"/) {
453 $value =~ s/^\s*\"//;
454 $value =~ s/\"\s*$//;
457 # Trim leading and trailing whitespace
461 return ($field, $operator, $value);
464 sub _parseConditional ($$;$);
465 sub _parseConditional ($$;$) {
466 my ($self, $query, $condition, $filterOperator) = @_;
468 return if $condition eq '';
470 my ($field, $operator, $value);
472 if ($condition =~ /(.+?)\s+(and|or)\s+(.+)/i) {
474 my $conjunction = lc $2;
477 if ($conjunction eq 'and') {
478 unless ($filterOperator) {
479 $filterOperator = $query->BuildFilterOperator ($CQPerlExt::CQ_BOOL_OP_AND);
481 $filterOperator = $filterOperator->BuildFilterOperator ($CQPerlExt::CQ_BOOL_OP_AND);
483 } elsif ($conjunction eq 'or') {
484 unless ($filterOperator) {
485 $filterOperator = $query->BuildFilterOperator ($CQPerlExt::CQ_BOOL_OP_OR);
487 $filterOperator = $filterOperator->BuildFilterOperator ($CQPerlExt::CQ_BOOL_OP_OR);
491 $self->_setCondition ($self->_parseCondition ($leftSide), $filterOperator);
493 $self->_parseConditional ($query, $rightSide, $filterOperator);
495 unless ($condition =~ $operatorRE) {
496 $self->_setError ("Unable to parse condition \"$condition\"");
501 $filterOperator = $query->BuildFilterOperator ($CQPerlExt::CQ_BOOL_OP_AND)
502 unless $filterOperator;
504 $self->_setCondition ($self->_parseCondition ($condition), $filterOperator);
507 # Actually clear error...
511 } # _parseConditional
513 sub _setCondition ($$$) {
514 my ($self, $field, $operator, $value, $filterOperator) = @_;
516 return unless $operator;
518 if ($operator == $CQPerlExt::CQ_COMP_OP_IS_NULL or
519 $operator == $CQPerlExt::CQ_COMP_OP_IS_NOT_NULL) {
520 eval {$filterOperator->BuildFilter ($field, $operator, [()])};
523 $self->_setError ($@);
528 # If the operator is one of the operators that have mulitple values then we
529 # need to make an array of $value
530 if ($operator == $CQPerlExt::CQ_COMP_OP_BETWEEN or
531 $operator == $CQPerlExt::CQ_COMP_OP_NOT_BETWEEN or
532 $operator == $CQPerlExt::CQ_COMP_OP_IN or
533 $operator == $CQPerlExt::CQ_COMP_OP_NOT_IN) {
534 my @values = split /,\s*/, $value;
536 eval {$filterOperator->BuildFilter ($field, $operator, \@values)};
539 $self->_setError ($@);
544 eval {$filterOperator->BuildFilter ($field, $operator, [$value])};
547 $self->_setError ($@);
557 sub _setFields ($@) {
558 my ($self, $table, @fields) = @_;
562 eval {$entityDef = $self->{session}->GetEntityDef ($table)};
565 $self->_setError ($@, -1);
572 push @fields, 'dbid' unless grep {$_ eq 'dbid'} @fields;
574 foreach (@{$entityDef->GetFieldDefNames}) {
575 unless ($self->{returnSystemFields}) {
576 next if $entityDef->IsSystemOwnedFieldDefName ($_);
586 sub _setError (;$$) {
587 my ($self, $errmsg, $error) = @_;
591 if ($errmsg and $errmsg ne '') {
594 $self->{errmsg} = $errmsg;
596 $self->{errmsg} = '';
599 $self->error ($error);
604 sub _setFieldValue ($$$$) {
605 my ($self, $entity, $table, $fieldName, $fieldValue) = @_;
609 my $entityDef = $self->{session}->GetEntityDef ($table);
611 return $errmsg if $entityDef->IsSystemOwnedFieldDefName ($fieldName);
613 unless (ref $fieldValue eq 'ARRAY') {
614 # This is one of those rare instances where it is important to surround a
615 # bare variable with double quotes otherwise the CQ API will wrongly
616 # evaluate $fieldValue if $fieldValue is a simple number (e.g. 0, 1, etc.)
617 $errmsg = $entity->SetFieldValue ($fieldName, "$fieldValue") if $fieldValue;
619 foreach (@$fieldValue) {
620 $errmsg = $entity->AddFieldValue ($fieldName, $_);
622 return $errmsg unless $errmsg eq '';
632 my @localtime = localtime;
633 my ($sec, $min, $hour, $mday, $mon, $year) = gmtime (
634 _dateToEpoch ($datetime) - (timegm (@localtime) - timelocal (@localtime))
640 $sec = '0' . $sec if $sec < 10;
641 $min = '0' . $min if $min < 10;
642 $hour = '0' . $hour if $hour < 10;
643 $mon = '0' . $mon if $mon < 10;
644 $mday = '0' . $mday if $mday < 10;
646 return "$year-$mon-${mday}T$hour:$min:${sec}Z";
649 sub _UTC2Localtime ($) {
650 my ($utcdatetime) = @_;
652 return unless $utcdatetime;
654 # If the field does not look like a UTC time then just return it.
655 return $utcdatetime unless $utcdatetime =~ /\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2}Z/;
657 $utcdatetime =~ s/T/ /;
658 $utcdatetime =~ s/Z//;
660 my @localtime = localtime;
662 return _epochToDate (
663 _dateToEpoch ($utcdatetime) + (timegm (@localtime) - timelocal (@localtime))
668 my ($self, $table, $values, @ordering) = @_;
674 Insert a new record into the database
678 =for html <blockquote>
684 The name of the table to insert into
688 Hash reference of name/value pairs for the insertion
692 Array containing field names that need to be processed in order. Not all fields
693 mentioned in the $values hash need be mentioned here. If you have fields that
694 must be set in a particular order you can mention them here. So, if you're
695 adding the Defect record, but you need Project set before Platform, you need
696 only pass in an @ordering of qw(Project Platform). They will be done first, then
697 all of the rest of the fields in the $values hash. If you have no ordering
698 dependencies then you can simply omit @ordering.
700 Note that the best way to determine if you have an ordering dependency try using
701 a Clearquest client and note the order that you set fields in. If at anytime
702 setting one field negates another field via action hook code then you have just
703 figured out that this field needs to be set before the file that just got
708 =for html </blockquote>
712 =for html <blockquote>
718 The DBID of the newly added record or undef if error.
722 =for html </blockquote>
726 $self->{errmsg} = '';
728 unless ($self->connected) {
729 $self->_setError ('You must connect to Clearquest before you can call add');
734 my %values = %$values;
737 eval {$entity = $self->{session}->BuildEntity ($table)};
740 $self->_setError ("Unable to create new $table record:\n$@");
745 # First process all fields in @ordering, if specified
746 foreach (@ordering) {
748 $self->{errmsg} = $self->_setFieldValue ($entity, $table, $_, $values{$_});
750 $self->_setError ("$_ from the ordering array is not present in the value hash", -1);
753 last unless $self->{errmsg} eq '';
756 return unless $self->{errmsg} eq '';
758 # Now process the rest of the values
759 foreach my $fieldName (keys %values) {
760 next if grep {$fieldName eq $_} @ordering;
762 $self->{errmsg} = $self->_setFieldValue ($entity, $table, $fieldName, $values{$fieldName});
764 last unless $self->{errmsg} eq '';
767 $self->_setError ($self->{errmsg});
769 return unless $self->{errmsg} eq '';
771 $self->{errmsg} = $self->_commitRecord ($entity);
772 $self->{error} = $self->{errmsg} eq '' ? 0 : 1;
774 my $dbid = $entity->GetFieldValue ('dbid')->GetValue;
779 sub connect (;$$$$) {
780 my ($self, $username, $password, $database, $dbset) = @_;
784 =head2 connect (;$$$$)
786 Connect to the Clearquest database. You can supply parameters such as username,
787 password, etc and they will override any passed to Clearquest::new (or those
788 coming from ../etc/cq.conf)
792 =for html <blockquote>
798 Username to use to connect to the database
802 Password to use to connect to the database
806 Clearquest database to connect to
810 Database set to connect to (Default: Connect to the default dbset)
814 =for html </blockquote>
818 =for html <blockquote>
826 =for html </blockquote>
830 return unless $self->{module} eq 'api';
832 eval {require CQPerlExt};
834 croak "Unable to use Rational's CQPerlExt library - "
835 . "You must use cqperl to use the Clearquest API back end\n$@" if $@;
837 $self->{username} = $username if $username;
838 $self->{password} = $password if $password;
839 $self->{database} = $database if $database;
840 $self->{dbset} = $dbset if $dbset;
842 $self->{session} = CQSession::Build ();
844 $self->{loggedin} = 0;
847 $self->{session}->UserLogon ($self->{username},
856 $self->_setError ($@, 1);
858 $self->{loggedin} = 1;
860 $self->_setError ($_, 0);
863 return $self->{loggedin};
873 Returns 1 if we are currently connected to Clearquest
877 =for html <blockquote>
885 =for html </blockquote>
889 =for html <blockquote>
893 =item 1 if logged in - 0 if not
897 =for html </blockquote>
901 return $self->{loggedin};
905 my ($self, $fullyQualify) = @_;
911 Returns a connection string that describes the current connection
915 =for html <blockquote>
921 If true the connection string will be fully qualified
925 =for html </blockquote>
929 =for html <blockquote>
935 A string describing the current connection. Generally
936 <username>@<database>[/<dbset>]. Note that <dbset> is only displayed if it is
937 not the default DBSet as defined in cq.conf.
941 =for html </blockquote>
945 my $connectionStr = $self->username ()
947 . $self->database ();
950 $connectionStr .= '/' . $self->dbset;
952 $connectionStr .= '/' . $self->dbset () unless $self->dbset eq $DEFAULT_DBSET;
955 return $connectionStr;
959 my ($self, $msg, $die) = @_;
963 =head2 checkErr (;$$)
965 Checks for error in the last Clearquest method call and prints error to STDERR.
966 Optionally prints a user message if $msg is specified. Dies if $die is true
970 =for html <blockquote>
980 Causes caller to croak if set to true
984 =for html </blockquote>
988 =for html <blockquote>
994 Returns 0 for no error, non-zero if error.
998 =for html </blockquote>
1004 if ($self->{error}) {
1006 $msg .= "\n" . $self->errmsg . "\n";
1008 $msg = $self->errmsg . "\n";
1014 print STDERR "$msg\n";
1016 return $self->{error};
1030 Returns the current database (or the database that would be used)
1034 =for html <blockquote>
1042 =for html </blockquote>
1046 =for html <blockquote>
1054 =for html </blockquote>
1058 return $self->{database};
1068 Returns the current dbset (or the dbset that would be used)
1072 =for html <blockquote>
1080 =for html </blockquote>
1084 =for html <blockquote>
1092 =for html </blockquote>
1096 return $self->{dbset};
1106 Return the installed DBSets for this schema
1110 =for html <blockquote>
1118 =for html </blockquote>
1122 =for html <blockquote>
1132 =for html </blockquote>
1136 unless ($self->connected) {
1137 $self->_setError ('You must connect to Clearquest before you can call DBSets', '-1');
1142 return @{$self->{session}->GetInstalledDbSets};
1146 my ($self, $table, $key) = @_;
1152 Deletes records from the database
1156 =for html <blockquote>
1162 Table to delete records from
1166 Key of the record to delete
1170 =for html </blockquote>
1174 =for html <blockquote>
1180 Error message or blank if no error
1184 =for html </blockquote>
1190 eval {$entity = $self->{session}->GetEntity ($table, $key)};
1193 $self->_setError ($@, 1);
1198 eval {$self->{session}->DeleteEntity ($entity, 'Delete')};
1201 $self->_setError ($@, 1);
1212 CQSession::Unbuild ($self->{session}) if $self->{session};
1222 =head2 disconnect ()
1224 Disconnect from Clearquest
1228 =for html <blockquote>
1236 =for html </blockquote>
1240 =for html <blockquote>
1248 =for html </blockquote>
1252 CQSession::Unbuild ($self->{session});
1254 undef $self->{session};
1256 $self->{loggedin} = 0;
1262 my ($self, $errmsg) = @_;
1268 Returns the last error message. Optionally sets the error message if specified.
1272 =for html <blockquote>
1280 =for html </blockquote>
1284 =for html <blockquote>
1294 =for html </blockquote>
1298 $self->{errmsg} = $errmsg if $errmsg;
1300 return $self->{errmsg};
1304 my ($self, $error) = @_;
1308 =head2 error ($error)
1310 Returns the last error number. Optional set the error number if specified
1314 =for html <blockquote>
1324 =for html </blockquote>
1328 =for html <blockquote>
1338 =for html </blockquote>
1342 $self->{error} = $error if defined $error;
1344 return $self->{error};
1347 sub fieldType ($$) {
1348 my ($self, $table, $fieldName) = @_;
1352 =head2 fieldType ($table, $fieldname)
1354 Returns the field type for the $table, $fieldname combination.
1358 =for html <blockquote>
1364 Table to return field type from.
1368 Fieldname to return the field type from.
1372 =for html </blockquote>
1376 =for html <blockquote>
1386 =for html </blockquote>
1390 return $UNKNOWN unless $self->{loggedin};
1392 # If we've already computed the fieldTypes for the fields in this table then
1394 if ($FIELDS{$table}) {
1395 # If we already have this fieldType just return it
1396 if (defined $FIELDS{$table}{$fieldName}) {
1397 return $FIELDS{$table}{$fieldName}
1403 my $entityDef = $self->{session}->GetEntityDef ($table);
1405 foreach (@{$entityDef->GetFieldDefNames}) {
1406 $FIELDS{$table}{$_} = $entityDef->GetFieldDefType ($_);
1409 if (defined $FIELDS{$table}{$fieldName}) {
1410 return $FIELDS{$table}{$fieldName}
1416 sub fieldTypeName ($$) {
1417 my ($self, $table, $fieldName) = @_;
1421 =head2 fieldTypeName ($table, $fieldname)
1423 Returns the field type name for the $table, $fieldname combination.
1427 =for html <blockquote>
1433 Table to return field type from.
1437 Fieldname to return the field type from.
1441 =for html </blockquote>
1445 =for html <blockquote>
1449 =item $fieldTypeName
1455 =for html </blockquote>
1459 my $fieldType = $self->fieldType ($table, $fieldName);
1461 return $UNKNOWN unless $fieldType;
1463 if ($fieldType == $STRING) {
1465 } elsif ($fieldType == $MULTILINE_STRING) {
1466 return "MULTILINE_STRING";
1467 } elsif ($fieldType == $INT) {
1469 } elsif ($fieldType == $DATE_TIME) {
1471 } elsif ($fieldType == $REFERENCE) {
1473 } elsif ($fieldType == $REFERENCE_LIST) {
1474 return "REFERENCE_LIST";
1475 } elsif ($fieldType == $ATTACHMENT_LIST) {
1476 return "ATTACHMENT_LIST";
1477 } elsif ($fieldType == $ID) {
1479 } elsif ($fieldType == $STATE) {
1481 } elsif ($fieldType == $JOURNAL) {
1483 } elsif ($fieldType == $DBID) {
1485 } elsif ($fieldType == $STATETYPE) {
1487 } elsif ($fieldType == $RECORD_TYPE) {
1488 return "RECORD_TYPE";
1489 } elsif ($fieldType == $UNKNOWN) {
1495 my ($self, $table, $condition, @fields) = @_;
1501 Find records in $table. You can specify a $condition and which fields you wish
1502 to retrieve. Specifying a smaller set of fields means less data transfered and
1503 quicker retrieval so only retrieve the fields you really need.
1507 =for html <blockquote>
1513 Name of the table to search
1517 Condition to use. If you want all records then pass in undef. Only simple
1518 conditions are supported. You can specify compound conditions (e.g. field1 ==
1519 'foo' and field1 == 'bar' or field2 is not null). No parenthesizing is
1522 The following conditionals are supported
1528 =item Not Equal (!=|<>)
1532 =item Greater than (>)
1534 =item Less than or equal (<=)
1536 =item Greater than or equal (>=)
1548 Note that "is not null" is currently not working in the REST module (it works
1549 in the api and thus also in the client/server model). This because the
1550 OLSC spec V1.0 does not support it.
1552 As for "Like"", you'll need to specify "<fieldname> like '%var%'" for the
1555 "In" is only available in the REST interface as that's what OLSC supports. It's
1556 syntax would be "<fieldname> In 'value1', 'value2', 'value3'..."
1558 Also conditions can be combined with (and|or) so in the api you could do "in"
1559 as "<fieldname> = 'value1 or <fieldname> = 'value2" or <fieldname> = 'value3'".
1561 Complicated expressions with parenthesis like "(Project = 'Athena' or Project =
1562 'Hawaii') and Category = 'Aspen'" are not supported.
1566 An array of fieldnames to retrieve
1570 =for html </blockquote>
1574 =for html <blockquote>
1578 =item $result or ($result, $nbrRecs)
1580 Internal structure to be used with getNext. If in an array context then $nbrRecs
1585 =for html </blockquote>
1591 unless ($self->connected) {
1592 $self->_setError ('You must connect to Clearquest before you can call find', '-1');
1599 eval {$entityDef = $self->{session}->GetEntityDef ($table)};
1602 $self->_setError ($@, -1);
1607 @fields = $self->_setFields ($table, @fields);
1609 return unless @fields;
1611 my $query = $self->{session}->BuildQuery ($table);
1614 eval {$query->BuildField ($_)};
1617 $self->_setError ($@);
1623 $self->_parseConditional ($query, $condition);
1625 return if $self->error;
1627 my $result = $self->{session}->BuildResultSet ($query);
1628 my $nbrRecs = $result->ExecuteAndCountRecords;
1637 return (\%resultSet, $nbrRecs);
1650 Given a $str or a reference to an array of strings, this function returns a list
1651 of Clearquest IDs found in the $str. If called in a scalar context this function
1652 returns a comma separated string of IDs found. Note that duplicate IDs are
1653 eliminated. Also, the lists of IDs may refer to different Clearquest databases.
1657 =for html <blockquote>
1663 String or reference to an array of strings to search
1667 =for html </blockquote>
1671 =for html <blockquote>
1675 =item @IDs or $strIDs
1677 Either an array of CQ IDs or a comma separated list of CQ IDs.
1681 =for html </blockquote>
1685 $str = join ' ', @$str if ref $str eq 'ARRAY';
1687 my @IDs = $str =~ /([A-Za-z]\w{1,4}\d{8})/gs;
1691 map { $IDs{$_} = 1; } @IDs;
1696 return join ',', keys %IDs;
1701 my ($self, $table, $id, @fields) = @_;
1707 Return a record that you have the id or key of.
1711 =for html <blockquote>
1717 The $table to get the record from
1721 The $id or key to use to retrieve the record
1725 =for html </blockquote>
1729 =for html <blockquote>
1735 Hash of name/value pairs for all the fields in $table
1739 =for html </blockquote>
1743 unless ($self->connected) {
1744 $self->_setError ('You must connect to Clearquest before you can call get', '-1');
1749 @fields = $self->_setFields ($table, @fields);
1751 return unless @fields;
1755 eval {$entity = $self->{session}->GetEntity ($table, $id)};
1758 $self->_setError ($@);
1766 my $fieldType = $entity->GetFieldValue ($_)->GetType;
1768 if ($fieldType == $CQPerlExt::CQ_REFERENCE_LIST) {
1769 $record{$_} = $entity->GetFieldValue ($_)->GetValueAsList;
1771 $record{$_} = $entity->GetFieldValue ($_)->GetValue;
1772 $record{$_} ||= '' if $self->{emptyStringForUndef};
1775 if ($fieldType == $CQPerlExt::CQ_DATE_TIME) {
1776 $record{$_} = _UTC2Localtime ($record{$_});
1786 sub getDBID ($$;@) {
1787 my ($self, $table, $dbid, @fields) = @_;
1791 =head2 getDBID ($$;@)
1793 Return a record that you have the dbid
1797 =for html <blockquote>
1803 The $table to get the record from
1807 The $dbid to use to retrieve the record
1811 Array of field names to retrieve (Default: All fields)
1813 Note: Avoid getting all fields for large records. It will be slow and bloat your
1814 script's memory usage.
1818 =for html </blockquote>
1822 =for html <blockquote>
1828 Hash of name/value pairs for all the fields in $table
1832 =for html </blockquote>
1836 unless ($self->connected) {
1837 $self->_setError ('You must connect to Clearquest before you can call getDBID', '-1');
1842 @fields = $self->_setFields ($table, @fields);
1848 eval {$entity = $self->{session}->GetEntityByDbId ($table, $dbid)};
1851 $self->_setError ($@);
1859 my $fieldType = $entity->GetFieldValue ($_)->GetType;
1861 if ($fieldType == $CQPerlExt::CQ_REFERENCE_LIST) {
1862 $record{$_} = $entity->GetFieldValue ($_)->GetValueAsList;
1864 $record{$_} = $entity->GetFieldValue ($_)->GetValue;
1865 $record{$_} ||= '' if $self->{emptyStringForUndef};
1868 if ($fieldType == $CQPerlExt::CQ_DATE_TIME) {
1869 $record{$_} = _UTC2Localtime ($record{$_});
1879 sub getDynamicList ($) {
1880 my ($self, $list) = @_;
1884 =head2 getDynamicList ($)
1886 Return the entries of a dynamic list
1890 =for html <blockquote>
1896 The name of the dynamic list
1900 =for html </blockquote>
1904 =for html <blockquote>
1910 An array of entries from the dynamic list
1914 =for html </blockquote>
1918 return () unless $self->connected;
1920 return @{$self->{session}->GetListMembers ($list)};
1924 my ($self, $result) = @_;
1930 Return the next record that qualifies from a preceeding call to the find method.
1934 =for html <blockquote>
1940 The $result returned from find.
1944 =for html </blockquote>
1948 =for html <blockquote>
1954 Hash of name/value pairs for the @fields specified to find.
1958 =for html </blockquote>
1962 unless ($self->connected) {
1963 $self->_setError ('You must connect to Clearquest before you can call getNext', '-1');
1968 # Here we need to do special processing to gather up reference list fields, if
1969 # any. If we have a reference list field in the field list then Clearquest
1970 # returns multiple records - one for each entry in the reference list. Thus if
1971 # you were getting say the key field of a record and a reference list field like
1972 # say Projects, you might see:
1974 # Key Value Projects
1975 # --------- --------
1980 # Things get combinatoric when multiple reference list fields are involved. Our
1981 # strategy here is to keep gathering all fields that change into arrays assuming
1982 # they are reference fields as long as the dbid field has not changed.
1986 unless ($result->{lastDBID}) {
1987 # Move to the first record
1988 last unless $result->{result}->MoveNext == $CQPerlExt::CQ_SUCCESS;
1989 } elsif ($result->{lastDBID} == $result->{thisDBID}) {
1990 # If the dbid is the same then we have at least one reference list field
1991 # in the request so we need to move to the next record
1992 last unless $result->{result}->MoveNext == $CQPerlExt::CQ_SUCCESS;
1994 # If lastDBID != thisDBID then set lastDBID to thisDBID so we can process
1996 $result->{lastDBID} = $result->{thisDBID};
1998 delete $result->{lastRecord};
2001 my $nbrColumns = $result->{result}->GetNumberOfColumns;
2006 while ($column <= $nbrColumns) {
2007 my $value = $result->{result}->GetColumnValue ($column);
2009 $value ||= '' if $self->{emptyStringForUndef};
2011 # Fix any UTC dates - _UTC2Localtime will only modify data if the data
2012 # matches a UTC datetime.
2013 $value = _UTC2Localtime ($value);
2015 $record{$result->{result}->GetColumnLabel ($column++)} = $value;
2018 %{$result->{lastRecord}} = %record unless $result->{lastRecord};
2020 # Store this record's DBID
2021 $result->{thisDBID} = $record{dbid};
2023 if ($result->{lastDBID}) {
2024 if ($result->{thisDBID} == $result->{lastDBID}) {
2025 # Since the dbid's are the same, we have at least one reference list field
2026 # and we need to compare all fields
2027 foreach my $field (keys %record) {
2028 # If the field is blank then skip it
2029 next if $record{$field} eq '';
2031 # Here we check the field in %lastRecord to see if it was a reference
2032 # list with more than one entry.
2033 if (ref \$result->{lastRecord}{$field} eq 'ARRAY') {
2034 # Check to see if this entry is already in the list of current entries
2035 next if grep {/^$record{$field}$/} @{$result->{lastRecord}{$field}};
2038 # This checks to see if the current field is a scalar and we have a new
2039 # value, then the scalar needs to be changed to an array
2040 if (ref \$result->{lastRecord}{$field} eq 'SCALAR') {
2041 # If the field is the same value then no change, no array. We do next
2042 # to start processing the next field
2043 next if $result->{lastRecord}{$field} eq $record{$field};
2045 # Changed $lastRecord{$_} to a reference to an ARRAY
2046 $result->{lastRecord}{$field} = [$result->{lastRecord}{$field}, $record{$field}];
2048 # Push the value only if it does not already exists in the array
2049 push @{$result->{lastRecord}{$field}}, $record{$field}
2050 unless grep {/^$record{$field}$/} @{$result->{lastRecord}{$field}};
2054 # Transfer %lastRecord -> %record
2055 %record = %{$result->{lastRecord}};
2057 %record = %{$result->{lastRecord}};
2063 # The $lastDBID is now $thisDBID
2064 $result->{lastDBID} = $result->{thisDBID};
2066 # Update %lastRecord
2067 %{$result->{lastRecord}} = %record;
2082 This function returns the database name given an ID.
2086 =for html <blockquote>
2092 The ID to extract the database name from
2096 =for html </blockquote>
2100 =for html <blockquote>
2106 Returns the name of the database the ID is part of or undef if not found.
2110 =for html </blockquote>
2114 if ($ID =~ /([A-Za-z]\w{1,4})\d{8}/) {
2122 my ($self, $table, $dbid) = @_;
2128 Return the key of the record given a $dbid
2132 =for html <blockquote>
2138 Name of the table to lookup
2142 Database ID of the record to retrieve
2146 =for html </blockquote>
2150 =for html <blockquote>
2158 =for html </blockquote>
2162 unless ($self->connected) {
2163 $self->_setError ('You must connect to Clearquest before you can call key', '-1');
2170 eval {$entity = $self->{session}->GetEntityByDbId ($table, $dbid)};
2172 return $entity->GetDisplayName;
2175 sub modify ($$$$;@) {
2176 my ($self, $table, $key, $action, $values, @ordering) = @_;
2180 =head2 modify ($$$$;@)
2186 =for html <blockquote>
2192 The $table to get the record from
2196 The $key identifying the record to modify
2200 Action to perform the modification under. Default is 'Modify'.
2204 Hash reference containing name/value that have the new values for the fields
2208 Array containing field names that need to be processed in order. Not all fields
2209 mentioned in the $values hash need be mentioned here. If you have fields that
2210 must be set in a particular order you can mention them here. So, if you're
2211 modifying the Defect record, but you need Project set before Platform, you need
2212 only pass in an @ordering of qw(Project Platform). They will be done first, then
2213 all of the rest of the fields in the $values hash. If you have no ordering
2214 dependencies then you can simply omit @ordering.
2216 Note that the best way to determine if you have an ordering dependency try using
2217 a Clearquest client and note the order that you set fields in. If at anytime
2218 setting one field negates another field via action hook code then you have just
2219 figured out that this field needs to be set before the file that just got
2224 =for html </blockquote>
2228 =for html <blockquote>
2234 The $errmsg, if any, when performing the update (empty string for success)
2238 =for html </blockquote>
2242 unless ($self->connected) {
2243 $self->_setError ('You must connect to Clearquest before you can call modify', '-1');
2245 return $self->{errmsg};
2248 my %record = $self->get ($table, $key, qw(dbid));
2250 return $self->modifyDBID ($table, $record{dbid}, $action, $values, @ordering);
2253 sub modifyDBID ($$$$;@) {
2254 my ($self, $table, $dbid, $action, $values, @ordering) = @_;
2258 =head2 modifyDBID ($$$%)
2260 Update a unique record (by DBID)
2264 =for html <blockquote>
2270 The $table to get the record from
2274 The $dbid of the record to update. Note that the find method always includes the
2275 dbid of a record in the hash that it returns.
2279 Action to perform the modification under. Default is 'Modify'.
2283 Hash containing name/value that have the new values for the fields
2287 =for html </blockquote>
2291 =for html <blockquote>
2297 The $errmsg, if any, when performing the update (empty string for success)
2301 =for html </blockquote>
2304 $action ||= 'Modify';
2306 my %values = %$values;
2310 eval {$entity = $self->{session}->GetEntityByDbId ($table, $dbid)};
2313 $self->_setError ($@);
2318 eval {$entity->EditEntity ($action)};
2321 $self->_setError ($@);
2326 # First process all fields in @ordering, if specified
2327 foreach (@ordering) {
2329 $self->{errmsg} = $self->_setFieldValue ($table, $_, $values{$_});
2331 $self->_setError ("$_ from the ordering array is not present in the value hash", -1);
2334 last unless $self->{errmsg} eq '';
2337 return $self->{errmsg} unless $self->{errmsg} eq '';
2339 # Now process the rest of the values
2340 foreach my $fieldName (keys %values) {
2341 next if grep {$fieldName eq $_} @ordering;
2343 $self->{errmsg} = $self->_setFieldValue ($entity, $table, $fieldName, $values{$fieldName});
2345 last unless $self->{errmsg} eq '';
2348 $self->_setError ($self->{errmsg});
2350 return $self->{errmsg} unless $self->{errmsg} eq '';
2352 $self->{errmsg} = $self->_commitRecord ($entity);
2353 $self->{error} = $self->{errmsg} eq '' ? 0 : 1;
2355 return $self->{errmsg};
2365 Returns the current back end module we are using
2369 =for html <blockquote>
2377 =for html </blockquote>
2381 =for html <blockquote>
2389 =for html </blockquote>
2393 return $self->{module};
2397 my ($class, %parms) = @_;
2403 Construct a new Clearquest object.
2407 Below are the key values for the %parms hash.
2409 =for html <blockquote>
2415 Webhost for REST module
2419 Username to use to connect to the database
2423 Password to use to connect to the database
2427 Clearquest database to connect to
2431 Database set to connect to
2435 One of 'rest', 'api' or 'client' (Default: From cq.conf). This determines which
2436 backend module will be used.
2440 =for html </blockquote>
2444 =for html <blockquote>
2448 =item Clearquest object
2452 =for html </blockquote>
2456 $parms{CQ_DATABASE} ||= $OPTS{CQ_DATABASE};
2457 $parms{CQ_USERNAME} ||= $OPTS{CQ_USERNAME};
2458 $parms{CQ_PASSWORD} ||= $OPTS{CQ_PASSWORD};
2459 $parms{CQ_DBSET} ||= $OPTS{CQ_DBSET};
2462 server => $parms{CQ_SERVER},
2463 port => $parms{CQ_PORT},
2464 database => $parms{CQ_DATABASE},
2465 dbset => $parms{CQ_DBSET},
2466 username => $parms{CQ_USERNAME},
2467 password => $parms{CQ_PASSWORD},
2468 emptyStringForUndef => 0,
2469 returnSystemFields => 0,
2472 my $module = delete $parms{CQ_MODULE};
2474 $module ||= $OPTS{CQ_MODULE};
2476 $module = lc $module;
2478 if ($module eq 'rest') {
2479 require Clearquest::REST;
2481 $self->{webhost} = $parms{CQ_WEBHOST} || $OPTS{CQ_WEBHOST};
2483 $self = Clearquest::REST->new ($self);
2484 } elsif ($module eq 'client') {
2485 require Clearquest::Client;
2487 $self->{server} = $parms{CQ_SERVER} || $OPTS{CQ_SERVER};
2488 $self->{port} = $parms{CQ_PORT} || $OPTS{CQ_PORT};
2490 $self = Clearquest::Client->new ($self);
2491 } elsif ($module ne 'api') {
2492 croak "Unknown interface requested - $module";
2495 $self->{module} = $module;
2497 # Save reference to instaniated instance of this object to insure that global
2498 # variables are properly disposed of
2499 push @objects, $self;
2511 Returns the current server if applicable
2515 =for html <blockquote>
2523 =for html </blockquote>
2527 =for html <blockquote>
2533 For api this will return ''. For REST and client/server this will return the
2534 server name that we are talking to.
2538 =for html </blockquote>
2542 return $self->{server};
2546 my ($self, %opts) = @_;
2552 Set options for operating
2556 =for html <blockquote>
2564 Options to set. The only options currently supported are emptyStringForUndef
2565 and returnSystemFields. If set emptyStringForUndef will return empty strings for
2566 empty fields instead of undef. Default: Empty fields are represented with undef.
2568 System-owned fields are used internally by IBM Rational ClearQuest to maintain
2569 information about the database. You should never modify system fields directly
2570 as it could corrupt the database. If returnSystemFields is set then system
2571 fields will be returned. Default: System fields will not be returned unless
2572 explicitly stated in the @fields parameter. This means that if you do not
2573 specify any fields in @fields, all fields will be returned except system fields,
2574 unless you set returnSystemFields via this method or you explicitly mention the
2575 system field in your @fields parameter.
2577 =for html </blockquote>
2581 =for html <blockquote>
2589 =for html </blockquote>
2593 $self->{emptyStringForUndef} = $opts{emptyStringForUndef}
2594 if $opts{emptyStringForUndef};
2595 $self->{returnSystemFields} = $opts{returnSystemFields}
2596 if $opts{returnSystemFields};
2600 my ($self, $option) = @_;
2610 =for html <blockquote>
2618 Option to retrieve. If non-existant then undef is returned.
2620 =for html </blockquote>
2624 =for html <blockquote>
2628 =item $option or undef if option doesn't exist
2632 =for html </blockquote>
2636 my @validOpts = qw (emptyStringForUndef returnSystemFields);
2638 if (grep {$option eq $_} @validOpts) {
2639 return $self->{$option};
2652 Returns the current username (or the username that would be used)
2656 =for html <blockquote>
2664 =for html </blockquote>
2668 =for html <blockquote>
2676 =for html </blockquote>
2680 return $self->{username};
2686 return $self->{webhost};
2697 L<File::Basename|File::Basename>
2699 =head2 ClearSCM Perl Modules
2701 =for html <p><a href="/php/scm_man.php?file=lib/GetConfig.pm">GetConfig</a></p>
2703 =head1 BUGS AND LIMITATIONS
2705 There are no known bugs in this module
2707 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
2709 =head1 LICENSE AND COPYRIGHT
2711 Copyright (c) 2007, ClearSCM, Inc. All rights reserved.