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 $self->{error} = $error if defined $error;
1349 return $self->{error};
1352 sub fieldType ($$) {
1353 my ($self, $table, $fieldName) = @_;
1357 =head2 fieldType ($table, $fieldname)
1359 Returns the field type for the $table, $fieldname combination.
1363 =for html <blockquote>
1369 Table to return field type from.
1373 Fieldname to return the field type from.
1377 =for html </blockquote>
1381 =for html <blockquote>
1391 =for html </blockquote>
1395 return $UNKNOWN unless $self->{loggedin};
1397 # If we've already computed the fieldTypes for the fields in this table then
1399 if ($FIELDS{$table}) {
1400 # If we already have this fieldType just return it
1401 if (defined $FIELDS{$table}{$fieldName}) {
1402 return $FIELDS{$table}{$fieldName}
1408 my $entityDef = $self->{session}->GetEntityDef ($table);
1410 for (@{$entityDef->GetFieldDefNames}) {
1411 $FIELDS{$table}{$_} = $entityDef->GetFieldDefType ($_);
1414 if (defined $FIELDS{$table}{$fieldName}) {
1415 return $FIELDS{$table}{$fieldName}
1421 sub fieldTypeName ($$) {
1422 my ($self, $table, $fieldName) = @_;
1426 =head2 fieldTypeName ($table, $fieldname)
1428 Returns the field type name for the $table, $fieldname combination.
1432 =for html <blockquote>
1438 Table to return field type from.
1442 Fieldname to return the field type from.
1446 =for html </blockquote>
1450 =for html <blockquote>
1454 =item $fieldTypeName
1460 =for html </blockquote>
1464 my $fieldType = $self->fieldType ($table, $fieldName);
1466 return $UNKNOWN unless $fieldType;
1468 if ($fieldType == $STRING) {
1470 } elsif ($fieldType == $MULTILINE_STRING) {
1471 return "MULTILINE_STRING";
1472 } elsif ($fieldType == $INT) {
1474 } elsif ($fieldType == $DATE_TIME) {
1476 } elsif ($fieldType == $REFERENCE) {
1478 } elsif ($fieldType == $REFERENCE_LIST) {
1479 return "REFERENCE_LIST";
1480 } elsif ($fieldType == $ATTACHMENT_LIST) {
1481 return "ATTACHMENT_LIST";
1482 } elsif ($fieldType == $ID) {
1484 } elsif ($fieldType == $STATE) {
1486 } elsif ($fieldType == $JOURNAL) {
1488 } elsif ($fieldType == $DBID) {
1490 } elsif ($fieldType == $STATETYPE) {
1492 } elsif ($fieldType == $RECORD_TYPE) {
1493 return "RECORD_TYPE";
1494 } elsif ($fieldType == $UNKNOWN) {
1500 my ($self, $table, $condition, @fields) = @_;
1506 Find records in $table. You can specify a $condition and which fields you wish
1507 to retrieve. Specifying a smaller set of fields means less data transfered and
1508 quicker retrieval so only retrieve the fields you really need.
1512 =for html <blockquote>
1518 Name of the table to search
1522 Condition to use. If you want all records then pass in undef. Only simple
1523 conditions are supported. You can specify compound conditions (e.g. field1 ==
1524 'foo' and field1 == 'bar' or field2 is not null). No parenthesizing is
1527 The following conditionals are supported
1533 =item Not Equal (!=|<>)
1537 =item Greater than (>)
1539 =item Less than or equal (<=)
1541 =item Greater than or equal (>=)
1553 Note that "is not null" is currently not working in the REST module (it works
1554 in the api and thus also in the client/server model). This because the
1555 OLSC spec V1.0 does not support it.
1557 As for "Like"", you'll need to specify "<fieldname> like '%var%'" for the
1560 "In" is only available in the REST interface as that's what OLSC supports. It's
1561 syntax would be "<fieldname> In 'value1', 'value2', 'value3'..."
1563 Also conditions can be combined with (and|or) so in the api you could do "in"
1564 as "<fieldname> = 'value1 or <fieldname> = 'value2" or <fieldname> = 'value3'".
1566 Complicated expressions with parenthesis like "(Project = 'Athena' or Project =
1567 'Hawaii') and Category = 'Aspen'" are not supported.
1571 An array of fieldnames to retrieve
1575 =for html </blockquote>
1579 =for html <blockquote>
1583 =item $result or ($result, $nbrRecs)
1585 Internal structure to be used with getNext. If in an array context then $nbrRecs
1590 =for html </blockquote>
1596 unless ($self->connected) {
1597 $self->_setError ('You must connect to Clearquest before you can call find', '-1');
1604 eval {$entityDef = $self->{session}->GetEntityDef ($table)};
1607 $self->_setError ($@, -1);
1612 @fields = $self->_setFields ($table, @fields);
1614 return unless @fields;
1616 my $query = $self->{session}->BuildQuery ($table);
1619 eval {$query->BuildField ($_)};
1622 $self->_setError ($@);
1628 $self->_parseConditional ($query, $condition);
1630 return if $self->error;
1632 my $result = $self->{session}->BuildResultSet ($query);
1633 my $nbrRecs = $result->ExecuteAndCountRecords;
1642 return (\%resultSet, $nbrRecs);
1655 Given a $str or a reference to an array of strings, this function returns a list
1656 of Clearquest IDs found in the $str. If called in a scalar context this function
1657 returns a comma separated string of IDs found. Note that duplicate IDs are
1658 eliminated. Also, the lists of IDs may refer to different Clearquest databases.
1662 =for html <blockquote>
1668 String or reference to an array of strings to search
1672 =for html </blockquote>
1676 =for html <blockquote>
1680 =item @IDs or $strIDs
1682 Either an array of CQ IDs or a comma separated list of CQ IDs.
1686 =for html </blockquote>
1690 $str = join ' ', @$str if ref $str eq 'ARRAY';
1692 my @IDs = $str =~ /([A-Za-z]\w{1,4}\d{8})/gs;
1696 map { $IDs{$_} = 1; } @IDs;
1701 return join ',', keys %IDs;
1706 my ($self, $table, $id, @fields) = @_;
1712 Return a record that you have the id or key of.
1716 =for html <blockquote>
1722 The $table to get the record from
1726 The $id or key to use to retrieve the record
1730 =for html </blockquote>
1734 =for html <blockquote>
1740 Hash of name/value pairs for all the fields in $table
1744 =for html </blockquote>
1748 unless ($self->connected) {
1749 $self->_setError ('You must connect to Clearquest before you can call get', '-1');
1754 @fields = $self->_setFields ($table, @fields);
1756 return unless @fields;
1760 eval {$entity = $self->{session}->GetEntity ($table, $id)};
1763 $self->_setError ($@);
1771 my $fieldType = $entity->GetFieldValue ($_)->GetType;
1773 if ($fieldType == $CQPerlExt::CQ_REFERENCE_LIST) {
1774 $record{$_} = $entity->GetFieldValue ($_)->GetValueAsList;
1776 $record{$_} = $entity->GetFieldValue ($_)->GetValue;
1777 $record{$_} ||= '' if $self->{emptyStringForUndef};
1780 if ($fieldType == $CQPerlExt::CQ_DATE_TIME) {
1781 $record{$_} = _UTC2Localtime ($record{$_});
1791 sub getDBID ($$;@) {
1792 my ($self, $table, $dbid, @fields) = @_;
1796 =head2 getDBID ($$;@)
1798 Return a record that you have the dbid
1802 =for html <blockquote>
1808 The $table to get the record from
1812 The $dbid to use to retrieve the record
1816 Array of field names to retrieve (Default: All fields)
1818 Note: Avoid getting all fields for large records. It will be slow and bloat your
1819 script's memory usage.
1823 =for html </blockquote>
1827 =for html <blockquote>
1833 Hash of name/value pairs for all the fields in $table
1837 =for html </blockquote>
1841 unless ($self->connected) {
1842 $self->_setError ('You must connect to Clearquest before you can call getDBID', '-1');
1847 @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';
2315 my %values = %$values;
2319 eval {$entity = $self->{session}->GetEntityByDbId ($table, $dbid)};
2322 $self->_setError ($@);
2327 eval {$entity->EditEntity ($action)};
2330 $self->_setError ($@);
2335 # First process all fields in @ordering, if specified
2338 $self->{errmsg} = $self->_setFieldValue ($table, $_, $values{$_});
2340 $self->_setError ("$_ from the ordering array is not present in the value hash", -1);
2343 last unless $self->{errmsg} eq '';
2346 return $self->{errmsg} unless $self->{errmsg} eq '';
2348 # Now process the rest of the values
2349 for my $fieldName (keys %values) {
2350 next if grep {$fieldName eq $_} @ordering;
2352 $self->{errmsg} = $self->_setFieldValue ($entity, $table, $fieldName, $values{$fieldName});
2354 last unless $self->{errmsg} eq '';
2357 $self->_setError ($self->{errmsg});
2359 return $self->{errmsg} unless $self->{errmsg} eq '';
2361 $self->{errmsg} = $self->_commitRecord ($entity);
2362 $self->{error} = $self->{errmsg} eq '' ? 0 : 1;
2364 return $self->{errmsg};
2374 Returns the current back end module we are using
2378 =for html <blockquote>
2386 =for html </blockquote>
2390 =for html <blockquote>
2398 =for html </blockquote>
2402 return $self->{module};
2406 my ($class, %parms) = @_;
2412 Construct a new Clearquest object.
2416 Below are the key values for the %parms hash.
2418 =for html <blockquote>
2424 Webhost for REST module
2428 Username to use to connect to the database
2432 Password to use to connect to the database
2436 Clearquest database to connect to
2440 Database set to connect to
2444 One of 'rest', 'api' or 'client' (Default: From cq.conf). This determines which
2445 backend module will be used.
2449 =for html </blockquote>
2453 =for html <blockquote>
2457 =item Clearquest object
2461 =for html </blockquote>
2465 $parms{CQ_DATABASE} ||= $OPTS{CQ_DATABASE};
2466 $parms{CQ_USERNAME} ||= $OPTS{CQ_USERNAME};
2467 $parms{CQ_PASSWORD} ||= $OPTS{CQ_PASSWORD};
2468 $parms{CQ_DBSET} ||= $OPTS{CQ_DBSET};
2471 server => $parms{CQ_SERVER},
2472 port => $parms{CQ_PORT},
2473 database => $parms{CQ_DATABASE},
2474 dbset => $parms{CQ_DBSET},
2475 username => $parms{CQ_USERNAME},
2476 password => $parms{CQ_PASSWORD},
2477 emptyStringForUndef => 0,
2478 returnSystemFields => 0,
2481 my $module = delete $parms{CQ_MODULE};
2483 $module ||= $OPTS{CQ_MODULE};
2485 $module = lc $module;
2487 if ($module eq 'rest') {
2488 require Clearquest::REST;
2490 $self->{webhost} = $parms{CQ_WEBHOST} || $OPTS{CQ_WEBHOST};
2492 $self = Clearquest::REST->new ($self);
2493 } elsif ($module eq 'client') {
2494 require Clearquest::Client;
2496 $self->{server} = $parms{CQ_SERVER} || $OPTS{CQ_SERVER};
2497 $self->{port} = $parms{CQ_PORT} || $OPTS{CQ_PORT};
2499 $self = Clearquest::Client->new ($self);
2500 } elsif ($module ne 'api') {
2501 croak "Unknown interface requested - $module";
2504 $self->{module} = $module;
2506 # Save reference to instaniated instance of this object to insure that global
2507 # variables are properly disposed of
2508 push @objects, $self;
2520 Returns the current server if applicable
2524 =for html <blockquote>
2532 =for html </blockquote>
2536 =for html <blockquote>
2542 For api this will return ''. For REST and client/server this will return the
2543 server name that we are talking to.
2547 =for html </blockquote>
2551 return $self->{server};
2555 my ($self, %opts) = @_;
2561 Set options for operating
2565 =for html <blockquote>
2573 Options to set. The only options currently supported are emptyStringForUndef
2574 and returnSystemFields. If set emptyStringForUndef will return empty strings for
2575 empty fields instead of undef. Default: Empty fields are represented with undef.
2577 System-owned fields are used internally by IBM Rational ClearQuest to maintain
2578 information about the database. You should never modify system fields directly
2579 as it could corrupt the database. If returnSystemFields is set then system
2580 fields will be returned. Default: System fields will not be returned unless
2581 explicitly stated in the @fields parameter. This means that if you do not
2582 specify any fields in @fields, all fields will be returned except system fields,
2583 unless you set returnSystemFields via this method or you explicitly mention the
2584 system field in your @fields parameter.
2586 =for html </blockquote>
2590 =for html <blockquote>
2598 =for html </blockquote>
2602 $self->{emptyStringForUndef} = $opts{emptyStringForUndef}
2603 if $opts{emptyStringForUndef};
2604 $self->{returnSystemFields} = $opts{returnSystemFields}
2605 if $opts{returnSystemFields};
2609 my ($self, $option) = @_;
2619 =for html <blockquote>
2627 Option to retrieve. If non-existant then undef is returned.
2629 =for html </blockquote>
2633 =for html <blockquote>
2637 =item $option or undef if option doesn't exist
2641 =for html </blockquote>
2645 my @validOpts = qw (emptyStringForUndef returnSystemFields);
2647 if (grep {$option eq $_} @validOpts) {
2648 return $self->{$option};
2661 Returns the current username (or the username that would be used)
2665 =for html <blockquote>
2673 =for html </blockquote>
2677 =for html <blockquote>
2685 =for html </blockquote>
2689 return $self->{username};
2695 return $self->{webhost};
2706 L<File::Basename|File::Basename>
2708 =head2 ClearSCM Perl Modules
2710 =for html <p><a href="/php/scm_man.php?file=lib/GetConfig.pm">GetConfig</a></p>
2712 =head1 BUGS AND LIMITATIONS
2714 There are no known bugs in this module
2716 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
2718 =head1 LICENSE AND COPYRIGHT
2720 Copyright (c) 2007, ClearSCM, Inc. All rights reserved.