-#!/usr/bin/env /opt/rational/clearquest/bin/cqperl\r
-##############################################################################\r
-#\r
-# Name: cqtool\r
-#\r
-# Description: cqtool is an interface to Clearquest to perform some simple\r
-# actions to the RANCQ database. It is used primarily by ucmwb\r
-# but it also supports a command line interface.\r
-#\r
-# The following commands are supported:\r
-#\r
-# activate <wor> <project> <est_hours> <startdate> <enddate>:\r
-# Activate WOR\r
-# assign <wor> <assignee> <project> <planned_hours> <startdate>:\r
-# Assign the WOR\r
-# clone <wor>:\r
-# Clones a WOR\r
-# comment <wor> <comment>\r
-# Add a comment to the Notes_Entry field for the WOR\r
-# complete <wor> <actual_hours>:\r
-# Complete WOR\r
-# createhd:\r
-# Create a new Help Desk Ticket\r
-# createwor:\r
-# Create a new WOR\r
-# effort <wor> <hours>:\r
-# Update the WOR's actual hours\r
-# exit|quit:\r
-# Exits cqtool\r
-# help:\r
-# This display\r
-# link <parent wor> <child wor>:\r
-# Link a parent WOR to a child WOR\r
-# resolve <wor>:\r
-# Resolve WOR\r
-# set <wor> <field> <value>\r
-# Set <field> to <value> for the <wor>\r
-# usage:\r
-# Displays command line usage\r
-# version:\r
-# Displays version of cqtool\r
-#\r
-# Many of these commands simply perform actions on a wor. Two\r
-# of these commands, createwor and createhd have Perl/Tk GUI\r
-# interfaces.\r
-#\r
-# Command line usage:\r
-#\r
-# Usage: cqtool\t[-usage|help] [-verbose] [-debug]\r
-# [-userid <user>] [-password <password>] [<command>]\r
-#\r
-# Where:\r
-#\r
-# -usage|help: Display usage\r
-# -verbose: Turn on verbose mode\r
-# -debug: Turn on debug mode\r
-# -userid: User ID to log into Clearquest database as\r
-# -password: Password to use\r
-# <command> If specified then cqtool executes <command> and\r
-# exits\r
-#\r
-# Environment: cqtool supports the following environment variables\r
-# that are used mostly for tesing purposes\r
-#\r
-# CQ_DBSET: Clearquest DBSET to open (e.g. XTST3 for testing -\r
-# default RANCQ) \r
-# CQ_USER: User name to log into the $CQ_DBSET database with\r
-# CQ_PASSWORD: Password to use to log into the $CQ_DBSET with.\r
-#\r
-# Author: Andrew@DeFaria.com\r
-#\r
-# (c) Copyright 2007, General Dynamics, all rights reserved\r
-#\r
-##############################################################################\r
-use strict;\r
-use warnings;\r
-\r
-use CQPerlExt;\r
-use FindBin;\r
-use Getopt::Long;\r
-use Term::ANSIColor qw (:constants);\r
-\r
-use lib ("$FindBin::Bin", "$FindBin::Bin/../lib");\r
-\r
-use SCCM::Misc;\r
-use Display;\r
-use CQTool;\r
-use CreateWORUI;\r
-use CreateHelpDeskUI;\r
-use Logger;\r
-\r
-my $VERSION = BOLD GREEN . "1.1" . RESET;\r
-my $PROMPT = BOLD YELLOW . ">>" . RESET;\r
-my $UCMWB_PROMPT = ">>";\r
-my $DESC = BOLD RED . "$FindBin::Script" .\r
- RESET " Version " .\r
- $VERSION .\r
- CYAN ": Program to talk to Clearquest" .\r
- RESET;\r
-\r
-# Globals\r
-my $_userid = $ENV{CQ_USER} ? $ENV{CQ_USER} : $ENV{USER};\r
-my $_password = $ENV{CQ_PASSWORD};\r
-my $_db_name = $ENV{CQ_DBSET} ? $ENV{CQ_DBSET} : "RANCQ";\r
-my $_ucmwb;\r
-\r
-my $_log;\r
-\r
-if (get_debug) {\r
- $_log = new Logger (\r
- path => "/tmp",\r
- append => 1,\r
- );\r
-} # if\r
-\r
-my %_commands = (\r
- activate => \&activate,\r
- assign => \&assign,\r
- clone => \&clone,\r
- comment => \&comment,\r
- complete => \&complete,\r
- createhd => \&createHelpDesk,\r
- createwor => \&createWOR,\r
- effort => \&effort,\r
- exit => \&shutdown,\r
- help => \&help,\r
- link => \&linkParentWor2ChildWor,\r
- quit => \&shutdown,\r
- resolve => \&resolve,\r
- set => \&set,\r
- usage => \&usage,\r
- version => \&announce,\r
-);\r
-\r
-##############################################################################\r
-# Forwards\r
-##############################################################################\r
-sub commandLoop (@);\r
-\r
-##############################################################################\r
-# Main\r
-##############################################################################\r
-MAIN: {\r
- GetOptions (\r
- "usage" => sub { usage () },\r
- "verbose" => sub { set_verbose () },\r
- "debug" => sub { set_debug () },\r
- "userid=s" => \$_userid,\r
- "password=s" => \$_password,\r
- "database=s" => \$_db_name,\r
- "ucmwb" => \$_ucmwb,\r
- ) || usage ();\r
-\r
- exit (commandLoop(@ARGV));\r
-} # MAIN\r
-\r
-##############################################################################\r
-# Subroutines\r
-##############################################################################\r
-\r
-#-----------------------------------------------------------------------------\r
-# shutdown (): Ends program\r
-#-----------------------------------------------------------------------------\r
-sub shutdown () {\r
- exit (0);\r
-} # exit\r
-\r
-#-----------------------------------------------------------------------------\r
-# help (): Displays help\r
-#-----------------------------------------------------------------------------\r
-sub help () {\r
- display ($DESC);\r
- display <<END;\r
-\r
-Valid commands are:\r
-\r
-activate <wor> <project> <est_hours> <startdate> <enddate>:\r
- Activate WOR\r
-assign <wor> <assignee> <project> <planned_hours> <startdate>:\r
- Assign the WOR\r
-clone <wor>:\r
- Clones a WOR\r
-comment <wor> <comment>\r
- Add a comment to the Notes_Entry field for the WOR\r
-complete <wor> <actual_hours>:\r
- Complete WOR\r
-createhd:\r
- Create a new Help Desk Ticket\r
-createwor:\r
- Create a new WOR\r
-effort <wor> <hours>:\r
- Update the WOR's actual hours\r
-exit|quit:\r
- Exits $FindBin::Script\r
-help:\r
- This display\r
-link <parent wor> <child wor>:\r
- Link a parent WOR to a child WOR\r
-resolve <wor>:\r
- Resolve WOR\r
-set <wor> <field> <value>\r
- Set <field> to <value> for the <wor>\r
-usage:\r
- Displays command line usage\r
-version:\r
- Displays version of $FindBin::Script\r
-END\r
-} # help\r
-\r
-#-----------------------------------------------------------------------------\r
-# announce (): Announce ourselves\r
-#-----------------------------------------------------------------------------\r
-sub announce () {\r
- display ($DESC);\r
-} # Announce\r
-\r
-#-----------------------------------------------------------------------------\r
-# dberror ($): Handle errors when talking to Clearquest. Note we need to reset\r
-# the database connection if an error happens.\r
-#-----------------------------------------------------------------------------\r
-sub dberror ($) {\r
- my ($msg) = @_;\r
-\r
- # Need to not only report the error but to reopen the\r
- # database. Something gets corruppted if we don't!\r
- error ($msg);\r
-\r
- closeDB ();\r
-\r
- openDB ($_userid, $_password, $_db_name);\r
-} # DBError\r
-\r
-#-----------------------------------------------------------------------------\r
-# getEntity ($$): Get an entity from Clearquest\r
-#-----------------------------------------------------------------------------\r
-sub getEntity ($$) {\r
- my ($recordname, $wor) = @_;\r
-\r
- my $entity;\r
-\r
- eval {\r
- $entity = $CQTool::session->GetEntity ($recordname, $wor);\r
- };\r
-\r
- if ($@) {\r
- chomp $@;\r
- dberror ($@);\r
- return undef;\r
- } else {\r
- return $entity;\r
- } # if\r
-} # getEntity\r
-\r
-#-----------------------------------------------------------------------------\r
-# set ($$$): Set $field to $value for $wor\r
-#-----------------------------------------------------------------------------\r
-sub set ($$@) {\r
- my ($wor, $field, $value) = @_;\r
-\r
- if (!$wor or $wor eq "") {\r
- error ("WOR is required");\r
- return 1;\r
- } # if\r
-\r
- if (!$field or $field eq "") {\r
- error ("Field is required");\r
- return 1;\r
- } # if\r
-\r
- my $entity = getEntity ("WOR", $wor);\r
-\r
- return 1 if !$entity;\r
-\r
- $session->EditEntity ($entity, "modify");\r
-\r
- $_log->msg ("Modifying $field to \"$value\"") if get_debug;\r
- eval {\r
- $entity->SetFieldValue ($field, $value);\r
- };\r
-\r
- if ($@) {\r
- dberror ("$field set failed for WOR $wor:\n$@");\r
- return 2;\r
- } # if\r
-\r
- my $status = $entity->Validate ();\r
-\r
- if ($status ne "") {\r
- $entity->Revert ();\r
- error ("$field validate failed for WOR $wor:\n$status");\r
- return 2;\r
- } # if\r
-\r
- $status = $entity->Commit ();\r
-\r
- if ($status ne "") {\r
- error ("$field update failed during Submit for $wor:\n$status");\r
- return 2;\r
- } # if\r
-\r
- return 0;\r
-} # set\r
-\r
-#-----------------------------------------------------------------------------\r
-# clone ($): Clone a WOR\r
-#-----------------------------------------------------------------------------\r
-sub clone ($) {\r
- my ($wor) = @_;\r
-\r
- if (!$wor) {\r
- error ("WOR not specified!");\r
- return 1;\r
- } # if\r
-\r
- $entity = getEntity ("WOR", $wor);\r
-\r
- return 1 if !$entity;\r
-\r
- # Check state\r
- my $state = $entity->GetFieldValue ("state")->GetValue ();\r
-\r
- if ($state ne "Closed") {\r
- error ("WOR $wor not closed - Unable to clone!");\r
- return 1;\r
- } # if\r
-\r
- verbose ("Cloning WOR $wor...");\r
-\r
- my $result = 0;\r
-\r
- eval {\r
- # Currently Clone doesn't return a proper result but eventually...\r
- $result = $CQTool::session->FireRecordScriptAlias ($entity, "Clone");\r
- };\r
-\r
- if ($@) {\r
- chomp $@;\r
- dberror ($@);\r
- return 1;\r
- } # if\r
-\r
- return $result;\r
-} # clone\r
-\r
-#-----------------------------------------------------------------------------\r
-# effort ($$): Update actual hours for a WOR\r
-#-----------------------------------------------------------------------------\r
-sub effort ($$) {\r
- my ($wor, $actualHrs) = @_;\r
-\r
- return set $wor, "ActualEffort", $actualHrs;\r
-} # effort\r
-\r
-#-----------------------------------------------------------------------------\r
-# comment (): Update the Notes_Entry comment field for a WOR\r
-#-----------------------------------------------------------------------------\r
-sub comment ($) {\r
- my ($wor) = @_;\r
-\r
- if (!$wor) {\r
- error "WOR not defined in call to comment!";\r
- return 1;\r
- } # if\r
-\r
- if (!$_ucmwb) {\r
- display ("Enter comments below. When finished, enter \".\" on a line by itself or hit ^D:");\r
- } else {\r
- # We still need to prompt for the comments however signal UCMWB\r
- # that command is ready for more input.\r
- display_nolf ($UCMWB_PROMPT);\r
- } # if\r
-\r
- my $comments;\r
-\r
- while (<STDIN>) {\r
- last if $_ eq ".\n";\r
- $comments .= $_;\r
- } # while\r
-\r
- chomp $comments;\r
-\r
- $_log->msg ("Comments:\n$comments") if get_debug;\r
-\r
- return set $wor, "Note_Entry", $comments;\r
-} # Comment\r
-\r
-#-----------------------------------------------------------------------------\r
-# linkParentWor2ChildWor ($$): Link a child WOR to a parent WOR\r
-#-----------------------------------------------------------------------------\r
-sub linkParentWor2ChildWor ($$) {\r
- my ($parentWor, $childWor) = @_;\r
-\r
- my $status;\r
-\r
- verbose ("Linking $parentWor -> $childWor...");\r
-\r
- my $childentity = getEntity ("WOR", $childWor);\r
- my $parententity = getEntity ("WOR", $parentWor);\r
-\r
- return 1 unless $childentity and $parententity;\r
-\r
- $session->EditEntity ($parententity, "modify");\r
-\r
- $parententity->AddFieldValue ("wor_children", $childWor);\r
-\r
- $status = $parententity->Validate ();\r
-\r
- if ($status ne "") {\r
- $parententity->Revert ();\r
- error ("Validation failed while attempting to add child WOR $childWor to parent WOR $parentWor:\n$status");\r
- return 1;\r
- } # if\r
-\r
- eval {\r
- $status = $parententity->Commit ();\r
- };\r
-\r
- $status = $@ if $@;\r
-\r
- if ($status ne "") {\r
- (error "Commit failed while trying to add child WOR $childWor to parent WOR $parentWor:\n$status");\r
- return 2;\r
- } # if\r
-\r
- debug "Modifying child $childWor...";\r
- $session->EditEntity ($childentity, "modify");\r
-\r
- $childentity->SetFieldValue ("wor_parent", $parentWor);\r
-\r
- $status = $childentity->Validate ();\r
-\r
- if ($status ne "") {\r
- $childentity->Revert ();\r
- error "Validation failed while attempting to add parent WOR $parentWor to child WOR $childWor:\n$status";\r
- return 1;\r
- } # if\r
-\r
- eval {\r
- $status = $childentity->Commit ();\r
- };\r
-\r
- $status = $@ if $@;\r
-\r
- if ($status ne "") {\r
- error "Commit failed while trying to add parent WOR $parentWor to child WOR $childWor:\n$status";\r
- return 2;\r
- } # if\r
-\r
- return 0;\r
-} # linkParentWor2ChildWor\r
-\r
-#-----------------------------------------------------------------------------\r
-# assign ($$$$): Assign a WOR\r
-#-----------------------------------------------------------------------------\r
-sub assign ($$$$$) {\r
- my ($wor, $assignee, $project, $plannedHrs, $startDate) = @_;\r
-\r
- if (!$wor or $wor eq "") {\r
- error ("WOR is required");\r
- return 1;\r
- } # if\r
-\r
- if (!$assignee or $assignee eq "") {\r
- error ("Assignee must be specified");\r
- return 1;\r
- } # if\r
-\r
- if (!$project or $project eq "") {\r
- error ("UCM Project is required");\r
- return 1;\r
- } # if\r
-\r
- if (!$startDate or $startDate eq "") {\r
- error ("Planned Start Date is required");\r
- return 1;\r
- } # if\r
-\r
- my $entity = getEntity ("WOR", $wor);\r
-\r
- return 1 if !$entity;\r
-\r
- my $state = $entity->GetFieldValue ("state")->GetValue ();\r
-\r
- if ($state ne "Submitted") {\r
- error ("WOR $wor is not in Submitted state!\nState: $state");\r
- return 2;\r
- } # if\r
-\r
- $session->EditEntity ($entity, "assign");\r
-\r
- $entity->SetFieldValue ("ucm_project", $project) if $project ne "";\r
- $entity->SetFieldValue ("PlannedStart", $startDate) if $startDate ne "";\r
- $entity->SetFieldValue ("PlannedEffort", $plannedHrs) if $plannedHrs ne "";\r
- $entity->SetFieldValue ("Owner", $assignee) if $assignee ne "";\r
-\r
- my $status = $entity->Validate ();\r
-\r
- if ($status ne "") {\r
- $entity->Revert ();\r
- error ("Assign failed for WOR $wor:\n$status");\r
- return 2;\r
- } # if\r
-\r
- $status = $entity->Commit ();\r
-\r
- if ($status ne "") {\r
- error ("Assign failed during Submit for WOR $wor:\n$status");\r
- return 2;\r
- } # if\r
-\r
- return 0;\r
-} # assign\r
-\r
-#-----------------------------------------------------------------------------\r
-# activate (): Activate a WOR\r
-#-----------------------------------------------------------------------------\r
-sub activate ($$$$$) {\r
- my ($wor, $project, $estHrs, $startDate, $endDate) = @_;\r
-\r
- if (!$wor or $wor eq "") {\r
- error ("WOR is required");\r
- return 1;\r
- } # if\r
-\r
- if (!$project or $project eq "") {\r
- error ("UCM Project is required");\r
- return 1;\r
- } # if\r
-\r
- if (!$startDate or $startDate eq "") {\r
- error ("Planned Start Date is required");\r
- return 1;\r
- } # if\r
-\r
- if (!$endDate or $endDate eq "") {\r
- error ("Planned End Date is required");\r
- return 1;\r
- } # if\r
-\r
- my $entity = getEntity ("WOR", $wor);\r
-\r
- return 1 if !$entity;\r
-\r
- my $state = $entity->GetFieldValue ("state")->GetValue ();\r
-\r
- if ($state ne "Assessing") {\r
- error ("WOR $wor is not in Assessing state!\nstate: $state");\r
- return 2;\r
- } # if\r
-\r
- $session->EditEntity ($entity, "activate");\r
-\r
- $entity->SetFieldValue ("ucm_project", $project) if $project ne "";\r
- $entity->SetFieldValue ("EstimatedEffort", $estHrs) if $estHrs ne "";\r
- $entity->SetFieldValue ("PlannedStart", $startDate) if $startDate ne "";\r
- $entity->SetFieldValue ("PlannedEnd", $endDate) if $endDate ne "";\r
-\r
- my $status = $entity->Validate ();\r
-\r
- if ($status ne "") {\r
- $entity->Revert ();\r
- error ("Activate failed for WOR $wor:\n$status");\r
- return 2;\r
- } # if\r
-\r
- $status = $entity->Commit ();\r
-\r
- if ($status ne "") {\r
- error ("Activate failed during Submit for WOR $wor:\n$status");\r
- return 2;\r
- } # if\r
-\r
- return 0;\r
-} # activate\r
-\r
-#-----------------------------------------------------------------------------\r
-# resolve ($): Resolve a WOR\r
-#-----------------------------------------------------------------------------\r
-sub resolve ($) {\r
- my ($wor) = @_;\r
-\r
- if (!$wor or $wor eq "") {\r
- error ("WOR is required");\r
- return 1;\r
- } # if\r
-\r
- my $entity = getEntity ("WOR", $wor);\r
-\r
- return 1 if !$entity;\r
-\r
- my $state = $entity->GetFieldValue ("state")->GetValue ();\r
-\r
- if ($state ne "Working") {\r
- error ("WOR $wor is not in Working state!\nState: $state");\r
- return 2;\r
- } # if\r
-\r
- $session->EditEntity ($entity, "resolve");\r
-\r
- my $status = $entity->Validate ();\r
-\r
- if ($status ne "") {\r
- $entity->Revert ();\r
- error ("Resolve failed for WOR $wor:\n$status");\r
- return 2;\r
- } # if\r
-\r
- $status = $entity->Commit ();\r
-\r
- if ($status ne "") {\r
- error ("Resolve failed during Submit for WOR $wor:\n$status");\r
- return 2;\r
- } # if\r
-\r
- return 0;\r
-} # resolve\r
-\r
-#-----------------------------------------------------------------------------\r
-# complete ($$): Complete a WOR\r
-#-----------------------------------------------------------------------------\r
-sub complete ($$) {\r
- my ($wor, $actualHrs) = @_;\r
-\r
- if (!$wor or $wor eq "") {\r
- error ("WOR is required");\r
- return 1;\r
- } # if\r
-\r
- if (!$wor or $wor eq "") {\r
- error ("Actual Hours are required");\r
- return 1;\r
- } # if\r
-\r
- my $entity = getEntity ("WOR", $wor);\r
-\r
- return 1 if !$entity;\r
-\r
- my $state = $entity->GetFieldValue ("state")->GetValue ();\r
-\r
- if ($state ne "Verifying") {\r
- error ("WOR $wor is not in Verifying state!\nState:$state");\r
- return 2;\r
- } # if\r
-\r
- $session->EditEntity ($entity, "complete");\r
- $entity->SetFieldValue ("ActualEffort", $actualHrs) if $actualHrs ne "";\r
-\r
- my $status = $entity->Validate ();\r
-\r
- if ($status ne "") {\r
- $entity->Revert ();\r
- error ("Complete failed for WOR $wor:\n$status");\r
- return 2;\r
- } # if\r
-\r
- $status = $entity->Commit ();\r
-\r
- if ($status ne "") {\r
- error ("Complete failed during Submit for WOR $wor:\n$status");\r
- return 2;\r
- } # if\r
-\r
- return 0;\r
-} # Complete\r
-\r
-#-----------------------------------------------------------------------------\r
-# executeCommand (@): Executes a cqtool command\r
-#-----------------------------------------------------------------------------\r
-sub executeCommand (@) {\r
- my (@args) = @_;\r
-\r
- my $cmd = lc shift @args;\r
-\r
- return if $cmd eq "";\r
-\r
- if ($_commands{$cmd}) {\r
- if (!$CQTool::session) {\r
- if ( # Commands that do not require a database connection\r
- !($cmd eq "exit" or\r
- $cmd eq "quit" or\r
- $cmd eq "help" or\r
- $cmd eq "usage" or\r
- $cmd eq "verbose")) {\r
- verbose "Opening $_db_name as $_userid...";\r
-\r
- if (!$_password) {\r
- display_nolf ("${_userid}'s password:");\r
- `stty -echo`;\r
- $_password = <STDIN>;\r
- chomp $_password;\r
- display ("");\r
- `stty echo`;\r
- } # if\r
-\r
- openDB ($_userid, $_password, $_db_name);\r
- } # if\r
- } # if\r
-\r
- # Treat args: Args that are enclosed in quotes must be\r
- # combined. For simplicity's sake we will only support matched\r
- # pairs of double quotes. Anything else results in undefined\r
- # behavior.\r
- my (@new_args);\r
-\r
- foreach (@args) {\r
- # Quoted argument starting\r
- if (/^\"(.*)\"$/s) {\r
- push @new_args, $1;\r
- } else {\r
- push @new_args, $_;\r
- } # if\r
- } # foreach\r
-\r
- $_log->msg ("$cmd (" . join (",", @new_args) . ")") if get_debug;\r
-\r
- return $_commands{$cmd} (@new_args);\r
- } else {\r
- error ("Unknown command \"$cmd\" (try help)");\r
- return 1;\r
- } # if\r
-} # executeCommand\r
-\r
-#-----------------------------------------------------------------------------\r
-# commandLoop (@): This is the interactive command loop\r
-#-----------------------------------------------------------------------------\r
-sub commandLoop (@) {\r
- my (@args) = @_;\r
-\r
- # For single, command line, commands...\r
- return executeCommand (@args) if @args;\r
-\r
- announce if !$_ucmwb;\r
-\r
- while () {\r
- if (!$_ucmwb) {\r
- display_nolf ($PROMPT . RESET . UNDERLINE);\r
- } else {\r
- display_nolf ($UCMWB_PROMPT);\r
- } # if\r
-\r
- # Read command into $_\r
- $_ = <STDIN>;\r
- chomp;\r
-\r
- # If we are not being called by ucmwb, display RESET to stop the\r
- # UNDERLINE we were using. This keeps the output from being\r
- # underlined. In ucmwb mode we are not using any of the terminal\r
- # sequences.\r
- display_nolf (RESET) if !$_ucmwb;\r
-\r
- # If the user hit Control-d then a ^D is displayed but we remain\r
- # on the same line. So output a carriage return and exit 0.\r
- if (!$_) {\r
- display ("");\r
- exit 0;\r
- } # if\r
-\r
- # Special handling for set command since we want to take\r
- # everything after <field> to be a value, and we may get long\r
- # values that are space separated and space significant\r
- # (e.g. description?)\r
- if (/^\s*(\w+)\s+(\w+)\s+(\w+)\s+(.*)/) {\r
- if (lc $1 eq "set") {\r
- my $cmd = $1;\r
- my $wor = $2;\r
- my $field = $3;\r
- my $value = $4;\r
-\r
- # Change "\n"'s back to \n's\r
- $value =~ s/\\n/\n/g;\r
-\r
- executeCommand ($cmd, $wor, $field, "\"$value\"");\r
- } else {\r
- executeCommand (split);\r
- } # if\r
- } else {\r
- executeCommand (split);\r
- } # if\r
- } # while\r
-} # commandLoop\r
+#!/usr/bin/env /opt/rational/clearquest/bin/cqperl
+##############################################################################
+#
+# Name: cqtool
+#
+# Description: cqtool is an interface to Clearquest to perform some simple
+# actions to the RANCQ database. It is used primarily by ucmwb
+# but it also supports a command line interface.
+#
+# The following commands are supported:
+#
+# activate <wor> <project> <est_hours> <startdate> <enddate>:
+# Activate WOR
+# assign <wor> <assignee> <project> <planned_hours> <startdate>:
+# Assign the WOR
+# clone <wor>:
+# Clones a WOR
+# comment <wor> <comment>
+# Add a comment to the Notes_Entry field for the WOR
+# complete <wor> <actual_hours>:
+# Complete WOR
+# createhd:
+# Create a new Help Desk Ticket
+# createwor:
+# Create a new WOR
+# effort <wor> <hours>:
+# Update the WOR's actual hours
+# exit|quit:
+# Exits cqtool
+# help:
+# This display
+# link <parent wor> <child wor>:
+# Link a parent WOR to a child WOR
+# resolve <wor>:
+# Resolve WOR
+# set <wor> <field> <value>
+# Set <field> to <value> for the <wor>
+# usage:
+# Displays command line usage
+# version:
+# Displays version of cqtool
+#
+# Many of these commands simply perform actions on a wor. Two
+# of these commands, createwor and createhd have Perl/Tk GUI
+# interfaces.
+#
+# Command line usage:
+#
+# Usage: cqtool\t[-usage|help] [-verbose] [-debug]
+# [-userid <user>] [-password <password>] [<command>]
+#
+# Where:
+#
+# -usage|help: Display usage
+# -verbose: Turn on verbose mode
+# -debug: Turn on debug mode
+# -userid: User ID to log into Clearquest database as
+# -password: Password to use
+# <command> If specified then cqtool executes <command> and
+# exits
+#
+# Environment: cqtool supports the following environment variables
+# that are used mostly for tesing purposes
+#
+# CQ_DBSET: Clearquest DBSET to open (e.g. XTST3 for testing -
+# default RANCQ)
+# CQ_USER: User name to log into the $CQ_DBSET database with
+# CQ_PASSWORD: Password to use to log into the $CQ_DBSET with.
+#
+# Author: Andrew@DeFaria.com
+#
+# (c) Copyright 2007, General Dynamics, all rights reserved
+#
+##############################################################################
+use strict;
+use warnings;
+
+use CQPerlExt;
+use FindBin;
+use Getopt::Long;
+use Term::ANSIColor qw (:constants);
+
+use lib ("$FindBin::Bin", "$FindBin::Bin/../lib");
+
+use SCCM::Misc;
+use Display;
+use CQTool;
+use CreateWORUI;
+use CreateHelpDeskUI;
+use Logger;
+
+my $VERSION = BOLD GREEN . "1.1" . RESET;
+my $PROMPT = BOLD YELLOW . ">>" . RESET;
+my $UCMWB_PROMPT = ">>";
+my $DESC = BOLD RED . "$FindBin::Script" .
+ RESET " Version " .
+ $VERSION .
+ CYAN ": Program to talk to Clearquest" .
+ RESET;
+
+# Globals
+my $_userid = $ENV{CQ_USER} ? $ENV{CQ_USER} : $ENV{USER};
+my $_password = $ENV{CQ_PASSWORD};
+my $_db_name = $ENV{CQ_DBSET} ? $ENV{CQ_DBSET} : "RANCQ";
+my $_ucmwb;
+
+my $_log;
+
+if (get_debug) {
+ $_log = new Logger (
+ path => "/tmp",
+ append => 1,
+ );
+} # if
+
+my %_commands = (
+ activate => \&activate,
+ assign => \&assign,
+ clone => \&clone,
+ comment => \&comment,
+ complete => \&complete,
+ createhd => \&createHelpDesk,
+ createwor => \&createWOR,
+ effort => \&effort,
+ exit => \&shutdown,
+ help => \&help,
+ link => \&linkParentWor2ChildWor,
+ quit => \&shutdown,
+ resolve => \&resolve,
+ set => \&set,
+ usage => \&usage,
+ version => \&announce,
+);
+
+##############################################################################
+# Forwards
+##############################################################################
+sub commandLoop (@);
+
+##############################################################################
+# Main
+##############################################################################
+MAIN: {
+ GetOptions (
+ "usage" => sub { usage () },
+ "verbose" => sub { set_verbose () },
+ "debug" => sub { set_debug () },
+ "userid=s" => \$_userid,
+ "password=s" => \$_password,
+ "database=s" => \$_db_name,
+ "ucmwb" => \$_ucmwb,
+ ) || usage ();
+
+ exit (commandLoop(@ARGV));
+} # MAIN
+
+##############################################################################
+# Subroutines
+##############################################################################
+
+#-----------------------------------------------------------------------------
+# shutdown (): Ends program
+#-----------------------------------------------------------------------------
+sub shutdown () {
+ exit (0);
+} # exit
+
+#-----------------------------------------------------------------------------
+# help (): Displays help
+#-----------------------------------------------------------------------------
+sub help () {
+ display ($DESC);
+ display <<END;
+
+Valid commands are:
+
+activate <wor> <project> <est_hours> <startdate> <enddate>:
+ Activate WOR
+assign <wor> <assignee> <project> <planned_hours> <startdate>:
+ Assign the WOR
+clone <wor>:
+ Clones a WOR
+comment <wor> <comment>
+ Add a comment to the Notes_Entry field for the WOR
+complete <wor> <actual_hours>:
+ Complete WOR
+createhd:
+ Create a new Help Desk Ticket
+createwor:
+ Create a new WOR
+effort <wor> <hours>:
+ Update the WOR's actual hours
+exit|quit:
+ Exits $FindBin::Script
+help:
+ This display
+link <parent wor> <child wor>:
+ Link a parent WOR to a child WOR
+resolve <wor>:
+ Resolve WOR
+set <wor> <field> <value>
+ Set <field> to <value> for the <wor>
+usage:
+ Displays command line usage
+version:
+ Displays version of $FindBin::Script
+END
+} # help
+
+#-----------------------------------------------------------------------------
+# announce (): Announce ourselves
+#-----------------------------------------------------------------------------
+sub announce () {
+ display ($DESC);
+} # Announce
+
+#-----------------------------------------------------------------------------
+# dberror ($): Handle errors when talking to Clearquest. Note we need to reset
+# the database connection if an error happens.
+#-----------------------------------------------------------------------------
+sub dberror ($) {
+ my ($msg) = @_;
+
+ # Need to not only report the error but to reopen the
+ # database. Something gets corruppted if we don't!
+ error ($msg);
+
+ closeDB ();
+
+ openDB ($_userid, $_password, $_db_name);
+} # DBError
+
+#-----------------------------------------------------------------------------
+# getEntity ($$): Get an entity from Clearquest
+#-----------------------------------------------------------------------------
+sub getEntity ($$) {
+ my ($recordname, $wor) = @_;
+
+ my $entity;
+
+ eval {
+ $entity = $CQTool::session->GetEntity ($recordname, $wor);
+ };
+
+ if ($@) {
+ chomp $@;
+ dberror ($@);
+ return undef;
+ } else {
+ return $entity;
+ } # if
+} # getEntity
+
+#-----------------------------------------------------------------------------
+# set ($$$): Set $field to $value for $wor
+#-----------------------------------------------------------------------------
+sub set ($$@) {
+ my ($wor, $field, $value) = @_;
+
+ if (!$wor or $wor eq "") {
+ error ("WOR is required");
+ return 1;
+ } # if
+
+ if (!$field or $field eq "") {
+ error ("Field is required");
+ return 1;
+ } # if
+
+ my $entity = getEntity ("WOR", $wor);
+
+ return 1 if !$entity;
+
+ $session->EditEntity ($entity, "modify");
+
+ $_log->msg ("Modifying $field to \"$value\"") if get_debug;
+ eval {
+ $entity->SetFieldValue ($field, $value);
+ };
+
+ if ($@) {
+ dberror ("$field set failed for WOR $wor:\n$@");
+ return 2;
+ } # if
+
+ my $status = $entity->Validate ();
+
+ if ($status ne "") {
+ $entity->Revert ();
+ error ("$field validate failed for WOR $wor:\n$status");
+ return 2;
+ } # if
+
+ $status = $entity->Commit ();
+
+ if ($status ne "") {
+ error ("$field update failed during Submit for $wor:\n$status");
+ return 2;
+ } # if
+
+ return 0;
+} # set
+
+#-----------------------------------------------------------------------------
+# clone ($): Clone a WOR
+#-----------------------------------------------------------------------------
+sub clone ($) {
+ my ($wor) = @_;
+
+ if (!$wor) {
+ error ("WOR not specified!");
+ return 1;
+ } # if
+
+ $entity = getEntity ("WOR", $wor);
+
+ return 1 if !$entity;
+
+ # Check state
+ my $state = $entity->GetFieldValue ("state")->GetValue ();
+
+ if ($state ne "Closed") {
+ error ("WOR $wor not closed - Unable to clone!");
+ return 1;
+ } # if
+
+ verbose ("Cloning WOR $wor...");
+
+ my $result = 0;
+
+ eval {
+ # Currently Clone doesn't return a proper result but eventually...
+ $result = $CQTool::session->FireRecordScriptAlias ($entity, "Clone");
+ };
+
+ if ($@) {
+ chomp $@;
+ dberror ($@);
+ return 1;
+ } # if
+
+ return $result;
+} # clone
+
+#-----------------------------------------------------------------------------
+# effort ($$): Update actual hours for a WOR
+#-----------------------------------------------------------------------------
+sub effort ($$) {
+ my ($wor, $actualHrs) = @_;
+
+ return set $wor, "ActualEffort", $actualHrs;
+} # effort
+
+#-----------------------------------------------------------------------------
+# comment (): Update the Notes_Entry comment field for a WOR
+#-----------------------------------------------------------------------------
+sub comment ($) {
+ my ($wor) = @_;
+
+ if (!$wor) {
+ error "WOR not defined in call to comment!";
+ return 1;
+ } # if
+
+ if (!$_ucmwb) {
+ display ("Enter comments below. When finished, enter \".\" on a line by itself or hit ^D:");
+ } else {
+ # We still need to prompt for the comments however signal UCMWB
+ # that command is ready for more input.
+ display_nolf ($UCMWB_PROMPT);
+ } # if
+
+ my $comments;
+
+ while (<STDIN>) {
+ last if $_ eq ".\n";
+ $comments .= $_;
+ } # while
+
+ chomp $comments;
+
+ $_log->msg ("Comments:\n$comments") if get_debug;
+
+ return set $wor, "Note_Entry", $comments;
+} # Comment
+
+#-----------------------------------------------------------------------------
+# linkParentWor2ChildWor ($$): Link a child WOR to a parent WOR
+#-----------------------------------------------------------------------------
+sub linkParentWor2ChildWor ($$) {
+ my ($parentWor, $childWor) = @_;
+
+ my $status;
+
+ verbose ("Linking $parentWor -> $childWor...");
+
+ my $childentity = getEntity ("WOR", $childWor);
+ my $parententity = getEntity ("WOR", $parentWor);
+
+ return 1 unless $childentity and $parententity;
+
+ $session->EditEntity ($parententity, "modify");
+
+ $parententity->AddFieldValue ("wor_children", $childWor);
+
+ $status = $parententity->Validate ();
+
+ if ($status ne "") {
+ $parententity->Revert ();
+ error ("Validation failed while attempting to add child WOR $childWor to parent WOR $parentWor:\n$status");
+ return 1;
+ } # if
+
+ eval {
+ $status = $parententity->Commit ();
+ };
+
+ $status = $@ if $@;
+
+ if ($status ne "") {
+ (error "Commit failed while trying to add child WOR $childWor to parent WOR $parentWor:\n$status");
+ return 2;
+ } # if
+
+ debug "Modifying child $childWor...";
+ $session->EditEntity ($childentity, "modify");
+
+ $childentity->SetFieldValue ("wor_parent", $parentWor);
+
+ $status = $childentity->Validate ();
+
+ if ($status ne "") {
+ $childentity->Revert ();
+ error "Validation failed while attempting to add parent WOR $parentWor to child WOR $childWor:\n$status";
+ return 1;
+ } # if
+
+ eval {
+ $status = $childentity->Commit ();
+ };
+
+ $status = $@ if $@;
+
+ if ($status ne "") {
+ error "Commit failed while trying to add parent WOR $parentWor to child WOR $childWor:\n$status";
+ return 2;
+ } # if
+
+ return 0;
+} # linkParentWor2ChildWor
+
+#-----------------------------------------------------------------------------
+# assign ($$$$): Assign a WOR
+#-----------------------------------------------------------------------------
+sub assign ($$$$$) {
+ my ($wor, $assignee, $project, $plannedHrs, $startDate) = @_;
+
+ if (!$wor or $wor eq "") {
+ error ("WOR is required");
+ return 1;
+ } # if
+
+ if (!$assignee or $assignee eq "") {
+ error ("Assignee must be specified");
+ return 1;
+ } # if
+
+ if (!$project or $project eq "") {
+ error ("UCM Project is required");
+ return 1;
+ } # if
+
+ if (!$startDate or $startDate eq "") {
+ error ("Planned Start Date is required");
+ return 1;
+ } # if
+
+ my $entity = getEntity ("WOR", $wor);
+
+ return 1 if !$entity;
+
+ my $state = $entity->GetFieldValue ("state")->GetValue ();
+
+ if ($state ne "Submitted") {
+ error ("WOR $wor is not in Submitted state!\nState: $state");
+ return 2;
+ } # if
+
+ $session->EditEntity ($entity, "assign");
+
+ $entity->SetFieldValue ("ucm_project", $project) if $project ne "";
+ $entity->SetFieldValue ("PlannedStart", $startDate) if $startDate ne "";
+ $entity->SetFieldValue ("PlannedEffort", $plannedHrs) if $plannedHrs ne "";
+ $entity->SetFieldValue ("Owner", $assignee) if $assignee ne "";
+
+ my $status = $entity->Validate ();
+
+ if ($status ne "") {
+ $entity->Revert ();
+ error ("Assign failed for WOR $wor:\n$status");
+ return 2;
+ } # if
+
+ $status = $entity->Commit ();
+
+ if ($status ne "") {
+ error ("Assign failed during Submit for WOR $wor:\n$status");
+ return 2;
+ } # if
+
+ return 0;
+} # assign
+
+#-----------------------------------------------------------------------------
+# activate (): Activate a WOR
+#-----------------------------------------------------------------------------
+sub activate ($$$$$) {
+ my ($wor, $project, $estHrs, $startDate, $endDate) = @_;
+
+ if (!$wor or $wor eq "") {
+ error ("WOR is required");
+ return 1;
+ } # if
+
+ if (!$project or $project eq "") {
+ error ("UCM Project is required");
+ return 1;
+ } # if
+
+ if (!$startDate or $startDate eq "") {
+ error ("Planned Start Date is required");
+ return 1;
+ } # if
+
+ if (!$endDate or $endDate eq "") {
+ error ("Planned End Date is required");
+ return 1;
+ } # if
+
+ my $entity = getEntity ("WOR", $wor);
+
+ return 1 if !$entity;
+
+ my $state = $entity->GetFieldValue ("state")->GetValue ();
+
+ if ($state ne "Assessing") {
+ error ("WOR $wor is not in Assessing state!\nstate: $state");
+ return 2;
+ } # if
+
+ $session->EditEntity ($entity, "activate");
+
+ $entity->SetFieldValue ("ucm_project", $project) if $project ne "";
+ $entity->SetFieldValue ("EstimatedEffort", $estHrs) if $estHrs ne "";
+ $entity->SetFieldValue ("PlannedStart", $startDate) if $startDate ne "";
+ $entity->SetFieldValue ("PlannedEnd", $endDate) if $endDate ne "";
+
+ my $status = $entity->Validate ();
+
+ if ($status ne "") {
+ $entity->Revert ();
+ error ("Activate failed for WOR $wor:\n$status");
+ return 2;
+ } # if
+
+ $status = $entity->Commit ();
+
+ if ($status ne "") {
+ error ("Activate failed during Submit for WOR $wor:\n$status");
+ return 2;
+ } # if
+
+ return 0;
+} # activate
+
+#-----------------------------------------------------------------------------
+# resolve ($): Resolve a WOR
+#-----------------------------------------------------------------------------
+sub resolve ($) {
+ my ($wor) = @_;
+
+ if (!$wor or $wor eq "") {
+ error ("WOR is required");
+ return 1;
+ } # if
+
+ my $entity = getEntity ("WOR", $wor);
+
+ return 1 if !$entity;
+
+ my $state = $entity->GetFieldValue ("state")->GetValue ();
+
+ if ($state ne "Working") {
+ error ("WOR $wor is not in Working state!\nState: $state");
+ return 2;
+ } # if
+
+ $session->EditEntity ($entity, "resolve");
+
+ my $status = $entity->Validate ();
+
+ if ($status ne "") {
+ $entity->Revert ();
+ error ("Resolve failed for WOR $wor:\n$status");
+ return 2;
+ } # if
+
+ $status = $entity->Commit ();
+
+ if ($status ne "") {
+ error ("Resolve failed during Submit for WOR $wor:\n$status");
+ return 2;
+ } # if
+
+ return 0;
+} # resolve
+
+#-----------------------------------------------------------------------------
+# complete ($$): Complete a WOR
+#-----------------------------------------------------------------------------
+sub complete ($$) {
+ my ($wor, $actualHrs) = @_;
+
+ if (!$wor or $wor eq "") {
+ error ("WOR is required");
+ return 1;
+ } # if
+
+ if (!$wor or $wor eq "") {
+ error ("Actual Hours are required");
+ return 1;
+ } # if
+
+ my $entity = getEntity ("WOR", $wor);
+
+ return 1 if !$entity;
+
+ my $state = $entity->GetFieldValue ("state")->GetValue ();
+
+ if ($state ne "Verifying") {
+ error ("WOR $wor is not in Verifying state!\nState:$state");
+ return 2;
+ } # if
+
+ $session->EditEntity ($entity, "complete");
+ $entity->SetFieldValue ("ActualEffort", $actualHrs) if $actualHrs ne "";
+
+ my $status = $entity->Validate ();
+
+ if ($status ne "") {
+ $entity->Revert ();
+ error ("Complete failed for WOR $wor:\n$status");
+ return 2;
+ } # if
+
+ $status = $entity->Commit ();
+
+ if ($status ne "") {
+ error ("Complete failed during Submit for WOR $wor:\n$status");
+ return 2;
+ } # if
+
+ return 0;
+} # Complete
+
+#-----------------------------------------------------------------------------
+# executeCommand (@): Executes a cqtool command
+#-----------------------------------------------------------------------------
+sub executeCommand (@) {
+ my (@args) = @_;
+
+ my $cmd = lc shift @args;
+
+ return if $cmd eq "";
+
+ if ($_commands{$cmd}) {
+ if (!$CQTool::session) {
+ if ( # Commands that do not require a database connection
+ !($cmd eq "exit" or
+ $cmd eq "quit" or
+ $cmd eq "help" or
+ $cmd eq "usage" or
+ $cmd eq "verbose")) {
+ verbose "Opening $_db_name as $_userid...";
+
+ if (!$_password) {
+ display_nolf ("${_userid}'s password:");
+ `stty -echo`;
+ $_password = <STDIN>;
+ chomp $_password;
+ display ("");
+ `stty echo`;
+ } # if
+
+ openDB ($_userid, $_password, $_db_name);
+ } # if
+ } # if
+
+ # Treat args: Args that are enclosed in quotes must be
+ # combined. For simplicity's sake we will only support matched
+ # pairs of double quotes. Anything else results in undefined
+ # behavior.
+ my (@new_args);
+
+ foreach (@args) {
+ # Quoted argument starting
+ if (/^\"(.*)\"$/s) {
+ push @new_args, $1;
+ } else {
+ push @new_args, $_;
+ } # if
+ } # foreach
+
+ $_log->msg ("$cmd (" . join (",", @new_args) . ")") if get_debug;
+
+ return $_commands{$cmd} (@new_args);
+ } else {
+ error ("Unknown command \"$cmd\" (try help)");
+ return 1;
+ } # if
+} # executeCommand
+
+#-----------------------------------------------------------------------------
+# commandLoop (@): This is the interactive command loop
+#-----------------------------------------------------------------------------
+sub commandLoop (@) {
+ my (@args) = @_;
+
+ # For single, command line, commands...
+ return executeCommand (@args) if @args;
+
+ announce if !$_ucmwb;
+
+ while () {
+ if (!$_ucmwb) {
+ display_nolf ($PROMPT . RESET . UNDERLINE);
+ } else {
+ display_nolf ($UCMWB_PROMPT);
+ } # if
+
+ # Read command into $_
+ $_ = <STDIN>;
+ chomp;
+
+ # If we are not being called by ucmwb, display RESET to stop the
+ # UNDERLINE we were using. This keeps the output from being
+ # underlined. In ucmwb mode we are not using any of the terminal
+ # sequences.
+ display_nolf (RESET) if !$_ucmwb;
+
+ # If the user hit Control-d then a ^D is displayed but we remain
+ # on the same line. So output a carriage return and exit 0.
+ if (!$_) {
+ display ("");
+ exit 0;
+ } # if
+
+ # Special handling for set command since we want to take
+ # everything after <field> to be a value, and we may get long
+ # values that are space separated and space significant
+ # (e.g. description?)
+ if (/^\s*(\w+)\s+(\w+)\s+(\w+)\s+(.*)/) {
+ if (lc $1 eq "set") {
+ my $cmd = $1;
+ my $wor = $2;
+ my $field = $3;
+ my $value = $4;
+
+ # Change "\n"'s back to \n's
+ $value =~ s/\\n/\n/g;
+
+ executeCommand ($cmd, $wor, $field, "\"$value\"");
+ } else {
+ executeCommand (split);
+ } # if
+ } else {
+ executeCommand (split);
+ } # if
+ } # while
+} # commandLoop
projects / clearscm.git / blobdiff