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