1 ##############################################################################
3 # Name: CreateHelpDeskUI.pm
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.
15 # Another problem is that while IBM/Rational's cqtool
16 # would work, it does not return the ID of the Help Desk ticket
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
27 # Author: Andrew@ClearSCM.com
29 # (c) Copyright 2007, General Dynamics, all rights reserved
31 ##############################################################################
35 package CreateHelpDeskUI;
46 my $ME = "CreateHelpDesk";
50 my ($EDIT_FOREGROUND, $EDIT_BACKGROUND);
60 my $_createHelpDeskUI;
79 @_requested_priorities,
85 ############################################################################
87 ############################################################################
89 #---------------------------------------------------------------------------
90 # _helpAbout (): Puts up the Help: About dialog box
91 #---------------------------------------------------------------------------
93 my $text = "$ME v$VERSION\n";
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.
99 Copyright General Dynamics © 2007 - All rights reserved
100 Developed by Andrew DeFaria <Andrew\@ClearSCM.com> of ClearSCM, Inc.
103 my $desc = $_createHelpDeskUI->Dialog (
104 -title => "About $ME",
106 -buttons => [ "OK" ],
112 #---------------------------------------------------------------------------
113 # _displayValues (): Displays the contents for %hd hash
114 #---------------------------------------------------------------------------
115 sub _displayValues () {
118 display "$_: $hd{$_}";
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) = @_;
132 return @{$entity->GetFieldChoiceList ($fieldname)};
135 #---------------------------------------------------------------------------
136 # _destroyHelpDeskUI (): Destroys the current HelpDesk UI recycling Tk
138 #---------------------------------------------------------------------------
139 sub _destroyHelpDeskUI () {
140 # Destroy all globals created
145 destroy $_related_version;
147 destroy $_requestor_priority;
148 destroy $_createHelpDeskUI;
155 $_requestor_priority =
157 $_createHelpDeskUI = undef;
160 } # _destroyHelpDeskUI
162 #---------------------------------------------------------------------------
163 # _submit (): Actually creates the WOR given the filled out %hd hash.
164 #---------------------------------------------------------------------------
166 debug "Creating Help Desk Ticket...";
168 # Change requestor from a format of "lastname, firstname (badge)" -> badge
169 if ($hd{requestor} =~ /\((\w*)\)$/) {
173 _displayValues if get_debug;
175 my $new_id = CQTool::submitHelpDesk ($CQTool::entity, %hd);
177 display $new_id if $new_id;
184 #---------------------------------------------------------------------------
185 # _setSubmitButton (): Sets the submit button to active only if all required
186 # fields have values.
187 #---------------------------------------------------------------------------
188 sub _setSubmitButton (;$) {
193 # Check to see if we can activate the submit button
194 my $state = "normal";
196 foreach (@CQTool::hd_required_fields) {
197 if ($_ eq "headline") {
198 if (defined $headline) {
199 if ($headline eq "") {
208 if (!$hd{$_} or $hd{$_} eq "") {
214 $_submit->configure (
219 #---------------------------------------------------------------------------
220 # _validateText (): Gets the text from the MyText widget and sets the submit
222 #---------------------------------------------------------------------------
226 $hd{description} = $text->get_text;
227 chomp $hd{description};
229 _setSubmitButton $text;
234 #---------------------------------------------------------------------------
235 # _validateEntry (): Gets the text from the headline widget and sets the
237 #---------------------------------------------------------------------------
241 _setSubmitButton $entry;
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) = @_;
255 -width => length $label,
263 return $parent->Optionmenu (
264 -activeforeground => $EDIT_FOREGROUND,
265 -activebackground => $EDIT_BACKGROUND,
266 -command => \&$refresh,
268 -options => \@values,
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
281 #---------------------------------------------------------------------------
282 sub _createBrowseEntry ($$$$$$@) {
283 my ($parent, $x, $y, $label, $refresh, $value, @values) = @_;
286 -width => length $label,
294 my $longest_item = 0;
297 $longest_item = length $_ if length $_ > $longest_item;
300 my $browse_entry = $parent->BrowseEntry (
301 -browsecmd => \&$refresh,
303 -width => $longest_item,
313 $browse_entry->insert ($i++, $_);
316 return $browse_entry;
317 } # _createBrowseEntry
319 #---------------------------------------------------------------------------
320 # _createTextField (): Creates a text field widget in $parent with a $label
321 # and a $value, using a $maxlen and a $validate
323 #---------------------------------------------------------------------------
324 sub _createTextField ($$$$$) {
325 my ($parent, $label, $value, $maxlen, $validate) = @_;
337 -foreground => $EDIT_FOREGROUND,
338 -background => $EDIT_BACKGROUND,
341 -textvariable => $value,
343 -validatecommand => \&$validate,
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) = @_;
370 -foreground => $EDIT_FOREGROUND,
371 -background => $EDIT_BACKGROUND,
374 -modified => \&$validate,
383 #---------------------------------------------------------------------------
384 # _createButton (): Creates a pushbutton widget in $parent with a $label and
386 #---------------------------------------------------------------------------
387 sub _createButton ($$$) {
388 my ($parent, $label, $action) = @_;
391 -activeforeground => $EDIT_FOREGROUND,
392 -activebackground => $EDIT_BACKGROUND,
394 -width => length $label,
402 #---------------------------------------------------------------------------
403 # _changeDropDown (): Refreshes the values in the dropdown menu.
404 #---------------------------------------------------------------------------
405 sub _changeDropDown ($@) {
406 my ($dropdown, @values) = @_;
409 my $menu = $dropdown->menu;
412 $dropdown->menu->delete (0, "end");
415 $dropdown->addOptions (@values);
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 #---------------------------------------------------------------------------
427 $fieldname = "category";
428 @_categories = _getChoices $CQTool::entity, $fieldname;
429 $hd{$fieldname} = $_categories[0] if !$hd{$fieldname};
430 $CQTool::entity->SetFieldValue ($fieldname, $hd{$fieldname});
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});
437 $fieldname = "platform";
438 @_platforms = _getChoices $CQTool::entity, $fieldname;
439 $hd{$fieldname} = $_platforms[0] if !$hd{$fieldname};
440 $CQTool::entity->SetFieldValue ($fieldname, $hd{$fieldname});
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});
447 _changeDropDown $_category, @_categories;
448 _changeDropDown $_related_version, @_related_versions;
449 _changeDropDown $_platform, @_platforms;
450 _changeDropDown $_requestor_priority, @_requested_priorities;
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 #---------------------------------------------------------------------------
465 my $query = $CQTool::session->BuildQuery ("users");
467 $query->BuildField ("fullname");
469 my $filter = $query->BuildFilterOperator ($CQPerlExt::CQ_BOOL_OP_AND);
471 # Clearquest requires values to be in an array
474 $filter->BuildFilter ("login_name", $CQPerlExt::CQ_COMP_OP_EQ, \@badge);
476 my $result = $CQTool::session->BuildResultSet ($query);
480 my $status = $result->MoveNext;
484 while ($status == $CQPerlExt::CQ_SUCCESS) {
485 $fullname = $result->GetColumnValue (1);
486 $status = $result->MoveNext;
489 $names{$fullname ? $fullname : "<unknown>"} = $_;
495 #---------------------------------------------------------------------------
496 # _darken (): Returns a slightly darker color than the passed in color
497 #---------------------------------------------------------------------------
502 my ($r, $g, $b) = $_createHelpDeskUI->rgb($color);
504 # Set them to $DARKEN % of their previous values
506 my $rhex = sprintf "%x", $r * $DARKEN;
507 my $ghex = sprintf "%x", $g * $DARKEN;
508 my $bhex = sprintf "%x", $b * $DARKEN;
510 # Return a color string
511 return "\#$rhex$ghex$bhex";
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;
522 $EDIT_FOREGROUND = $_createHelpDeskUI->optionGet ("foreground", "Foreground");
523 $EDIT_BACKGROUND = _darken ($_createHelpDeskUI->optionGet ("background", "Background"));
525 $hd{id} = "None" if !$hd{id};
527 $_createHelpDeskUI->title ("Submit Helpdesk $hd{id}");
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;
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";
557 my %requestor_names = _getNames @_requestors;
561 foreach (sort keys %requestor_names) {
563 push @_requestors, "";
565 push @_requestors, "$_ ($requestor_names{$_})";
569 @_locations = _getChoices $CQTool::entity, "requestorlocation";
571 $_requestor = _createBrowseEntry
578 $_location = _createDropDown
586 $_category = _createDropDown
593 $_related_version = _createDropDown
598 \$hd{related_version},
601 $_platform = _createDropDown
608 $_requestor_priority = _createDropDown
611 "Requested Priority",
613 \$hd{requestedpriority},
614 @_requested_priorities;
616 $_submit = _createButton $frame6, "Submit", \&_submit;
618 $_submit->configure (
619 -state => "disabled",
622 _createButton $frame6, "Display", \&_displayValues if (get_debug);
623 _createButton $frame6, "About", \&_helpAbout;
624 _createButton $frame6, "Exit", sub { _destroyHelpDeskUI };