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 for (@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);
571 for (@{$entityDef->GetFieldDefNames}) {
572 unless ($self->{returnSystemFields}) {
573 next if $entityDef->IsSystemOwnedFieldDefName ($_);
581 push @fields, 'dbid' unless grep {$_ eq 'dbid'} @fields;
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;
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
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 for 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;
958 sub checkErr (;$$$) {
959 my ($self, $msg, $die, $log) = @_;
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";
1012 $log->err ($msg) if $log;
1018 print STDERR "$msg\n";
1021 return $self->{error};
1035 Returns the current database (or the database that would be used)
1039 =for html <blockquote>
1047 =for html </blockquote>
1051 =for html <blockquote>
1059 =for html </blockquote>
1063 return $self->{database};
1073 Returns the current dbset (or the dbset that would be used)
1077 =for html <blockquote>
1085 =for html </blockquote>
1089 =for html <blockquote>
1097 =for html </blockquote>
1101 return $self->{dbset};
1111 Return the installed DBSets for this schema
1115 =for html <blockquote>
1123 =for html </blockquote>
1127 =for html <blockquote>
1137 =for html </blockquote>
1141 unless ($self->connected) {
1142 $self->_setError ('You must connect to Clearquest before you can call DBSets', '-1');
1147 return @{$self->{session}->GetInstalledDbSets};
1151 my ($self, $table, $key) = @_;
1157 Deletes records from the database
1161 =for html <blockquote>
1167 Table to delete records from
1171 Key of the record to delete
1175 =for html </blockquote>
1179 =for html <blockquote>
1185 Error message or blank if no error
1189 =for html </blockquote>
1195 eval {$entity = $self->{session}->GetEntity ($table, $key)};
1198 $self->_setError ($@, 1);
1203 eval {$self->{session}->DeleteEntity ($entity, 'Delete')};
1206 $self->_setError ($@, 1);
1217 CQSession::Unbuild ($self->{session}) if $self->{session};
1227 =head2 disconnect ()
1229 Disconnect from Clearquest
1233 =for html <blockquote>
1241 =for html </blockquote>
1245 =for html <blockquote>
1253 =for html </blockquote>
1257 CQSession::Unbuild ($self->{session});
1259 undef $self->{session};
1261 $self->{loggedin} = 0;
1267 my ($self, $errmsg) = @_;
1273 Returns the last error message. Optionally sets the error message if specified.
1277 =for html <blockquote>
1285 =for html </blockquote>
1289 =for html <blockquote>
1299 =for html </blockquote>
1303 $self->{errmsg} = $errmsg if $errmsg;
1305 return $self->{errmsg};
1309 my ($self, $error) = @_;
1313 =head2 error ($error)
1315 Returns the last error number. Optional set the error number if specified
1319 =for html <blockquote>
1329 =for html </blockquote>
1333 =for html <blockquote>
1343 =for html </blockquote>
1347 # Watch here as $error can very well be 0 which "if $error" would evaluate
1348 # to false leaving $self->{error} undefined
1349 $self->{error} = $error if defined $error;
1351 return $self->{error};
1354 sub fieldType ($$) {
1355 my ($self, $table, $fieldName) = @_;
1359 =head2 fieldType ($table, $fieldname)
1361 Returns the field type for the $table, $fieldname combination.
1365 =for html <blockquote>
1371 Table to return field type from.
1375 Fieldname to return the field type from.
1379 =for html </blockquote>
1383 =for html <blockquote>
1393 =for html </blockquote>
1397 return $UNKNOWN unless $self->{loggedin};
1399 # If we've already computed the fieldTypes for the fields in this table then
1401 if ($FIELDS{$table}) {
1402 # If we already have this fieldType just return it
1403 if (defined $FIELDS{$table}{$fieldName}) {
1404 return $FIELDS{$table}{$fieldName}
1410 my $entityDef = $self->{session}->GetEntityDef ($table);
1412 for (@{$entityDef->GetFieldDefNames}) {
1413 $FIELDS{$table}{$_} = $entityDef->GetFieldDefType ($_);
1416 if (defined $FIELDS{$table}{$fieldName}) {
1417 return $FIELDS{$table}{$fieldName}
1423 sub fieldTypeName ($$) {
1424 my ($self, $table, $fieldName) = @_;
1428 =head2 fieldTypeName ($table, $fieldname)
1430 Returns the field type name for the $table, $fieldname combination.
1434 =for html <blockquote>
1440 Table to return field type from.
1444 Fieldname to return the field type from.
1448 =for html </blockquote>
1452 =for html <blockquote>
1456 =item $fieldTypeName
1462 =for html </blockquote>
1466 my $fieldType = $self->fieldType ($table, $fieldName);
1468 return $UNKNOWN unless $fieldType;
1470 if ($fieldType == $STRING) {
1472 } elsif ($fieldType == $MULTILINE_STRING) {
1473 return "MULTILINE_STRING";
1474 } elsif ($fieldType == $INT) {
1476 } elsif ($fieldType == $DATE_TIME) {
1478 } elsif ($fieldType == $REFERENCE) {
1480 } elsif ($fieldType == $REFERENCE_LIST) {
1481 return "REFERENCE_LIST";
1482 } elsif ($fieldType == $ATTACHMENT_LIST) {
1483 return "ATTACHMENT_LIST";
1484 } elsif ($fieldType == $ID) {
1486 } elsif ($fieldType == $STATE) {
1488 } elsif ($fieldType == $JOURNAL) {
1490 } elsif ($fieldType == $DBID) {
1492 } elsif ($fieldType == $STATETYPE) {
1494 } elsif ($fieldType == $RECORD_TYPE) {
1495 return "RECORD_TYPE";
1496 } elsif ($fieldType == $UNKNOWN) {
1502 my ($self, $table, $condition, @fields) = @_;
1508 Find records in $table. You can specify a $condition and which fields you wish
1509 to retrieve. Specifying a smaller set of fields means less data transfered and
1510 quicker retrieval so only retrieve the fields you really need.
1514 =for html <blockquote>
1520 Name of the table to search
1524 Condition to use. If you want all records then pass in undef. Only simple
1525 conditions are supported. You can specify compound conditions (e.g. field1 ==
1526 'foo' and field1 == 'bar' or field2 is not null). No parenthesizing is
1529 The following conditionals are supported
1535 =item Not Equal (!=|<>)
1539 =item Greater than (>)
1541 =item Less than or equal (<=)
1543 =item Greater than or equal (>=)
1555 Note that "is not null" is currently not working in the REST module (it works
1556 in the api and thus also in the client/server model). This because the
1557 OLSC spec V1.0 does not support it.
1559 As for "Like"", you'll need to specify "<fieldname> like '%var%'" for the
1562 "In" is only available in the REST interface as that's what OLSC supports. It's
1563 syntax would be "<fieldname> In 'value1', 'value2', 'value3'..."
1565 Also conditions can be combined with (and|or) so in the api you could do "in"
1566 as "<fieldname> = 'value1 or <fieldname> = 'value2" or <fieldname> = 'value3'".
1568 Complicated expressions with parenthesis like "(Project = 'Athena' or Project =
1569 'Hawaii') and Category = 'Aspen'" are not supported.
1573 An array of fieldnames to retrieve
1577 =for html </blockquote>
1581 =for html <blockquote>
1585 =item $result or ($result, $nbrRecs)
1587 Internal structure to be used with getNext. If in an array context then $nbrRecs
1592 =for html </blockquote>
1598 unless ($self->connected) {
1599 $self->_setError ('You must connect to Clearquest before you can call find', '-1');
1606 eval {$entityDef = $self->{session}->GetEntityDef ($table)};
1609 $self->_setError ($@, -1);
1614 @fields = $self->_setFields ($table, @fields);
1616 return unless @fields;
1618 my $query = $self->{session}->BuildQuery ($table);
1621 eval {$query->BuildField ($_)};
1624 $self->_setError ($@);
1630 $self->_parseConditional ($query, $condition);
1632 return if $self->error;
1634 my $result = $self->{session}->BuildResultSet ($query);
1635 my $nbrRecs = $result->ExecuteAndCountRecords;
1644 return (\%resultSet, $nbrRecs);
1657 Given a $str or a reference to an array of strings, this function returns a list
1658 of Clearquest IDs found in the $str. If called in a scalar context this function
1659 returns a comma separated string of IDs found. Note that duplicate IDs are
1660 eliminated. Also, the lists of IDs may refer to different Clearquest databases.
1664 =for html <blockquote>
1670 String or reference to an array of strings to search
1674 =for html </blockquote>
1678 =for html <blockquote>
1682 =item @IDs or $strIDs
1684 Either an array of CQ IDs or a comma separated list of CQ IDs.
1688 =for html </blockquote>
1692 $str = join ' ', @$str if ref $str eq 'ARRAY';
1694 my @IDs = $str =~ /([A-Za-z]\w{1,4}\d{8})/gs;
1698 map { $IDs{$_} = 1; } @IDs;
1703 return join ',', keys %IDs;
1708 my ($self, $table, $id, @fields) = @_;
1714 Return a record that you have the id or key of.
1718 =for html <blockquote>
1724 The $table to get the record from
1728 The $id or key to use to retrieve the record
1732 =for html </blockquote>
1736 =for html <blockquote>
1742 Hash of name/value pairs for all the fields in $table
1746 =for html </blockquote>
1750 unless ($self->connected) {
1751 $self->_setError ('You must connect to Clearquest before you can call get', '-1');
1756 @fields = $self->_setFields ($table, @fields);
1758 return unless @fields;
1762 eval {$entity = $self->{session}->GetEntity ($table, $id)};
1765 $self->_setError ($@);
1773 my $fieldType = $entity->GetFieldValue ($_)->GetType;
1775 if ($fieldType == $CQPerlExt::CQ_REFERENCE_LIST) {
1776 $record{$_} = $entity->GetFieldValue ($_)->GetValueAsList;
1778 $record{$_} = $entity->GetFieldValue ($_)->GetValue;
1779 $record{$_} ||= '' if $self->{emptyStringForUndef};
1782 if ($fieldType == $CQPerlExt::CQ_DATE_TIME) {
1783 $record{$_} = _UTC2Localtime ($record{$_});
1793 sub getDBID ($$;@) {
1794 my ($self, $table, $dbid, @fields) = @_;
1798 =head2 getDBID ($$;@)
1800 Return a record that you have the dbid
1804 =for html <blockquote>
1810 The $table to get the record from
1814 The $dbid to use to retrieve the record
1818 Array of field names to retrieve (Default: All fields)
1820 Note: Avoid getting all fields for large records. It will be slow and bloat your
1821 script's memory usage.
1825 =for html </blockquote>
1829 =for html <blockquote>
1835 Hash of name/value pairs for all the fields in $table
1839 =for html </blockquote>
1843 unless ($self->connected) {
1844 $self->_setError ('You must connect to Clearquest before you can call getDBID', '-1');
1849 @fields = $self->_setFields ($table, @fields);
1853 eval {$entity = $self->{session}->GetEntityByDbId ($table, $dbid)};
1856 $self->_setError ($@);
1864 my $fieldType = $entity->GetFieldValue ($_)->GetType;
1866 if ($fieldType == $CQPerlExt::CQ_REFERENCE_LIST) {
1867 $record{$_} = $entity->GetFieldValue ($_)->GetValueAsList;
1869 $record{$_} = $entity->GetFieldValue ($_)->GetValue;
1870 $record{$_} ||= '' if $self->{emptyStringForUndef};
1873 if ($fieldType == $CQPerlExt::CQ_DATE_TIME) {
1874 $record{$_} = _UTC2Localtime ($record{$_});
1884 sub getDynamicList ($) {
1885 my ($self, $list) = @_;
1889 =head2 getDynamicList ($)
1891 Return the entries of a dynamic list
1895 =for html <blockquote>
1901 The name of the dynamic list
1905 =for html </blockquote>
1909 =for html <blockquote>
1915 An array of entries from the dynamic list
1919 =for html </blockquote>
1923 return () unless $self->connected;
1925 return @{$self->{session}->GetListMembers ($list)};
1929 my ($self, $result) = @_;
1935 Return the next record that qualifies from a preceeding call to the find method.
1939 =for html <blockquote>
1945 The $result returned from find.
1949 =for html </blockquote>
1953 =for html <blockquote>
1959 Hash of name/value pairs for the @fields specified to find.
1963 =for html </blockquote>
1967 unless ($self->connected) {
1968 $self->_setError ('You must connect to Clearquest before you can call getNext', '-1');
1973 # Here we need to do special processing to gather up reference list fields, if
1974 # any. If we have a reference list field in the field list then Clearquest
1975 # returns multiple records - one for each entry in the reference list. Thus if
1976 # you were getting say the key field of a record and a reference list field like
1977 # say Projects, you might see:
1979 # Key Value Projects
1980 # --------- --------
1985 # Things get combinatoric when multiple reference list fields are involved. Our
1986 # strategy here is to keep gathering all fields that change into arrays assuming
1987 # they are reference fields as long as the dbid field has not changed.
1991 unless ($result->{lastDBID}) {
1992 # Move to the first record
1993 last unless $result->{result}->MoveNext == $CQPerlExt::CQ_SUCCESS;
1994 } elsif ($result->{lastDBID} == $result->{thisDBID}) {
1995 # If the dbid is the same then we have at least one reference list field
1996 # in the request so we need to move to the next record
1997 last unless $result->{result}->MoveNext == $CQPerlExt::CQ_SUCCESS;
1999 # If lastDBID != thisDBID then set lastDBID to thisDBID so we can process
2001 $result->{lastDBID} = $result->{thisDBID};
2003 delete $result->{lastRecord};
2006 my $nbrColumns = $result->{result}->GetNumberOfColumns;
2011 while ($column <= $nbrColumns) {
2012 my $name = $result->{result}->GetColumnLabel($column);
2013 my $value = $result->{result}->GetColumnValue($column++);
2015 # Fix any UTC dates - _UTC2Localtime will only modify data if the data
2016 # matches a UTC datetime.
2017 $value = _UTC2Localtime ($value) if $value;
2019 $value ||= '' if $self->{emptyStringForUndef};
2021 $record{$name} = $value;
2024 %{$result->{lastRecord}} = %record unless $result->{lastRecord};
2026 # Store this record's DBID
2027 $result->{thisDBID} = $record{dbid};
2029 if ($result->{lastDBID}) {
2030 if ($result->{thisDBID} == $result->{lastDBID}) {
2031 # Since the dbid's are the same, we have at least one reference list field
2032 # and we need to compare all fields
2033 for my $field (keys %record) {
2034 # If the field is blank then skip it
2035 next if $record{$field} eq '';
2037 # Here we check the field in %lastRecord to see if it was a reference
2038 # list with more than one entry.
2039 if (ref \$result->{lastRecord}{$field} eq 'ARRAY') {
2040 # Check to see if this entry is already in the list of current entries
2041 next if grep {/^$record{$field}$/} @{$result->{lastRecord}{$field}};
2044 # This checks to see if the current field is a scalar and we have a new
2045 # value, then the scalar needs to be changed to an array
2046 if (ref \$result->{lastRecord}{$field} eq 'SCALAR') {
2047 # If the field is the same value then no change, no array. We do next
2048 # to start processing the next field
2049 next if $result->{lastRecord}{$field} eq $record{$field};
2051 # Changed $lastRecord{$_} to a reference to an ARRAY
2052 $result->{lastRecord}{$field} = [$result->{lastRecord}{$field}, $record{$field}];
2054 # Push the value only if it does not already exists in the array
2055 push @{$result->{lastRecord}{$field}}, $record{$field}
2056 unless grep {/^$record{$field}$/} @{$result->{lastRecord}{$field}};
2060 # Transfer %lastRecord -> %record
2061 %record = %{$result->{lastRecord}};
2063 %record = %{$result->{lastRecord}};
2069 # The $lastDBID is now $thisDBID
2070 $result->{lastDBID} = $result->{thisDBID};
2072 # Update %lastRecord
2073 %{$result->{lastRecord}} = %record;
2078 # Never return dbid...
2079 delete $record{dbid};
2091 This function returns the database name given an ID.
2095 =for html <blockquote>
2101 The ID to extract the database name from
2105 =for html </blockquote>
2109 =for html <blockquote>
2115 Returns the name of the database the ID is part of or undef if not found.
2119 =for html </blockquote>
2123 if ($ID =~ /([A-Za-z]\w{1,4})\d{8}/) {
2131 my ($self, $table, $dbid) = @_;
2137 Return the key of the record given a $dbid
2141 =for html <blockquote>
2147 Name of the table to lookup
2151 Database ID of the record to retrieve
2155 =for html </blockquote>
2159 =for html <blockquote>
2167 =for html </blockquote>
2171 unless ($self->connected) {
2172 $self->_setError ('You must connect to Clearquest before you can call key', '-1');
2179 eval {$entity = $self->{session}->GetEntityByDbId ($table, $dbid)};
2181 return $entity->GetDisplayName;
2184 sub modify ($$$$;@) {
2185 my ($self, $table, $key, $action, $values, @ordering) = @_;
2189 =head2 modify ($$$$;@)
2195 =for html <blockquote>
2201 The $table to get the record from
2205 The $key identifying the record to modify
2209 Action to perform the modification under. Default is 'Modify'.
2213 Hash reference containing name/value that have the new values for the fields
2217 Array containing field names that need to be processed in order. Not all fields
2218 mentioned in the $values hash need be mentioned here. If you have fields that
2219 must be set in a particular order you can mention them here. So, if you're
2220 modifying the Defect record, but you need Project set before Platform, you need
2221 only pass in an @ordering of qw(Project Platform). They will be done first, then
2222 all of the rest of the fields in the $values hash. If you have no ordering
2223 dependencies then you can simply omit @ordering.
2225 Note that the best way to determine if you have an ordering dependency try using
2226 a Clearquest client and note the order that you set fields in. If at anytime
2227 setting one field negates another field via action hook code then you have just
2228 figured out that this field needs to be set before the file that just got
2233 =for html </blockquote>
2237 =for html <blockquote>
2243 The $errmsg, if any, when performing the update (empty string for success)
2247 =for html </blockquote>
2251 unless ($self->connected) {
2252 $self->_setError ('You must connect to Clearquest before you can call modify', '-1');
2254 return $self->{errmsg};
2257 my %record = $self->get ($table, $key, qw(dbid));
2259 return $self->modifyDBID ($table, $record{dbid}, $action, $values, @ordering);
2262 sub modifyDBID ($$$$;@) {
2263 my ($self, $table, $dbid, $action, $values, @ordering) = @_;
2267 =head2 modifyDBID ($$$%)
2269 Update a unique record (by DBID)
2273 =for html <blockquote>
2279 The $table to get the record from
2283 The $dbid of the record to update. Note that the find method always includes the
2284 dbid of a record in the hash that it returns.
2288 Action to perform the modification under. Default is 'Modify'.
2292 Hash containing name/value that have the new values for the fields
2296 =for html </blockquote>
2300 =for html <blockquote>
2306 The $errmsg, if any, when performing the update (empty string for success)
2310 =for html </blockquote>
2313 $action ||= 'Modify';
2317 %values = %$values if $values;
2321 eval {$entity = $self->{session}->GetEntityByDbId ($table, $dbid)};
2324 $self->_setError ($@);
2329 eval {$entity->EditEntity ($action)};
2332 $self->_setError ($@);
2337 # First process all fields in @ordering, if specified
2340 $self->{errmsg} = $self->_setFieldValue ($table, $_, $values{$_});
2342 $self->_setError ("$_ from the ordering array is not present in the value hash", -1);
2345 last unless $self->{errmsg} eq '';
2348 return $self->{errmsg} unless $self->{errmsg} eq '';
2350 # Now process the rest of the values
2351 for my $fieldName (keys %values) {
2352 next if grep {$fieldName eq $_} @ordering;
2354 $self->{errmsg} = $self->_setFieldValue ($entity, $table, $fieldName, $values{$fieldName});
2356 last unless $self->{errmsg} eq '';
2359 $self->_setError ($self->{errmsg});
2361 return $self->{errmsg} unless $self->{errmsg} eq '';
2363 $self->{errmsg} = $self->_commitRecord ($entity);
2364 $self->{error} = $self->{errmsg} eq '' ? 0 : 1;
2366 return $self->{errmsg};
2376 Returns the current back end module we are using
2380 =for html <blockquote>
2388 =for html </blockquote>
2392 =for html <blockquote>
2400 =for html </blockquote>
2404 return $self->{module};
2408 my ($class, %parms) = @_;
2414 Construct a new Clearquest object.
2418 Below are the key values for the %parms hash.
2420 =for html <blockquote>
2426 Webhost for REST module
2430 Username to use to connect to the database
2434 Password to use to connect to the database
2438 Clearquest database to connect to
2442 Database set to connect to
2446 One of 'rest', 'api' or 'client' (Default: From cq.conf). This determines which
2447 backend module will be used.
2451 =for html </blockquote>
2455 =for html <blockquote>
2459 =item Clearquest object
2463 =for html </blockquote>
2467 $parms{CQ_DATABASE} ||= $OPTS{CQ_DATABASE};
2468 $parms{CQ_USERNAME} ||= $OPTS{CQ_USERNAME};
2469 $parms{CQ_PASSWORD} ||= $OPTS{CQ_PASSWORD};
2470 $parms{CQ_DBSET} ||= $OPTS{CQ_DBSET};
2473 server => $parms{CQ_SERVER},
2474 port => $parms{CQ_PORT},
2475 database => $parms{CQ_DATABASE},
2476 dbset => $parms{CQ_DBSET},
2477 username => $parms{CQ_USERNAME},
2478 password => $parms{CQ_PASSWORD},
2479 emptyStringForUndef => 0,
2480 returnSystemFields => 0,
2483 my $module = delete $parms{CQ_MODULE};
2485 $module ||= $OPTS{CQ_MODULE};
2487 $module = lc $module;
2489 if ($module eq 'rest') {
2490 require Clearquest::REST;
2492 $self->{webhost} = $parms{CQ_WEBHOST} || $OPTS{CQ_WEBHOST};
2494 $self = Clearquest::REST->new ($self);
2495 } elsif ($module eq 'client') {
2496 require Clearquest::Client;
2498 $self->{server} = $parms{CQ_SERVER} || $OPTS{CQ_SERVER};
2499 $self->{port} = $parms{CQ_PORT} || $OPTS{CQ_PORT};
2501 $self = Clearquest::Client->new ($self);
2502 } elsif ($module ne 'api') {
2503 croak "Unknown interface requested - $module";
2506 $self->{module} = $module;
2508 # Save reference to instaniated instance of this object to insure that global
2509 # variables are properly disposed of
2510 push @objects, $self;
2522 Returns the current server if applicable
2526 =for html <blockquote>
2534 =for html </blockquote>
2538 =for html <blockquote>
2544 For api this will return ''. For REST and client/server this will return the
2545 server name that we are talking to.
2549 =for html </blockquote>
2553 return $self->{server};
2557 my ($self, %opts) = @_;
2563 Set options for operating
2567 =for html <blockquote>
2575 Options to set. The only options currently supported are emptyStringForUndef
2576 and returnSystemFields. If set emptyStringForUndef will return empty strings for
2577 empty fields instead of undef. Default: Empty fields are represented with undef.
2579 System-owned fields are used internally by IBM Rational ClearQuest to maintain
2580 information about the database. You should never modify system fields directly
2581 as it could corrupt the database. If returnSystemFields is set then system
2582 fields will be returned. Default: System fields will not be returned unless
2583 explicitly stated in the @fields parameter. This means that if you do not
2584 specify any fields in @fields, all fields will be returned except system fields,
2585 unless you set returnSystemFields via this method or you explicitly mention the
2586 system field in your @fields parameter.
2588 =for html </blockquote>
2592 =for html <blockquote>
2600 =for html </blockquote>
2604 $self->{emptyStringForUndef} = $opts{emptyStringForUndef}
2605 if $opts{emptyStringForUndef};
2606 $self->{returnSystemFields} = $opts{returnSystemFields}
2607 if $opts{returnSystemFields};
2611 my ($self, $option) = @_;
2621 =for html <blockquote>
2629 Option to retrieve. If non-existant then undef is returned.
2631 =for html </blockquote>
2635 =for html <blockquote>
2639 =item $option or undef if option doesn't exist
2643 =for html </blockquote>
2647 my @validOpts = qw (emptyStringForUndef returnSystemFields);
2649 if (grep {$option eq $_} @validOpts) {
2650 return $self->{$option};
2663 Returns the current username (or the username that would be used)
2667 =for html <blockquote>
2675 =for html </blockquote>
2679 =for html <blockquote>
2687 =for html </blockquote>
2691 return $self->{username};
2697 return $self->{webhost};
2708 L<File::Basename|File::Basename>
2710 =head2 ClearSCM Perl Modules
2712 =for html <p><a href="/php/scm_man.php?file=lib/GetConfig.pm">GetConfig</a></p>
2714 =head1 BUGS AND LIMITATIONS
2716 There are no known bugs in this module
2718 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
2720 =head1 LICENSE AND COPYRIGHT
2722 Copyright (c) 2007, ClearSCM, Inc. All rights reserved.