cqtool/CreateHelpDeskUI.pm

   1 ##############################################################################
   2 #
   3 # Name: CreateHelpDeskUI.pm
   4 #
   5 # Description: CreateHelpDeskUI.pm is a Perl module that encapsulates
   6 #              a Perl/Tk application to create a Help Desk
   7 #              ticket. This application was developed for a few
   8 #              reasons. First ucmwb needs to be able to create Help
   9 #              Desk tickets. The approach was to use IBM/Rational's
  10 #              cqtool (/opt/rational/clearquest/bin/cqtool) but there
  11 #              is two problems with this. First IBM/Rational's cqtool
  12 #              is unsupported and documented. Secondly IBM/Rational's
  13 #              cqtool is going away as of Clearquest 7.0.
  14 #
  15 #              Another problem is that while IBM/Rational's cqtool
  16 #              would work, it does not return the ID of the Help Desk ticket
  17 #              created!
  18 #
  19 #              So this Perl/Tk module was created to create Help Desk
  20 #              tickets. Perl interfaces with Clearquest to call the
  21 #              appropraite Clearquest action hooks and the like. Note
  22 #              that only the basic information is asked for. If you
  23 #              really want to create or modify a full Help Desk ticket
  24 #              use Clearquest. This Perl/Tk app's main customer is
  25 #              ucmwb.
  26 #
  27 # Author: Andrew@ClearSCM.com
  28 #
  29 # (c) Copyright 2007, General Dynamics, all rights reserved
  30 #
  31 ##############################################################################
  32 use strict;
  33 use warnings;
  34
  35 package CreateHelpDeskUI;
  36   use Tk;
  37   use Tk::Dialog;
  38   use Tk::BrowseEntry;
  39
  40   use Display;
  41   use Tk::MyText;
  42   use CQTool;
  43
  44   use base "Exporter";
  45
  46   my $ME                = "CreateHelpDesk";
  47   my $VERSION           = "1.1";
  48
  49   # Colors
  50   my ($EDIT_FOREGROUND, $EDIT_BACKGROUND);
  51
  52   our %hd;
  53
  54   our @EXPORT = qw (
  55     createHelpDeskUI
  56     %hd
  57   );
  58
  59   # Globals
  60   my $_createHelpDeskUI;
  61
  62   # Dropdowns
  63   my (
  64     $_requestor,
  65     $_location,
  66     $_category,
  67     $_related_version,
  68     $_platform,
  69     $_requestor_priority,
  70   );
  71
  72   # Choice lists
  73   my (
  74     @_requestors,
  75     @_locations,
  76     @_categories,
  77     @_related_versions,
  78     @_platforms,
  79     @_requested_priorities,
  80   );
  81
  82   # Buttons
  83   my $_submit;
  84
  85   ############################################################################
  86   # Subroutines
  87   ############################################################################
  88
  89   #---------------------------------------------------------------------------
  90   # _helpAbout (): Puts up the Help: About dialog box
  91   #---------------------------------------------------------------------------
  92   sub _helpAbout () {
  93     my $text = "$ME v$VERSION\n";
  94
  95     $text .= <<END;
  96
  97 This application creates a Help Desk ticket using Perl/Tk. It is used by UCM/WB or can be used stand alone. It effectively replicates the functionality of Clearquest but 1) is blocking and 2) returns the RANCQ-# so that UCM/WB can determine the number of the newly created WOR.
  98
  99 Copyright General Dynamics © 2007 - All rights reserved
 100 Developed by Andrew DeFaria <Andrew\@ClearSCM.com> of ClearSCM, Inc.
 101 END
 102
 103     my $desc = $_createHelpDeskUI->Dialog (
 104       -title            => "About $ME",
 105       -text             => $text,
 106       -buttons          => [ "OK" ],
 107     );
 108
 109     $desc->Show;
 110   } # _helpAbout
 111
 112   #---------------------------------------------------------------------------
 113   # _displayValues (): Displays the contents for %hd hash
 114   #---------------------------------------------------------------------------
 115   sub _displayValues () {
 116     foreach (keys %hd) {
 117       if ($hd{$_}) {
 118         display "$_: $hd{$_}";
 119       } else {
 120         display "$_: undef";
 121       } # if
 122     } # foreach
 123   } # _displayValues
 124
 125   #---------------------------------------------------------------------------
 126   # _getChoices (): For a given $entity and $fieldname, this routine returns
 127   #                 the given choice list from Clearquest.
 128   #---------------------------------------------------------------------------
 129   sub _getChoices ($$) {
 130     my ($entity, $fieldname) = @_;
 131
 132     return @{$entity->GetFieldChoiceList ($fieldname)};
 133   } # _getChoices
 134
 135   #---------------------------------------------------------------------------
 136   # _destroyHelpDeskUI (): Destroys the current HelpDesk UI recycling Tk
 137   #                        objects
 138   #---------------------------------------------------------------------------
 139   sub _destroyHelpDeskUI () {
 140     # Destroy all globals created
 141     destroy $_submit;
 142     destroy $_requestor;
 143     destroy $_location;
 144     destroy $_category;
 145     destroy $_related_version;
 146     destroy $_platform;
 147     destroy $_requestor_priority;
 148     destroy $_createHelpDeskUI;
 149
 150     $_requestor                 =
 151     $_location                  =
 152     $_category                  =
 153     $_related_version           =
 154     $_platform                  =
 155     $_requestor_priority        =
 156     $_submit                    =
 157     $_createHelpDeskUI          = undef;
 158
 159     %hd = ();
 160   } # _destroyHelpDeskUI
 161
 162   #---------------------------------------------------------------------------
 163   # _submit (): Actually creates the WOR given the filled out %hd hash.
 164   #---------------------------------------------------------------------------
 165   sub _submit () {
 166     debug "Creating Help Desk Ticket...";
 167
 168     # Change requestor from a format of "lastname, firstname (badge)" -> badge
 169     if ($hd{requestor} =~ /\((\w*)\)$/) {
 170       $hd{requestor} = $1;
 171     } # if
 172
 173     _displayValues if get_debug;
 174
 175     my $new_id = CQTool::submitHelpDesk ($CQTool::entity, %hd);
 176
 177     display $new_id if $new_id;
 178
 179     _destroyHelpDeskUI;
 180
 181     return $new_id;
 182   } # _submit
 183
 184   #---------------------------------------------------------------------------
 185   # _setSubmitButton (): Sets the submit button to active only if all required
 186   #                      fields have values.
 187   #---------------------------------------------------------------------------
 188   sub _setSubmitButton (;$) {
 189     my ($headline) = @_;
 190
 191     return if !$_submit;
 192
 193     # Check to see if we can activate the submit button
 194     my $state = "normal";
 195
 196     foreach (@CQTool::hd_required_fields) {
 197       if ($_ eq "headline") {
 198         if (defined $headline) {
 199           if ($headline eq "") {
 200             $state = "disable";
 201             last;
 202           } else {
 203             next;
 204           } # if
 205         } # if
 206       } # if
 207
 208       if (!$hd{$_} or $hd{$_} eq "") {
 209         $state = "disable";
 210         last;
 211       } # if
 212     } # foreach
 213
 214     $_submit->configure (
 215       -state    => $state,
 216     );
 217   } # _setSubmitButton
 218
 219   #---------------------------------------------------------------------------
 220   # _validateText (): Gets the text from the MyText widget and sets the submit
 221   #                   button
 222   #---------------------------------------------------------------------------
 223   sub _validatetext {
 224     my ($text) = @_;
 225
 226     $hd{description} = $text->get_text;
 227     chomp $hd{description};
 228
 229     _setSubmitButton $text;
 230
 231     return 1;
 232   } # _validatetext
 233
 234   #---------------------------------------------------------------------------
 235   # _validateEntry (): Gets the text from the headline widget and sets the
 236   #                    submit button
 237   #---------------------------------------------------------------------------
 238   sub _validateentry {
 239     my ($entry) = @_;
 240
 241     _setSubmitButton $entry;
 242
 243     return 1;
 244   } # _validateentry
 245
 246   #---------------------------------------------------------------------------
 247   # _createDropDown (): Creates a dropdown widget in $parent in a grid at the
 248   #                     $x, $y coordinates with a $label and a $value, using
 249   #                     dropdown @values and a $refresh procedure.
 250   #---------------------------------------------------------------------------
 251   sub _createDropDown ($$$$$$@) {
 252     my ($parent, $x, $y, $label, $refresh, $value, @values) = @_;
 253
 254     $parent->Label (
 255       -width            => length $label,
 256       -text             => "$label:",
 257     )->grid (
 258       -row              => $x,
 259       -column           => $y,
 260       -sticky           => "e",
 261     );
 262
 263     return $parent->Optionmenu (
 264       -activeforeground => $EDIT_FOREGROUND,
 265       -activebackground => $EDIT_BACKGROUND,
 266       -command          => \&$refresh,
 267       -variable         => $value,
 268       -options          => \@values,
 269     )->grid (
 270       -row              => $x,
 271       -column           => $y + 1,
 272       -sticky           => "w",
 273     );
 274   } # _createDropDown
 275
 276   #---------------------------------------------------------------------------
 277   # _createBrowseEntry (): Creates a dropdown like widget which drops down a
 278   #                        scrollable list in $parent with a $label, $refresh
 279   #                        procedure, setting $value with the choice from
 280   #                        @values.
 281   #---------------------------------------------------------------------------
 282   sub _createBrowseEntry ($$$$$$@) {
 283     my ($parent, $x, $y, $label, $refresh, $value, @values) = @_;
 284
 285     $parent->Label (
 286       -width            => length $label,
 287       -text             => "$label:",
 288     )->grid (
 289       -row              => $x,
 290       -column           => $y,
 291       -sticky           => "e",
 292     );
 293
 294     my $longest_item = 0;
 295
 296     foreach (@values) {
 297       $longest_item = length $_ if length $_ > $longest_item;
 298     } # if
 299
 300     my $browse_entry = $parent->BrowseEntry (
 301       -browsecmd        => \&$refresh,
 302       -variable         => $value,
 303       -width            => $longest_item,
 304     )->grid (
 305       -row              => $x,
 306       -column           => $y + 1,
 307       -sticky           => "w",
 308     );
 309
 310     my $i = 0;
 311
 312     foreach (@values) {
 313       $browse_entry->insert ($i++, $_);
 314     } # foreach
 315
 316     return $browse_entry;
 317   } # _createBrowseEntry
 318
 319   #---------------------------------------------------------------------------
 320   # _createTextField (): Creates a text field widget in $parent with a $label
 321   #                      and a $value, using a $maxlen and a $validate
 322   #                      procedure.
 323   #---------------------------------------------------------------------------
 324   sub _createTextField ($$$$$) {
 325     my ($parent, $label, $value, $maxlen, $validate) = @_;
 326
 327     $parent->Label (
 328       -text             => "$label:",
 329       -justify          => "right",
 330       -width            => 10,
 331     )->pack (
 332       -side             => "left",
 333       -anchor           => "e",
 334     );
 335
 336     $parent->Entry (
 337       -foreground       => $EDIT_FOREGROUND,
 338       -background       => $EDIT_BACKGROUND,
 339       -width            => $maxlen,
 340       -justify          => "left",
 341       -textvariable     => $value,
 342       -validate         => "key",
 343       -validatecommand  => \&$validate,
 344     )->pack (
 345       -side             => "left",
 346       -padx             => 5,
 347       -anchor           => "e",
 348     );
 349   } # _createTextField
 350
 351   #---------------------------------------------------------------------------
 352   # _createText (): Creates a multiline text field widget in $parent with a
 353   #                 $label and a $value, using the specified $rows and $cols
 354   #                 and a $validate procedure.
 355   #---------------------------------------------------------------------------
 356   sub _createText ($$$$$$) {
 357     my ($parent, $label, $value, $rows, $cols, $validate) = @_;
 358
 359     $parent->Label (
 360       -text             => "$label:",
 361       -justify          => "right",
 362       -width            => 10,
 363     )->pack (
 364       -side             => "left",+
 365       -anchor           => "n",
 366       -pady             => 5,
 367     );
 368
 369     $parent->MyText (
 370       -foreground       => $EDIT_FOREGROUND,
 371       -background       => $EDIT_BACKGROUND,
 372       -height           => $rows,
 373       -width            => $cols,
 374       -modified         => \&$validate,
 375       -text             => $value,
 376     )->pack (
 377       -side             => "left",
 378       -pady             => 5,
 379       -anchor           => "s",
 380     );
 381   } # _createText
 382
 383   #---------------------------------------------------------------------------
 384   # _createButton (): Creates a pushbutton widget in $parent with a $label and
 385   #                   an $action.
 386   #---------------------------------------------------------------------------
 387   sub _createButton ($$$) {
 388     my ($parent, $label, $action) = @_;
 389
 390     $parent->Button (
 391       -activeforeground => $EDIT_FOREGROUND,
 392       -activebackground => $EDIT_BACKGROUND,
 393       -text             => $label,
 394       -width            => length $label,
 395     -command            => \$action
 396     )->pack (
 397       -side             => "left",
 398       -padx             => 5
 399     );
 400   } # _createButton
 401
 402   #---------------------------------------------------------------------------
 403   # _changeDropDown (): Refreshes the values in the dropdown menu.
 404   #---------------------------------------------------------------------------
 405   sub _changeDropDown ($@) {
 406     my ($dropdown, @values) = @_;
 407
 408     if ($dropdown) {
 409       my $menu = $dropdown->menu;
 410
 411       if ($menu) {
 412         $dropdown->menu->delete (0, "end");
 413       } # if
 414
 415       $dropdown->addOptions (@values);
 416     } # if
 417   } # _changeDropDown
 418
 419   #---------------------------------------------------------------------------
 420   # _refresh (): Refreshes the application by getting news values from
 421   #              Clearquest. Note a change in one dropdown may change others,
 422   #              so we re-get all of them through this procedure.
 423   #---------------------------------------------------------------------------
 424   sub _refresh () {
 425     my $fieldname;
 426
 427     $fieldname                  = "category";
 428     @_categories                = _getChoices $CQTool::entity, $fieldname;
 429     $hd{$fieldname}             = $_categories[0] if !$hd{$fieldname};
 430     $CQTool::entity->SetFieldValue ($fieldname, $hd{$fieldname});
 431
 432     $fieldname                  = "related_version";
 433     @_related_versions  = _getChoices $CQTool::entity, $fieldname;
 434     $hd{$fieldname}             = $_related_versions[0] if !$hd{$fieldname};
 435     $CQTool::entity->SetFieldValue ($fieldname, $hd{$fieldname});
 436
 437     $fieldname                  = "platform";
 438     @_platforms         = _getChoices $CQTool::entity, $fieldname;
 439     $hd{$fieldname}             = $_platforms[0] if !$hd{$fieldname};
 440     $CQTool::entity->SetFieldValue ($fieldname, $hd{$fieldname});
 441
 442     $fieldname                  = "requestedpriority";
 443     @_requested_priorities      = _getChoices $CQTool::entity, $fieldname;
 444     $hd{$fieldname}             = $_requested_priorities[0] if !$hd{$fieldname};
 445     $CQTool::entity->SetFieldValue ($fieldname, $hd{$fieldname});
 446
 447     _changeDropDown $_category,                 @_categories;
 448     _changeDropDown $_related_version,          @_related_versions;
 449     _changeDropDown $_platform,                 @_platforms;
 450     _changeDropDown $_requestor_priority,       @_requested_priorities;
 451
 452     _setSubmitButton;
 453   } # _refresh
 454
 455   #---------------------------------------------------------------------------
 456   # _getNames (): Translates an array of badge numbers into a hash of names
 457   #               as the key and badge numbers as the value.
 458   #---------------------------------------------------------------------------
 459   sub _getNames (@) {
 460     my (@badges) = @_;
 461
 462     my %names;
 463
 464     foreach (@badges) {
 465       my $query = $CQTool::session->BuildQuery ("users");
 466
 467       $query->BuildField ("fullname");
 468
 469       my $filter = $query->BuildFilterOperator ($CQPerlExt::CQ_BOOL_OP_AND);
 470
 471       # Clearquest requires values to be in an array
 472       my @badge = $_;
 473
 474       $filter->BuildFilter ("login_name", $CQPerlExt::CQ_COMP_OP_EQ, \@badge);
 475
 476       my $result = $CQTool::session->BuildResultSet ($query);
 477
 478       $result->Execute;
 479
 480       my $status = $result->MoveNext;
 481
 482       my $fullname;
 483
 484       while ($status == $CQPerlExt::CQ_SUCCESS) {
 485         $fullname = $result->GetColumnValue (1);
 486         $status = $result->MoveNext;
 487       } # while
 488
 489       $names{$fullname ? $fullname : "<unknown>"} = $_;
 490     } # foreach
 491
 492     return %names;
 493   } # _getNames
 494
 495   #---------------------------------------------------------------------------
 496   # _darken (): Returns a slightly darker color than the passed in color
 497   #---------------------------------------------------------------------------
 498   sub _darken ($) {
 499     my ($color) = @_;
 500
 501     # Get the RGB values
 502     my ($r, $g, $b) = $_createHelpDeskUI->rgb($color);
 503
 504     # Set them to $DARKEN % of their previous values
 505     my $DARKEN = .8;
 506     my $rhex = sprintf "%x", $r * $DARKEN;
 507     my $ghex = sprintf "%x", $g * $DARKEN;
 508     my $bhex = sprintf "%x", $b * $DARKEN;
 509
 510     # Return a color string
 511     return "\#$rhex$ghex$bhex";
 512   } # _darken
 513
 514   #---------------------------------------------------------------------------
 515   # _createHelpDeskUI (): This is the main and exported routine that creates
 516   #                       and handles the entire Perl/Tk application for
 517   #                       creating a Help Desk ticket.
 518   #---------------------------------------------------------------------------
 519   sub createHelpDeskUI () {
 520     $_createHelpDeskUI = MainWindow->new;
 521
 522     $EDIT_FOREGROUND    = $_createHelpDeskUI->optionGet ("foreground", "Foreground");
 523     $EDIT_BACKGROUND    = _darken ($_createHelpDeskUI->optionGet ("background", "Background"));
 524
 525     $hd{id} = "None" if !$hd{id};
 526
 527     $_createHelpDeskUI->title ("Submit Helpdesk $hd{id}");
 528
 529     my $frame0 = $_createHelpDeskUI->Frame->pack (-pady => 2);
 530     my $frame1 = $_createHelpDeskUI->Frame->pack;
 531     my $frame2 = $_createHelpDeskUI->Frame->pack;
 532     my $frame3 = $_createHelpDeskUI->Frame->pack;
 533     my $frame4 = $_createHelpDeskUI->Frame->pack;
 534     my $frame5 = $_createHelpDeskUI->Frame->pack;
 535     my $frame6 = $_createHelpDeskUI->Frame->pack;
 536
 537     _createTextField
 538       $frame1,
 539       "Headline",
 540       \$hd{headline},
 541       100,
 542       \&_validateentry;
 543
 544     _createText
 545       $frame2,
 546       "Description",
 547       \$hd{description},
 548       24, 100,
 549       \&_validatetext;
 550
 551     @_categories                = _getChoices $CQTool::entity, "category";
 552     @_related_versions  = _getChoices $CQTool::entity, "related_version";
 553     @_platforms         = _getChoices $CQTool::entity, "platform";
 554     @_requested_priorities      = _getChoices $CQTool::entity, "requestedpriority";
 555     @_requestors                = _getChoices $CQTool::entity, "requestor";
 556
 557     my %requestor_names = _getNames @_requestors;
 558
 559     @_requestors = ();
 560
 561     foreach (sort keys %requestor_names) {
 562       if ($_ eq "") {
 563         push @_requestors, "";
 564       } else {
 565         push @_requestors, "$_ ($requestor_names{$_})";
 566       } # if
 567     } # foreach
 568
 569     @_locations         = _getChoices $CQTool::entity, "requestorlocation";
 570
 571     $_requestor = _createBrowseEntry
 572       $frame3,
 573       0, 0,
 574       "Requestor",
 575       \&_refresh,
 576       \$hd{requestor},
 577       @_requestors;
 578     $_location = _createDropDown
 579       $frame3,
 580       0, 3,
 581       "Location",
 582       \&_refresh,
 583       \$hd{location},
 584       @_locations;
 585
 586     $_category = _createDropDown
 587       $frame4,
 588       0, 0,
 589       "Category",
 590       \&_refresh,
 591       \$hd{category},
 592       @_categories;
 593     $_related_version = _createDropDown
 594       $frame4,
 595       0, 3,
 596       "Related Version",
 597       \&_refresh,
 598       \$hd{related_version},
 599       @_related_versions;
 600
 601     $_platform = _createDropDown
 602       $frame5,
 603       0, 0,
 604       "Platform",
 605       \&_refresh,
 606       \$hd{platform},
 607       @_platforms;
 608     $_requestor_priority = _createDropDown
 609       $frame5,
 610       0, 3,
 611       "Requested Priority",
 612       \&_refresh,
 613       \$hd{requestedpriority},
 614       @_requested_priorities;
 615
 616     $_submit = _createButton $frame6, "Submit", \&_submit;
 617
 618     $_submit->configure (
 619       -state    => "disabled",
 620     );
 621
 622     _createButton $frame6, "Display",   \&_displayValues if (get_debug);
 623     _createButton $frame6, "About",     \&_helpAbout;
 624     _createButton $frame6, "Exit",      sub { _destroyHelpDeskUI };
 625   } # createHelpDeskUI
 626
 627 1;