1 #!/usr/bin/env /opt/rational/clearquest/bin/cqperl
2 ##############################################################################
6 # Description: cqtool is an interface to Clearquest to perform some simple
7 # actions to the RANCQ database. It is used primarily by ucmwb
8 # but it also supports a command line interface.
10 # The following commands are supported:
12 # activate <wor> <project> <est_hours> <startdate> <enddate>:
14 # assign <wor> <assignee> <project> <planned_hours> <startdate>:
18 # comment <wor> <comment>
19 # Add a comment to the Notes_Entry field for the WOR
20 # complete <wor> <actual_hours>:
23 # Create a new Help Desk Ticket
26 # effort <wor> <hours>:
27 # Update the WOR's actual hours
32 # link <parent wor> <child wor>:
33 # Link a parent WOR to a child WOR
36 # set <wor> <field> <value>
37 # Set <field> to <value> for the <wor>
39 # Displays command line usage
41 # Displays version of cqtool
43 # Many of these commands simply perform actions on a wor. Two
44 # of these commands, createwor and createhd have Perl/Tk GUI
49 # Usage: cqtool\t[-usage|help] [-verbose] [-debug]
50 # [-userid <user>] [-password <password>] [<command>]
54 # -usage|help: Display usage
55 # -verbose: Turn on verbose mode
56 # -debug: Turn on debug mode
57 # -userid: User ID to log into Clearquest database as
58 # -password: Password to use
59 # <command> If specified then cqtool executes <command> and
62 # Environment: cqtool supports the following environment variables
63 # that are used mostly for tesing purposes
65 # CQ_DBSET: Clearquest DBSET to open (e.g. XTST3 for testing -
67 # CQ_USER: User name to log into the $CQ_DBSET database with
68 # CQ_PASSWORD: Password to use to log into the $CQ_DBSET with.
70 # Author: Andrew@DeFaria.com
72 # (c) Copyright 2007, General Dynamics, all rights reserved
74 ##############################################################################
81 use Term::ANSIColor qw (:constants);
83 use lib ("$FindBin::Bin", "$FindBin::Bin/../lib");
92 my $VERSION = BOLD GREEN . "1.1" . RESET;
93 my $PROMPT = BOLD YELLOW . ">>" . RESET;
94 my $UCMWB_PROMPT = ">>";
95 my $DESC = BOLD RED . "$FindBin::Script" .
98 CYAN ": Program to talk to Clearquest" .
102 my $_userid = $ENV{CQ_USER} ? $ENV{CQ_USER} : $ENV{USER};
103 my $_password = $ENV{CQ_PASSWORD};
104 my $_db_name = $ENV{CQ_DBSET} ? $ENV{CQ_DBSET} : "RANCQ";
117 activate => \&activate,
120 comment => \&comment,
121 complete => \&complete,
122 createhd => \&createHelpDesk,
123 createwor => \&createWOR,
127 link => \&linkParentWor2ChildWor,
129 resolve => \&resolve,
132 version => \&announce,
135 ##############################################################################
137 ##############################################################################
140 ##############################################################################
142 ##############################################################################
145 "usage" => sub { usage () },
146 "verbose" => sub { set_verbose () },
147 "debug" => sub { set_debug () },
148 "userid=s" => \$_userid,
149 "password=s" => \$_password,
150 "database=s" => \$_db_name,
154 exit (commandLoop(@ARGV));
157 ##############################################################################
159 ##############################################################################
161 #-----------------------------------------------------------------------------
162 # shutdown (): Ends program
163 #-----------------------------------------------------------------------------
168 #-----------------------------------------------------------------------------
169 # help (): Displays help
170 #-----------------------------------------------------------------------------
177 activate <wor> <project> <est_hours> <startdate> <enddate>:
179 assign <wor> <assignee> <project> <planned_hours> <startdate>:
183 comment <wor> <comment>
184 Add a comment to the Notes_Entry field for the WOR
185 complete <wor> <actual_hours>:
188 Create a new Help Desk Ticket
191 effort <wor> <hours>:
192 Update the WOR's actual hours
194 Exits $FindBin::Script
197 link <parent wor> <child wor>:
198 Link a parent WOR to a child WOR
201 set <wor> <field> <value>
202 Set <field> to <value> for the <wor>
204 Displays command line usage
206 Displays version of $FindBin::Script
210 #-----------------------------------------------------------------------------
211 # announce (): Announce ourselves
212 #-----------------------------------------------------------------------------
217 #-----------------------------------------------------------------------------
218 # dberror ($): Handle errors when talking to Clearquest. Note we need to reset
219 # the database connection if an error happens.
220 #-----------------------------------------------------------------------------
224 # Need to not only report the error but to reopen the
225 # database. Something gets corruppted if we don't!
230 openDB ($_userid, $_password, $_db_name);
233 #-----------------------------------------------------------------------------
234 # getEntity ($$): Get an entity from Clearquest
235 #-----------------------------------------------------------------------------
237 my ($recordname, $wor) = @_;
242 $entity = $CQTool::session->GetEntity ($recordname, $wor);
254 #-----------------------------------------------------------------------------
255 # set ($$$): Set $field to $value for $wor
256 #-----------------------------------------------------------------------------
258 my ($wor, $field, $value) = @_;
260 if (!$wor or $wor eq "") {
261 error ("WOR is required");
265 if (!$field or $field eq "") {
266 error ("Field is required");
270 my $entity = getEntity ("WOR", $wor);
272 return 1 if !$entity;
274 $session->EditEntity ($entity, "modify");
276 $_log->msg ("Modifying $field to \"$value\"") if get_debug;
278 $entity->SetFieldValue ($field, $value);
282 dberror ("$field set failed for WOR $wor:\n$@");
286 my $status = $entity->Validate ();
290 error ("$field validate failed for WOR $wor:\n$status");
294 $status = $entity->Commit ();
297 error ("$field update failed during Submit for $wor:\n$status");
304 #-----------------------------------------------------------------------------
305 # clone ($): Clone a WOR
306 #-----------------------------------------------------------------------------
311 error ("WOR not specified!");
315 $entity = getEntity ("WOR", $wor);
317 return 1 if !$entity;
320 my $state = $entity->GetFieldValue ("state")->GetValue ();
322 if ($state ne "Closed") {
323 error ("WOR $wor not closed - Unable to clone!");
327 verbose ("Cloning WOR $wor...");
332 # Currently Clone doesn't return a proper result but eventually...
333 $result = $CQTool::session->FireRecordScriptAlias ($entity, "Clone");
345 #-----------------------------------------------------------------------------
346 # effort ($$): Update actual hours for a WOR
347 #-----------------------------------------------------------------------------
349 my ($wor, $actualHrs) = @_;
351 return set $wor, "ActualEffort", $actualHrs;
354 #-----------------------------------------------------------------------------
355 # comment (): Update the Notes_Entry comment field for a WOR
356 #-----------------------------------------------------------------------------
361 error "WOR not defined in call to comment!";
366 display ("Enter comments below. When finished, enter \".\" on a line by itself or hit ^D:");
368 # We still need to prompt for the comments however signal UCMWB
369 # that command is ready for more input.
370 display_nolf ($UCMWB_PROMPT);
382 $_log->msg ("Comments:\n$comments") if get_debug;
384 return set $wor, "Note_Entry", $comments;
387 #-----------------------------------------------------------------------------
388 # linkParentWor2ChildWor ($$): Link a child WOR to a parent WOR
389 #-----------------------------------------------------------------------------
390 sub linkParentWor2ChildWor ($$) {
391 my ($parentWor, $childWor) = @_;
395 verbose ("Linking $parentWor -> $childWor...");
397 my $childentity = getEntity ("WOR", $childWor);
398 my $parententity = getEntity ("WOR", $parentWor);
400 return 1 unless $childentity and $parententity;
402 $session->EditEntity ($parententity, "modify");
404 $parententity->AddFieldValue ("wor_children", $childWor);
406 $status = $parententity->Validate ();
409 $parententity->Revert ();
410 error ("Validation failed while attempting to add child WOR $childWor to parent WOR $parentWor:\n$status");
415 $status = $parententity->Commit ();
421 (error "Commit failed while trying to add child WOR $childWor to parent WOR $parentWor:\n$status");
425 debug "Modifying child $childWor...";
426 $session->EditEntity ($childentity, "modify");
428 $childentity->SetFieldValue ("wor_parent", $parentWor);
430 $status = $childentity->Validate ();
433 $childentity->Revert ();
434 error "Validation failed while attempting to add parent WOR $parentWor to child WOR $childWor:\n$status";
439 $status = $childentity->Commit ();
445 error "Commit failed while trying to add parent WOR $parentWor to child WOR $childWor:\n$status";
450 } # linkParentWor2ChildWor
452 #-----------------------------------------------------------------------------
453 # assign ($$$$): Assign a WOR
454 #-----------------------------------------------------------------------------
456 my ($wor, $assignee, $project, $plannedHrs, $startDate) = @_;
458 if (!$wor or $wor eq "") {
459 error ("WOR is required");
463 if (!$assignee or $assignee eq "") {
464 error ("Assignee must be specified");
468 if (!$project or $project eq "") {
469 error ("UCM Project is required");
473 if (!$startDate or $startDate eq "") {
474 error ("Planned Start Date is required");
478 my $entity = getEntity ("WOR", $wor);
480 return 1 if !$entity;
482 my $state = $entity->GetFieldValue ("state")->GetValue ();
484 if ($state ne "Submitted") {
485 error ("WOR $wor is not in Submitted state!\nState: $state");
489 $session->EditEntity ($entity, "assign");
491 $entity->SetFieldValue ("ucm_project", $project) if $project ne "";
492 $entity->SetFieldValue ("PlannedStart", $startDate) if $startDate ne "";
493 $entity->SetFieldValue ("PlannedEffort", $plannedHrs) if $plannedHrs ne "";
494 $entity->SetFieldValue ("Owner", $assignee) if $assignee ne "";
496 my $status = $entity->Validate ();
500 error ("Assign failed for WOR $wor:\n$status");
504 $status = $entity->Commit ();
507 error ("Assign failed during Submit for WOR $wor:\n$status");
514 #-----------------------------------------------------------------------------
515 # activate (): Activate a WOR
516 #-----------------------------------------------------------------------------
517 sub activate ($$$$$) {
518 my ($wor, $project, $estHrs, $startDate, $endDate) = @_;
520 if (!$wor or $wor eq "") {
521 error ("WOR is required");
525 if (!$project or $project eq "") {
526 error ("UCM Project is required");
530 if (!$startDate or $startDate eq "") {
531 error ("Planned Start Date is required");
535 if (!$endDate or $endDate eq "") {
536 error ("Planned End Date is required");
540 my $entity = getEntity ("WOR", $wor);
542 return 1 if !$entity;
544 my $state = $entity->GetFieldValue ("state")->GetValue ();
546 if ($state ne "Assessing") {
547 error ("WOR $wor is not in Assessing state!\nstate: $state");
551 $session->EditEntity ($entity, "activate");
553 $entity->SetFieldValue ("ucm_project", $project) if $project ne "";
554 $entity->SetFieldValue ("EstimatedEffort", $estHrs) if $estHrs ne "";
555 $entity->SetFieldValue ("PlannedStart", $startDate) if $startDate ne "";
556 $entity->SetFieldValue ("PlannedEnd", $endDate) if $endDate ne "";
558 my $status = $entity->Validate ();
562 error ("Activate failed for WOR $wor:\n$status");
566 $status = $entity->Commit ();
569 error ("Activate failed during Submit for WOR $wor:\n$status");
576 #-----------------------------------------------------------------------------
577 # resolve ($): Resolve a WOR
578 #-----------------------------------------------------------------------------
582 if (!$wor or $wor eq "") {
583 error ("WOR is required");
587 my $entity = getEntity ("WOR", $wor);
589 return 1 if !$entity;
591 my $state = $entity->GetFieldValue ("state")->GetValue ();
593 if ($state ne "Working") {
594 error ("WOR $wor is not in Working state!\nState: $state");
598 $session->EditEntity ($entity, "resolve");
600 my $status = $entity->Validate ();
604 error ("Resolve failed for WOR $wor:\n$status");
608 $status = $entity->Commit ();
611 error ("Resolve failed during Submit for WOR $wor:\n$status");
618 #-----------------------------------------------------------------------------
619 # complete ($$): Complete a WOR
620 #-----------------------------------------------------------------------------
622 my ($wor, $actualHrs) = @_;
624 if (!$wor or $wor eq "") {
625 error ("WOR is required");
629 if (!$wor or $wor eq "") {
630 error ("Actual Hours are required");
634 my $entity = getEntity ("WOR", $wor);
636 return 1 if !$entity;
638 my $state = $entity->GetFieldValue ("state")->GetValue ();
640 if ($state ne "Verifying") {
641 error ("WOR $wor is not in Verifying state!\nState:$state");
645 $session->EditEntity ($entity, "complete");
646 $entity->SetFieldValue ("ActualEffort", $actualHrs) if $actualHrs ne "";
648 my $status = $entity->Validate ();
652 error ("Complete failed for WOR $wor:\n$status");
656 $status = $entity->Commit ();
659 error ("Complete failed during Submit for WOR $wor:\n$status");
666 #-----------------------------------------------------------------------------
667 # executeCommand (@): Executes a cqtool command
668 #-----------------------------------------------------------------------------
669 sub executeCommand (@) {
672 my $cmd = lc shift @args;
674 return if $cmd eq "";
676 if ($_commands{$cmd}) {
677 if (!$CQTool::session) {
678 if ( # Commands that do not require a database connection
683 $cmd eq "verbose")) {
684 verbose "Opening $_db_name as $_userid...";
687 display_nolf ("${_userid}'s password:");
689 $_password = <STDIN>;
695 openDB ($_userid, $_password, $_db_name);
699 # Treat args: Args that are enclosed in quotes must be
700 # combined. For simplicity's sake we will only support matched
701 # pairs of double quotes. Anything else results in undefined
706 # Quoted argument starting
714 $_log->msg ("$cmd (" . join (",", @new_args) . ")") if get_debug;
716 return $_commands{$cmd} (@new_args);
718 error ("Unknown command \"$cmd\" (try help)");
723 #-----------------------------------------------------------------------------
724 # commandLoop (@): This is the interactive command loop
725 #-----------------------------------------------------------------------------
726 sub commandLoop (@) {
729 # For single, command line, commands...
730 return executeCommand (@args) if @args;
732 announce if !$_ucmwb;
736 display_nolf ($PROMPT . RESET . UNDERLINE);
738 display_nolf ($UCMWB_PROMPT);
741 # Read command into $_
745 # If we are not being called by ucmwb, display RESET to stop the
746 # UNDERLINE we were using. This keeps the output from being
747 # underlined. In ucmwb mode we are not using any of the terminal
749 display_nolf (RESET) if !$_ucmwb;
751 # If the user hit Control-d then a ^D is displayed but we remain
752 # on the same line. So output a carriage return and exit 0.
758 # Special handling for set command since we want to take
759 # everything after <field> to be a value, and we may get long
760 # values that are space separated and space significant
761 # (e.g. description?)
762 if (/^\s*(\w+)\s+(\w+)\s+(\w+)\s+(.*)/) {
763 if (lc $1 eq "set") {
769 # Change "\n"'s back to \n's
770 $value =~ s/\\n/\n/g;
772 executeCommand ($cmd, $wor, $field, "\"$value\"");
774 executeCommand (split);
777 executeCommand (split);