pg has asked for the wisdom of the Perl Monks concerning the following question:

I am working on something, and I need to interact with the user. I use Tk::Dialog, but the problem is that, when the DialogBox pop up, it is not really displayed on the screen, instead it is just an icon on the task bar.

I am using windows XP, and perl 5.8.4.

If you read the code - the red portion, you can see that I have tried something, but it does not work.

use IO::Select;
use IO::Socket;
use Tk::DialogBox;

use strict;
use warnings;

my $banned_type = {
    "cab" => 1,
    "class" => 1,
    "dat" => 1,
    "exe" => 1,
    "gif" => 1,
    "ico" => 1,
    "jpg" => 1,
    #"js" => 1,
    #"jsp" => 1,
    "png" => 1,
    "swf" => 1
};

my $trusted_site = {
"www.perlmonks.org"=>1
};

use constant RES_400 => "404 HTTP/1.1 Banned\r\n\r\n<html><body><h1>Ba
+nned</h1></body></html>";
use constant FAILED_TO_CONNECT_REMOTE => "404 HTTP/1.1 Banned\r\n\r\n<
+html><body>Failed to connect remote site %s</body></html>";

my $mw = MainWindow->new();
my $browser_listener = new IO::Socket::INET(Proto => "tcp",
                                            LocalAddr => "localhost",
                                            LocalPort => 8080,
                                            Reuse => 1,
                                            Timeout => 1,
                                            Listen => 10) || die "fail
+ed to create browser listener";
my $selector = new IO::Select();
my %pairs = ();
while (1) {
    if (my $browser = $browser_listener->accept()) {
        my $req = recv_req($browser);
        my $remote = send_req($browser, $req);
        if ($remote) {
            $selector->add($remote);
            $pairs{$remote} = $browser;
        };
    } 
    foreach my $remote ($selector->can_read(1)) {
        my $res = read_res($remote);
        if ($res) {
            send_res($pairs{$remote}, $res);
        } else {
            $selector->remove($remote);
            $remote->close();
            $pairs{$remote}->close();
            delete $pairs{$remote};
        }
    }
}

sub recv_req {
    my ($browser, $thread_id) = @_;
    my $content_length = 0;
    my $req = "";
    while (1) {
        my $chunk;
        $browser->recv($chunk, 10000);
        if ($chunk =~ m/Content-Length: (\d*)/) {
            $content_length = $1;
        }
        $req .= $chunk;
        last if ($chunk =~ "\r\n\r\n");
    }
    $req =~ /(.*?)\r\n\r\n(.*)/s;
    if (length($2) > 0) {
        $content_length -= length($2);
        print "after -, content_length = $content_length\n";
    }
    while ($content_length > 0) {
        my $chunk;
        $browser->recv($chunk, $content_length);
        $req .= $chunk;
        $content_length -= length($chunk);
    }
    return $req;
}

sub send_req {
    my ($browser, $req) = @_;
    my $host = ($req =~ m/Host:\s*(.*?)\r/)[0];
    my $remote;
    #some web site does not like repeat siet in get/post
    $req =~ s/$host//; #only once
    $req =~ s/http:\/\///;
    $req =~ m/.*?\s+(.*?)\s/;
    my $page = $1;
        if (!defined($trusted_site->{$host})) {

[download]
        my $dialog = $mw->DialogBox(-title => "Is $host trusted?", -bu
+ttons => ["Yes", "No"]);
        $dialog->geometry("600x100+0+0");
        $dialog->deiconify();
        my $answer = $dialog->Show(-global, -popover=>"cursor");
        
        if ($answer eq "Yes") {
            $trusted_site->{$host} = 1;
        } else {
            $trusted_site->{$host} = 0;
        }

[download]
 
}
    if (!$trusted_site->{$host} || is_banned_type($page)) {
            print "[$host, $page] is banned\n";
            print $browser RES_400;
            close($browser);
        } else {
            if ($remote = new IO::Socket::INET(Proto => "tcp", PeerAdd
+r => $host, PeerPort => 80)) {
                $remote->send($req);
            }
        }
    return $remote;
}

sub read_res {
    my $remote = shift;
    my $res;
    $remote->recv($res, 100000);
    if (!length($res)) {
        $res = undef;
    }
    return $res;
}

sub send_res {
    my ($browser, $res) = @_;
    $browser->send($res);
}


sub is_banned_type {
    my $tmp = lc(shift);
    if ($tmp ne "/") {
        $tmp = (split /\//, $tmp)[-1];
        my $type = (split /\./, $tmp)[-1];

        if ($type && exists($banned_type->{$type})) {
            return 1;
        } else {
            return 0;
        }
    }    
}

[download]

Replies are listed 'Best First'.
Re: Tk::DialogBox as the top window
by tachyon (Chancellor) on Oct 08, 2004 at 04:08 UTC

    You need a MainLoop; The problem is that Tk is event driven and you seem to want a hybrid console application that pops up a dialog. You are probably better to go with a native Win32 dialog box for this purpose.

    Given that you are writing a filtering proxy server a dialog box does not immediately seem appropriate. If the end user is using a browser why not use that CGI style. You could simple send back your message as HTML, let them post the form. Intercept it and respond appropriately.

    cheers

    tachyon

[reply]

      It is true that I don't have MainLoop, but I don't believe that was the issue. I observed more carefully, the DialogBox actually poped up, but it is not the top window, thus it is covered by the broswer window (as you said this is a filter ;-). If I minimize the broswer, then the DialogBox shows up (or click its icon to activate it, it also shows up).

      This code works, the box pops up three times:

      use Tk;

my $mw = MainWindow->new();
for (1..3) { 
    $mw->DialogBox(-title => "?", -buttons => ["Yes", "No"])->Show();
}

      [download]

      Which makes sense, as the "command prompt" window, from where I run my script, itself is the top window.

      The question is how to bring the DialogBox to top front automatically.

      CGI is an interesting answer. I like it. It requires more coding, but I am willing to go that way, if there is no way to bring the DialogBox to front.

      Sort of don't like the idea of Win32 GUI. Would rather reduce platform dependency.

[reply]
[d/l]
        the DialogBox actually poped up, but it is not the top window

        Usually, a 

          $window->raise;

        [download]
        raises your window, but in the case of a dialog, you might need to do something like: 
          $mw->after(50, sub {$dialog->raise});
  $dialog->Show;

        [download]
        to schedule a callback to be executed after the dialog is shown. Untested :)

        Also, if you don't need your MainWindow, why don't you withdraw it?

[reply]
[d/l]
[select]

        The problem you have is that the focus is with IE. You need to steal the focus to FG your dialog, then give it back. AFAK this means you have to deal with the window manager and as a result won't port transparently. Win32::GUITest for example shows you how to get focus on a Window from Perl. An alternative that still gives you a popup is to use a small javascript to generate your dialog box. You could pass it a hash and if you got the request+hash back in your filter call that a yes, otherwise....

        cheers

        tachyon

[reply]

Back to Seekers of Perl Wisdom