cqtool/cqtool.pl

   1 #!/usr/bin/env /opt/rational/clearquest/bin/cqperl
   2 ##############################################################################
   3 #
   4 # Name: cqtool
   5 #
   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.
   9 #
  10 #               The following commands are supported:
  11 #
  12 #               activate <wor> <project> <est_hours> <startdate> <enddate>:
  13 #                       Activate WOR
  14 #               assign <wor> <assignee> <project> <planned_hours> <startdate>:
  15 #                       Assign the WOR
  16 #               clone <wor>:
  17 #                       Clones a WOR
  18 #               comment <wor> <comment>
  19 #                       Add a comment to the Notes_Entry field for the WOR
  20 #               complete <wor> <actual_hours>:
  21 #                       Complete WOR
  22 #               createhd:
  23 #                       Create a new Help Desk Ticket
  24 #               createwor:
  25 #                       Create a new WOR
  26 #               effort <wor> <hours>:
  27 #                       Update the WOR's actual hours
  28 #               exit|quit:
  29 #                       Exits cqtool
  30 #               help:
  31 #                       This display
  32 #               link <parent wor> <child wor>:
  33 #                       Link a parent WOR to a child WOR
  34 #               resolve <wor>:
  35 #                       Resolve WOR
  36 #               set <wor> <field> <value>
  37 #                       Set <field> to <value> for the <wor>
  38 #               usage:
  39 #                       Displays command line usage
  40 #               version:
  41 #                       Displays version of cqtool
  42 #
  43 #               Many of these commands simply perform actions on a wor. Two
  44 #               of these commands, createwor and createhd have Perl/Tk GUI
  45 #               interfaces.
  46 #
  47 # Command line usage:
  48 #
  49 # Usage: cqtool\t[-usage|help] [-verbose] [-debug]
  50 #       [-userid <user>] [-password <password>] [<command>]
  51 #
  52 # Where:
  53 #
  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
  60 #                       exits
  61 #
  62 # Environment:          cqtool supports the following environment variables
  63 #                       that are used mostly for tesing purposes
  64 #
  65 #       CQ_DBSET:       Clearquest DBSET to open (e.g. XTST3 for testing -
  66 #                       default RANCQ)
  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.
  69 #
  70 # Author: Andrew@DeFaria.com
  71 #
  72 # (c) Copyright 2007, General Dynamics, all rights reserved
  73 #
  74 ##############################################################################
  75 use strict;
  76 use warnings;
  77
  78 use CQPerlExt;
  79 use FindBin;
  80 use Getopt::Long;
  81 use Term::ANSIColor qw (:constants);
  82
  83 use lib ("$FindBin::Bin", "$FindBin::Bin/../lib");
  84
  85 use SCCM::Misc;
  86 use Display;
  87 use CQTool;
  88 use CreateWORUI;
  89 use CreateHelpDeskUI;
  90 use Logger;
  91
  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" .
  96                           RESET      " Version " .
  97                           $VERSION .
  98                           CYAN ": Program to talk to Clearquest" .
  99                           RESET;
 100
 101 # Globals
 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";
 105 my $_ucmwb;
 106
 107 my $_log;
 108
 109 if (get_debug) {
 110   $_log = new Logger (
 111     path => "/tmp",
 112     append => 1,
 113   );
 114 } # if
 115
 116 my %_commands = (
 117   activate      => \&activate,
 118   assign        => \&assign,
 119   clone         => \&clone,
 120   comment       => \&comment,
 121   complete      => \&complete,
 122   createhd      => \&createHelpDesk,
 123   createwor     => \&createWOR,
 124   effort        => \&effort,
 125   exit          => \&shutdown,
 126   help          => \&help,
 127   link          => \&linkParentWor2ChildWor,
 128   quit          => \&shutdown,
 129   resolve       => \&resolve,
 130   set           => \&set,
 131   usage         => \&usage,
 132   version       => \&announce,
 133 );
 134
 135 ##############################################################################
 136 # Forwards
 137 ##############################################################################
 138 sub commandLoop (@);
 139
 140 ##############################################################################
 141 # Main
 142 ##############################################################################
 143 MAIN: {
 144   GetOptions (
 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,
 151     "ucmwb"             => \$_ucmwb,
 152   ) || usage ();
 153
 154   exit (commandLoop(@ARGV));
 155 } # MAIN
 156
 157 ##############################################################################
 158 # Subroutines
 159 ##############################################################################
 160
 161 #-----------------------------------------------------------------------------
 162 # shutdown (): Ends program
 163 #-----------------------------------------------------------------------------
 164 sub shutdown () {
 165   exit (0);
 166 } # exit
 167
 168 #-----------------------------------------------------------------------------
 169 # help (): Displays help
 170 #-----------------------------------------------------------------------------
 171 sub help () {
 172   display ($DESC);
 173   display <<END;
 174
 175 Valid commands are:
 176
 177 activate <wor> <project> <est_hours> <startdate> <enddate>:
 178         Activate WOR
 179 assign <wor> <assignee> <project> <planned_hours> <startdate>:
 180         Assign the WOR
 181 clone <wor>:
 182         Clones a WOR
 183 comment <wor> <comment>
 184         Add a comment to the Notes_Entry field for the WOR
 185 complete <wor> <actual_hours>:
 186         Complete WOR
 187 createhd:
 188         Create a new Help Desk Ticket
 189 createwor:
 190         Create a new WOR
 191 effort <wor> <hours>:
 192         Update the WOR's actual hours
 193 exit|quit:
 194         Exits $FindBin::Script
 195 help:
 196         This display
 197 link <parent wor> <child wor>:
 198         Link a parent WOR to a child WOR
 199 resolve <wor>:
 200         Resolve WOR
 201 set <wor> <field> <value>
 202         Set <field> to <value> for the <wor>
 203 usage:
 204         Displays command line usage
 205 version:
 206         Displays version of $FindBin::Script
 207 END
 208 } # help
 209
 210 #-----------------------------------------------------------------------------
 211 # announce (): Announce ourselves
 212 #-----------------------------------------------------------------------------
 213 sub announce () {
 214   display ($DESC);
 215 } # Announce
 216
 217 #-----------------------------------------------------------------------------
 218 # dberror ($): Handle errors when talking to Clearquest. Note we need to reset
 219 #              the database connection if an error happens.
 220 #-----------------------------------------------------------------------------
 221 sub dberror ($) {
 222   my ($msg) = @_;
 223
 224   # Need to not only report the error but to reopen the
 225   # database. Something gets corruppted if we don't!
 226   error ($msg);
 227
 228   closeDB ();
 229
 230   openDB ($_userid, $_password, $_db_name);
 231 } # DBError
 232
 233 #-----------------------------------------------------------------------------
 234 # getEntity ($$): Get an entity from Clearquest
 235 #-----------------------------------------------------------------------------
 236 sub getEntity ($$) {
 237   my ($recordname, $wor) = @_;
 238
 239   my $entity;
 240
 241   eval {
 242     $entity = $CQTool::session->GetEntity ($recordname, $wor);
 243   };
 244
 245   if ($@) {
 246     chomp $@;
 247     dberror ($@);
 248     return undef;
 249   } else {
 250     return $entity;
 251   } # if
 252 } # getEntity
 253
 254 #-----------------------------------------------------------------------------
 255 # set ($$$): Set $field to $value for $wor
 256 #-----------------------------------------------------------------------------
 257 sub set ($$@) {
 258   my ($wor, $field, $value) = @_;
 259
 260   if (!$wor or $wor eq "") {
 261     error ("WOR is required");
 262     return 1;
 263   } # if
 264
 265   if (!$field or $field eq "") {
 266     error ("Field is required");
 267     return 1;
 268   } # if
 269
 270   my $entity    = getEntity ("WOR", $wor);
 271
 272   return 1 if !$entity;
 273
 274   $session->EditEntity ($entity, "modify");
 275
 276   $_log->msg ("Modifying $field to \"$value\"") if get_debug;
 277   eval {
 278     $entity->SetFieldValue ($field, $value);
 279   };
 280
 281   if ($@) {
 282     dberror ("$field set failed for WOR $wor:\n$@");
 283     return 2;
 284   } # if
 285
 286   my $status = $entity->Validate ();
 287
 288   if ($status ne "") {
 289     $entity->Revert ();
 290     error ("$field validate failed for WOR $wor:\n$status");
 291     return 2;
 292   } # if
 293
 294   $status = $entity->Commit ();
 295
 296   if ($status ne "") {
 297     error ("$field update failed during Submit for $wor:\n$status");
 298     return 2;
 299   } # if
 300
 301    return 0;
 302 } # set
 303
 304 #-----------------------------------------------------------------------------
 305 # clone ($): Clone a WOR
 306 #-----------------------------------------------------------------------------
 307 sub clone ($) {
 308   my ($wor) = @_;
 309
 310   if (!$wor) {
 311     error ("WOR not specified!");
 312     return 1;
 313   } # if
 314
 315   $entity = getEntity ("WOR", $wor);
 316
 317   return 1 if !$entity;
 318
 319   # Check state
 320   my $state = $entity->GetFieldValue ("state")->GetValue ();
 321
 322   if ($state ne "Closed") {
 323     error ("WOR $wor not closed - Unable to clone!");
 324     return 1;
 325   } # if
 326
 327   verbose ("Cloning WOR $wor...");
 328
 329   my $result = 0;
 330
 331   eval {
 332     # Currently Clone doesn't return a proper result but eventually...
 333     $result = $CQTool::session->FireRecordScriptAlias ($entity, "Clone");
 334   };
 335
 336   if ($@) {
 337     chomp $@;
 338     dberror ($@);
 339     return 1;
 340   } # if
 341
 342   return $result;
 343 } # clone
 344
 345 #-----------------------------------------------------------------------------
 346 # effort ($$): Update actual hours for a WOR
 347 #-----------------------------------------------------------------------------
 348 sub effort ($$) {
 349   my ($wor, $actualHrs) = @_;
 350
 351   return set $wor, "ActualEffort", $actualHrs;
 352 } # effort
 353
 354 #-----------------------------------------------------------------------------
 355 # comment (): Update the Notes_Entry comment field for a WOR
 356 #-----------------------------------------------------------------------------
 357 sub comment ($) {
 358   my ($wor) = @_;
 359
 360   if (!$wor) {
 361     error "WOR not defined in call to comment!";
 362     return 1;
 363   } # if
 364
 365   if (!$_ucmwb) {
 366     display ("Enter comments below. When finished, enter \".\" on a line by itself or hit ^D:");
 367   } else {
 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);
 371   } # if
 372
 373   my $comments;
 374
 375   while (<STDIN>) {
 376     last if $_ eq ".\n";
 377     $comments .= $_;
 378   } # while
 379
 380   chomp $comments;
 381
 382   $_log->msg ("Comments:\n$comments") if get_debug;
 383
 384   return set $wor, "Note_Entry", $comments;
 385 } # Comment
 386
 387 #-----------------------------------------------------------------------------
 388 # linkParentWor2ChildWor ($$): Link a child WOR to a parent WOR
 389 #-----------------------------------------------------------------------------
 390 sub linkParentWor2ChildWor ($$) {
 391   my ($parentWor, $childWor) = @_;
 392
 393   my $status;
 394
 395   verbose ("Linking $parentWor -> $childWor...");
 396
 397   my $childentity       = getEntity ("WOR", $childWor);
 398   my $parententity      = getEntity ("WOR", $parentWor);
 399
 400   return 1 unless $childentity and $parententity;
 401
 402   $session->EditEntity ($parententity, "modify");
 403
 404   $parententity->AddFieldValue ("wor_children", $childWor);
 405
 406   $status = $parententity->Validate ();
 407
 408   if ($status ne "") {
 409     $parententity->Revert ();
 410     error ("Validation failed while attempting to add child WOR $childWor to parent WOR $parentWor:\n$status");
 411     return 1;
 412   } # if
 413
 414   eval {
 415     $status = $parententity->Commit ();
 416   };
 417
 418   $status = $@ if $@;
 419
 420   if ($status ne "") {
 421     (error "Commit failed while trying to add child WOR $childWor to parent WOR $parentWor:\n$status");
 422     return 2;
 423   } # if
 424
 425   debug "Modifying child $childWor...";
 426   $session->EditEntity ($childentity, "modify");
 427
 428   $childentity->SetFieldValue ("wor_parent", $parentWor);
 429
 430   $status = $childentity->Validate ();
 431
 432   if ($status ne "") {
 433     $childentity->Revert ();
 434     error "Validation failed while attempting to add parent WOR $parentWor to child WOR $childWor:\n$status";
 435     return 1;
 436   } # if
 437
 438   eval {
 439     $status = $childentity->Commit ();
 440   };
 441
 442   $status = $@ if $@;
 443
 444   if ($status ne "") {
 445     error "Commit failed while trying to add parent WOR $parentWor to child WOR $childWor:\n$status";
 446     return 2;
 447   } # if
 448
 449   return 0;
 450 } # linkParentWor2ChildWor
 451
 452 #-----------------------------------------------------------------------------
 453 # assign ($$$$): Assign a WOR
 454 #-----------------------------------------------------------------------------
 455 sub assign ($$$$$) {
 456   my ($wor, $assignee, $project, $plannedHrs, $startDate) = @_;
 457
 458   if (!$wor or $wor eq "") {
 459     error ("WOR is required");
 460     return 1;
 461   } # if
 462
 463   if (!$assignee or $assignee eq "") {
 464     error ("Assignee must be specified");
 465     return 1;
 466   } # if
 467
 468   if (!$project or $project eq "") {
 469     error ("UCM Project is required");
 470     return 1;
 471   } # if
 472
 473   if (!$startDate or $startDate eq "") {
 474     error ("Planned Start Date is required");
 475     return 1;
 476   } # if
 477
 478   my $entity    = getEntity ("WOR", $wor);
 479
 480   return 1 if !$entity;
 481
 482   my $state     = $entity->GetFieldValue ("state")->GetValue ();
 483
 484   if ($state ne "Submitted") {
 485     error ("WOR $wor is not in Submitted state!\nState: $state");
 486     return 2;
 487   } # if
 488
 489   $session->EditEntity ($entity, "assign");
 490
 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 "";
 495
 496   my $status = $entity->Validate ();
 497
 498   if ($status ne "") {
 499     $entity->Revert ();
 500     error ("Assign failed for WOR $wor:\n$status");
 501     return 2;
 502   } # if
 503
 504   $status = $entity->Commit ();
 505
 506   if ($status ne "") {
 507     error ("Assign failed during Submit for WOR $wor:\n$status");
 508     return 2;
 509   } # if
 510
 511   return 0;
 512 } # assign
 513
 514 #-----------------------------------------------------------------------------
 515 # activate (): Activate a WOR
 516 #-----------------------------------------------------------------------------
 517 sub activate ($$$$$) {
 518   my ($wor, $project, $estHrs, $startDate, $endDate) = @_;
 519
 520   if (!$wor or $wor eq "") {
 521     error ("WOR is required");
 522     return 1;
 523   } # if
 524
 525   if (!$project or $project eq "") {
 526     error ("UCM Project is required");
 527     return 1;
 528   } # if
 529
 530   if (!$startDate or $startDate eq "") {
 531     error ("Planned Start Date is required");
 532     return 1;
 533   } # if
 534
 535   if (!$endDate or $endDate eq "") {
 536     error ("Planned End Date is required");
 537     return 1;
 538   } # if
 539
 540   my $entity    = getEntity ("WOR", $wor);
 541
 542   return 1 if !$entity;
 543
 544   my $state     = $entity->GetFieldValue ("state")->GetValue ();
 545
 546   if ($state ne "Assessing") {
 547     error ("WOR $wor is not in Assessing state!\nstate: $state");
 548     return 2;
 549   } # if
 550
 551   $session->EditEntity ($entity, "activate");
 552
 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 "";
 557
 558   my $status = $entity->Validate ();
 559
 560   if ($status ne "") {
 561     $entity->Revert ();
 562     error ("Activate failed for WOR $wor:\n$status");
 563     return 2;
 564   } # if
 565
 566   $status = $entity->Commit ();
 567
 568   if ($status ne "") {
 569     error ("Activate failed during Submit for WOR $wor:\n$status");
 570     return 2;
 571   } # if
 572
 573    return 0;
 574 } # activate
 575
 576 #-----------------------------------------------------------------------------
 577 # resolve ($): Resolve a WOR
 578 #-----------------------------------------------------------------------------
 579 sub resolve ($) {
 580   my ($wor) = @_;
 581
 582   if (!$wor or $wor eq "") {
 583     error ("WOR is required");
 584     return 1;
 585   } # if
 586
 587   my $entity    = getEntity ("WOR", $wor);
 588
 589   return 1 if !$entity;
 590
 591   my $state     = $entity->GetFieldValue ("state")->GetValue ();
 592
 593   if ($state ne "Working") {
 594     error ("WOR $wor is not in Working state!\nState: $state");
 595     return 2;
 596   } # if
 597
 598   $session->EditEntity ($entity, "resolve");
 599
 600   my $status = $entity->Validate ();
 601
 602   if ($status ne "") {
 603     $entity->Revert ();
 604     error ("Resolve failed for WOR $wor:\n$status");
 605     return 2;
 606   } # if
 607
 608   $status = $entity->Commit ();
 609
 610   if ($status ne "") {
 611     error ("Resolve failed during Submit for WOR $wor:\n$status");
 612     return 2;
 613   } # if
 614
 615    return 0;
 616 } # resolve
 617
 618 #-----------------------------------------------------------------------------
 619 # complete ($$): Complete a WOR
 620 #-----------------------------------------------------------------------------
 621 sub complete ($$) {
 622   my ($wor, $actualHrs) = @_;
 623
 624   if (!$wor or $wor eq "") {
 625     error ("WOR is required");
 626     return 1;
 627   } # if
 628
 629   if (!$wor or $wor eq "") {
 630     error ("Actual Hours are required");
 631     return 1;
 632   } # if
 633
 634   my $entity    = getEntity ("WOR", $wor);
 635
 636   return 1 if !$entity;
 637
 638   my $state     = $entity->GetFieldValue ("state")->GetValue ();
 639
 640   if ($state ne "Verifying") {
 641     error ("WOR $wor is not in Verifying state!\nState:$state");
 642     return 2;
 643   } # if
 644
 645   $session->EditEntity ($entity, "complete");
 646   $entity->SetFieldValue ("ActualEffort", $actualHrs) if $actualHrs ne "";
 647
 648   my $status = $entity->Validate ();
 649
 650   if ($status ne "") {
 651     $entity->Revert ();
 652     error ("Complete failed for WOR $wor:\n$status");
 653     return 2;
 654   } # if
 655
 656   $status = $entity->Commit ();
 657
 658   if ($status ne "") {
 659     error ("Complete failed during Submit for WOR $wor:\n$status");
 660     return 2;
 661   } # if
 662
 663    return 0;
 664 } # Complete
 665
 666 #-----------------------------------------------------------------------------
 667 # executeCommand (@): Executes a cqtool command
 668 #-----------------------------------------------------------------------------
 669 sub executeCommand (@) {
 670   my (@args) = @_;
 671
 672   my $cmd = lc shift @args;
 673
 674   return if $cmd eq "";
 675
 676   if ($_commands{$cmd}) {
 677     if (!$CQTool::session) {
 678       if ( # Commands that do not require a database connection
 679           !($cmd eq "exit"      or
 680             $cmd eq "quit"      or
 681             $cmd eq "help"      or
 682             $cmd eq "usage"     or
 683             $cmd eq "verbose")) {
 684         verbose "Opening $_db_name as $_userid...";
 685
 686         if (!$_password) {
 687           display_nolf ("${_userid}'s password:");
 688           `stty -echo`;
 689           $_password = <STDIN>;
 690           chomp $_password;
 691           display ("");
 692           `stty echo`;
 693         } # if
 694
 695         openDB ($_userid, $_password, $_db_name);
 696       } # if
 697     } # if
 698
 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
 702     # behavior.
 703     my (@new_args);
 704
 705     foreach (@args) {
 706       # Quoted argument starting
 707       if (/^\"(.*)\"$/s) {
 708         push @new_args, $1;
 709       } else {
 710         push @new_args, $_;
 711       } # if
 712     } # foreach
 713
 714     $_log->msg ("$cmd (" . join (",", @new_args) . ")") if get_debug;
 715
 716     return $_commands{$cmd} (@new_args);
 717   } else {
 718     error ("Unknown command \"$cmd\" (try help)");
 719     return 1;
 720   } # if
 721 } # executeCommand
 722
 723 #-----------------------------------------------------------------------------
 724 # commandLoop (@): This is the interactive command loop
 725 #-----------------------------------------------------------------------------
 726 sub commandLoop (@) {
 727   my (@args) = @_;
 728
 729   # For single, command line, commands...
 730   return executeCommand (@args) if @args;
 731
 732   announce if !$_ucmwb;
 733
 734   while () {
 735     if (!$_ucmwb) {
 736       display_nolf ($PROMPT . RESET . UNDERLINE);
 737     } else {
 738       display_nolf ($UCMWB_PROMPT);
 739     } # if
 740
 741     # Read command into $_
 742     $_ = <STDIN>;
 743     chomp;
 744
 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
 748     # sequences.
 749     display_nolf (RESET) if !$_ucmwb;
 750
 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.
 753     if (!$_) {
 754       display ("");
 755       exit 0;
 756     } # if
 757
 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") {
 764         my $cmd         = $1;
 765         my $wor         = $2;
 766         my $field       = $3;
 767         my $value       = $4;
 768
 769         # Change "\n"'s back to \n's
 770         $value =~ s/\\n/\n/g;
 771
 772         executeCommand ($cmd, $wor, $field, "\"$value\"");
 773       } else {
 774         executeCommand (split);
 775       } # if
 776     } else {
 777       executeCommand (split);
 778     } # if
 779   } # while
 780 } # commandLoop