Home > Archive > PerlTk > January 2007 > Alter Button Callback and text server output
You are viewing an archived Text-only version of the thread.
To view this thread in it's original format and/or if you want to reply to
this thread please [click here]
| Author |
Alter Button Callback and text server output
|
|
| deadpickle 2006-12-19, 7:06 pm |
| Currently I have a mainwindow that has an entry that lets you change
the port and a text window that is suppost to display the output from
the server.
What I want to happen is that when I click the "Listen For Client"
button I want the buttons text to change to "Stop". When you click the
"Stop" button I want the program to stop and the button to turn back to
"Listen For Client". I have been told that fileevent should be use to
achieve this but I dont know how.
Secondly I would like the output from the server program after you hit
the "Listen For Client" button to be displayed in the text box. When
the server "hears" the client it will start to transfer the file to the
client. The server does this every 10 seconds or so. I want to see the
output from this in the text box but I'm not sure how to do this.
Here is the code:
========================================
================================
use Tk;
use Tk::LabEntry;
use strict;
use IO::Socket;
my $port = '2000';
#Main window interface
my $mainwindow = new MainWindow;
my $left = $mainwindow->Frame(-relief => 'sunken')->grid(-row => 1,
-column => 0,
-sticky => 'nw');
my $bottom = $mainwindow->Frame->grid(-row => 2,
-column => 0,
-columnspan => 3,
-sticky => 'nw');
my $pt = $left->LabEntry(-label => "PORT",
-labelPack => [-side => "left", -anchor => "w" ],
-textvariable => \$port,
-width => 10
)->pack;
my $txt = $bottom->Text(-width => 60,
-height => 25,
-wrap => 'none'
)->pack;
my $btnlstn = $bottom->Button(-text => "Listen For Client",
-anchor => 'center',
-command => \&server
)->pack;
MainLoop;
sub server {
my $sock = new IO::Socket::INET(
LocalPort => $port,
Proto => 'tcp',
Listen => SOMAXCONN,
Reuse => 1);
$sock or die "no socket :$!";
$|=1;
my($new_sock, $c_addr, $buf);
while (($new_sock, $c_addr) = $sock->accept()) {
my ($client_port, $c_ip) = sockaddr_in($c_addr);
my $client_ipnum = inet_ntoa($c_ip);
my $client_host = gethostbyaddr($c_ip, AF_INET);
print "got a connection from: $client_host","
[$client_ipnum]\n";
while (defined ($buf = <$new_sock> )) {
chomp($buf);
if ($buf=~/^FILE\|/){
my $filename = (split /\|/, $buf)[1];
unless (open (FH, "<", $filename)){
print $new_sock "NACK|File '$filename'
do not exists\n";
}
else {
while (my $line =<FH> ){
chomp($line);
print $new_sock
"FIL|".$line."\n";
#
# Remove/comment next line in
production
#
print "SENT>FIL|".$line."\n";
}
close(FH);
print $new_sock "EOT|\n";
}
last;
}
elsif ($buf=~/^QUIT\|/){
last;
}
else {
print $new_sock "NACK|Command not
understood\n";
last;
}
}
close($new_sock);
}
exit;
}
| |
| Marc Dashevsky 2006-12-19, 7:06 pm |
| In article <1166560975.053295.90140@80g2000cwy.googlegroups.com>, deadpickle@gmail.com
says...
>
> What I want to happen is that when I click the "Listen For Client"
> button I want the buttons text to change to "Stop". When you click the
> "Stop" button I want the program to stop and the button to turn back to
> "Listen For Client". I have been told that fileevent should be use to
> achieve this but I dont know how.
Following is a quickly reply to your first request. If has a chance
of working reasonably well as long the wait for input isn't too long.
use Tk;
use Tk::LabEntry;
use strict;
use IO::Socket;
my $port = '2000';
my $mainwindow = new MainWindow;
my $left = $mainwindow->Frame(
-relief => 'sunken',
)->grid(
-row => 1,
-column => 0,
-sticky => 'nw',
);
my $bottom = $mainwindow->Frame->grid(
-row => 2,
-column => 0,
-columnspan => 3,
-sticky => 'nw',
);
my $pt = $left->LabEntry(
-label => "PORT",
-labelPack => [-side => "left", -anchor => "w" ],
-textvariable => \$port,
-width => 10
)->pack;
my $txt = $bottom->Text(
-width => 60,
-height => 25,
-wrap => 'none'
)->pack;
my $btnlstn = $bottom->Button(-anchor => 'center')->pack;
SetButton(1);
MainLoop;
sub SetButton {
my %options;
if ($_[0]) {
%options = (-text => 'Listen For Client', -command => \&server);
} else {
%options = (-text => 'Stop', -command => \&XXX);
}
$btnlsts->configure(%options);
$mainwindow->update;
}
sub server {
SetButton(0);
my $sock = new IO::Socket::INET(
LocalPort => $port,
Proto => 'tcp',
Listen => SOMAXCONN,
Reuse => 1,
);
$sock or die "no socket :$!";
$| = 1;
my($new_sock, $c_addr, $buf);
while (($new_sock, $c_addr) = $sock->accept()) {
my ($client_port, $c_ip) = sockaddr_in($c_addr);
my $client_ipnum = inet_ntoa($c_ip);
my $client_host = gethostbyaddr($c_ip, AF_INET);
print "got a connection from: $client_host", "[$client_ipnum]\n";
while (defined ($buf = <$new_sock> )) {
$mainwindow->update;
chomp($buf);
if ($buf =~ /^FILE\|/) {
my $filename = (split /\|/, $buf)[1];
unless (open (FH, "<", $filename)) {
print $new_sock "NACK|File '$filename' do not exists\n";
} else {
while (my $line = <FH> ) {
$mainwindow->update;
chomp($line);
print $new_sock "FIL|".$line."\n";
print "SENT>FIL|".$line."\n";
}
close(FH);
print $new_sock "EOT|\n";
}
last;
} elsif ($buf =~ /^QUIT\|/) {
last;
} else {
print $new_sock "NACK|Command not understood\n";
last;
}
}
close($new_sock);
}
exit;
}
--
Go to http://MarcDashevsky.com to send me e-mail.
| |
| deadpickle 2006-12-19, 10:02 pm |
| THanks for the Reply.
I tried the suggestions that where made. Even though it does change the
button to Stop, it also freezes the program and does not allow me to
click Stop. It causes a critical error.
| |
| Marc Dashevsky 2006-12-19, 10:02 pm |
| In article <1166576929.137249.249750@80g2000cwy.googlegroups.com>, deadpickle@gmail.com
says...
> THanks for the Reply.
>
> I tried the suggestions that where made. Even though it does change the
> button to Stop, it also freezes the program and does not allow me to
> click Stop. It causes a critical error.
I'm embarrassed to say that I forgot to provide a routine
to match what gets set in the code:
-command => \&XXX
You'll have to make this sub and figure out what to put in it.
--
Go to http://MarcDashevsky.com to send me e-mail.
| |
| deadpickle 2006-12-21, 7:02 pm |
|
Marc Dashevsky wrote:
> In article <1166576929.137249.249750@80g2000cwy.googlegroups.com>, deadpickle@gmail.com
> says...
>
> I'm embarrassed to say that I forgot to provide a routine
> to match what gets set in the code:
>
> -command => \&XXX
>
> You'll have to make this sub and figure out what to put in it.
>
> --
> Go to http://MarcDashevsky.com to send me e-mail.
Thanks for the help. I dont quit understand the server program here and
the program seems to just stop responding if it does not get a server
right away. Is there a way to remidy this? Also, how can I get the
output from the file to display in the text box?
| |
| Marc Dashevsky 2006-12-21, 7:02 pm |
| In article <1166728152.224780.119050@79g2000cws.googlegroups.com>, deadpickle@gmail.com
says...
>
> Marc Dashevsky wrote:
>
>
> Thanks for the help. I dont quit understand the server program here and
> the program seems to just stop responding if it does not get a server
> right away. Is there a way to remidy this? Also, how can I get the
> output from the file to display in the text box?
For the latter, do something like:
$txt->insert('end', $StuffToDisplay);
$txt->update;
--
Go to http://MarcDashevsky.com to send me e-mail.
| |
| deadpickle 2007-01-06, 7:14 pm |
| That worked great.
Right now the program works ok. What I want to do now is have it so
that when I hit the button to listen for a client I want the program to
sit and listen for 10 seconds and if no client connects I want it to
close the socket. I'm not sure how to do this, any help?
| |
| Petr Vileta 2007-01-06, 7:14 pm |
| "deadpickle" <deadpickle@gmail.com> píse v diskusním príspevku
news:1167849679.323730.303020@k21g2000cwa.googlegroups.com...
> That worked great.
>
> Right now the program works ok. What I want to do now is have it so
> that when I hit the button to listen for a client I want the program to
> sit and listen for 10 seconds and if no client connects I want it to
> close the socket. I'm not sure how to do this, any help?
>
Maybe my solution is not the best but ...
sub button_pressed {
my $telnet=Net::Telnet->new();
my $in_progress=1;
# ..... some code here for normal work
$in_progress=0;
$mw->after(1000, \&kill_it($telnet, $in_progress);
}
sub kill_it {
my ($object, $running)=@_;
return unless $running;
$object->break;
$object->close;
}
--
Petr Vileta, Czech republic
(My server rejects all messages from Yahoo and Hotmail. Send me your mail
from another non-spammer site please.)
| |
| Petr Vileta 2007-01-06, 7:14 pm |
| "Petr Vileta" <stoupa@practisoft.cz> píse v diskusním príspevku
news:enhl26$1gpm$1@ns.felk.cvut.cz...
> "deadpickle" <deadpickle@gmail.com> píse v diskusním príspevku
> news:1167849679.323730.303020@k21g2000cwa.googlegroups.com...
Sorry, this code is right:
sub button_pressed {
my $telnet=Net::Telnet->new();
my $in_progress=1;
$mw->after(1000, \&kill_it($telnet, $in_progress);
# ..... some code here for normal work
$in_progress=0;
}
sub kill_it {
my ($object, $running)=@_;
return unless $running;
$object->break;
$object->close;
}
--
Petr Vileta, Czech republic
(My server rejects all messages from Yahoo and Hotmail. Send me your mail
from another non-spammer site please.)
|
|
|
|
|