Hello gurus, I have this client/server app that keeps track of system IP address on a server. The client app uses perl/Tk and runs on a win32 platform. The client has been running great until my boss asked me to add a search component to it. The search component works exactly the way it is supposed, but the problem I am having is with the search dialogbox.

How the search works:
The client has a listbox that lists all the IPs. The search opens a dialogbox that takes the input for the search. If the search finds one match it highlights that ip in the listbox (works great). When the search finds more than one match it opens another dialogbox with the results. The user can then double click one of the results to have it highlight it in the listbox (also works great), and then close (destroy) the dialog box.

Here is the problem I am seeing: When I get the results dialogbox and double click a result, the dialogbox closes and the ip is highlighted. Then if I try to close the client using the windows "X" (standard windows close button), the app closes but the process is still there. I have tested it a bunch of different ways and it seems to have to do with the destroy of the dialogbox. If I never destroy it, the close works great. I was wondering if I was doing this wrong or if there was another way of doing it.

For now I have added this line to overcome the problem:
$top->protocol( 'WM_DELETE_WINDOW', sub{} );

[download]


search code (first sub called is search): 
sub getSearch {
    my $dialog = $top->DialogBox( 
            -title => "MxFWcon Search",
            -buttons => [ "Search", "Cancel" ],        
            );
    $dialog->add("Label", -text=> "MxFWcon Search")->grid(-row => '0',
+ -column => '0', -columnspan => 2);
    $dialog->add("Label", -text=> "IP:")->grid(-row => '2', -column =>
+ '0', -stick => "e");
    my $ip = $dialog->add("Entry", -width => 20)->grid(-row => '2', -c
+olumn => '1');
    return ($dialog, $ip);
}

sub getResults {
    my $list = shift;
    my $dialog = $top->DialogBox( 
            -title => "MxFWcon Search",
            -buttons => [ "Done" ],        
            );
    $dialog->add("Label", -text=> "MxFWcon Search")->grid(-row => '0',
+ -column => '0', -columnspan => 2);
    my $scroll = $dialog->add("Scrollbar", -orient => 'vertical')->gri
+d(-row => '2', -column => '1');
    my $ltb = $dialog->add("Listbox",
        -background => 'white',
        -height => '4',
        -width => '30',
        -yscrollcommand => ['set' => $scroll],
        )->grid(-row => '2', -column => '0');
    $scroll->configure(-command => ['yview' => $ltb]);
    foreach my $item(keys %$list) {
        $ltb->insert('end', $list->{$item});
    }
    $ltb->bind("<Double-1>", sub { searchGet($dialog, $ltb);});
    return ($dialog);
}

sub searchGet {
    my ($dialog, $ltb) = @_;
    if ((my $sel = $ltb->curselection()) !~ /^$/) {
        my $ip = $ltb->get($sel);
        my $lk1 = $vars->{lk1};
        my @ips = $lk1->get(0,'end');
        my $x = 0;
        foreach my $item(@ips) {
            if ($item eq $ip) {
                setBlock($x);
                $dialog->destroy;
                return;
            }
            $x++;
        } 
    }
    return;
}

sub setBlock {
    my $sel = shift;
    my $lk1 = $vars->{lk1};
    $lk1->selection('clear', 0, 'end');
    $lk1->selection('set', $sel);
    $lk1->see($sel);
}

sub search {
    my $lk1 = $vars->{lk1};
    my ($dialog, $ip) = getSearch();
    my $ans = $dialog->Show();
    if ($ans eq "Search") {
        my $sip = $ip->get;
        $sip =~ s/\s*//g;
        my %list;
            my @ips = $lk1->get(0,'end');
            my $x = 0;
            foreach my $item(@ips) {
                if ($item =~ /^$sip/) {
                    $list{$x} = $item;
                }
                $x++;
            }
            my $found = keys(%list);
            if ($found > 1) {
                my $res = getResults(\%list);
                $res->Show();
            }
            elsif ($found == 1) {
                    my ($x, $y) = each(%list);
                    setBlock($x);
            }
            else {
                getMess("IP: $sip NOT found in the list", "MxFWcon Sea
+rch");
            }
    }
    return;
}

[download]

In reply to Problems with perl/Tk dialogbox destroy by slydog

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.