Paolo Molaro wrote:
Gtk::io works this way: you create your usual socket, say IO::Socket::INET,
and re-bless the reference to the proper Gtk::io::* package:
my $socket = IO::Socket::INET->new (...);
bless $socket, 'Gtk::io::INET';
It doesn´t nessesarily have to work that way. my $socket = new Gtk::io::INET(); Does the same thing as the above and, in my opinion, explicitly reblessing objects ought to be discouraged.
Now, look at @Gtk::io::INET::ISA : @ISA = qw(Gtk::io IO::Socket::INET);
Either use and change the current $timeout scalar (ignoring the IO::Socket one) or refactor the sweeper func to access the timeout from IO::Socket. The first option is the easy one, though not a complete solution.
Here´s a patch that implements a per socket timeout when the socket inherits from IO::Socket and uses the global timeout value when it does not. Note that, at least on my machine, the default value of $sock->timeout is undefined, so Gtk::io sets it to the global value anyway. Jim Also attached is a simple test program...
Index: io.pm
===================================================================
RCS file: /cvs/gnome/gnome-perl/Gtk/io.pm,v
retrieving revision 1.1
diff -u -r1.1 io.pm
--- io.pm 2001/01/07 18:19:30 1.1
+++ io.pm 2001/07/16 18:07:40
@@ -1,8 +1,9 @@
package Gtk::io;
+use strict;
my %pending = ();
my $sweepid;
-my $timeout = 2;
+use constant Timeout=>2;
sub get_pending {
my $fd = shift;
@@ -19,8 +20,8 @@
my ($k, $v);
while ( ($k, $v) = each %pending) {
next unless ref $v;
- if ($now - $v->[1] > $timeout) {
- warn "Timeout on $k\n";
+ if ($now - $v->[1] > $v->[2]) {
+ warn "Timeout on $k after $v->[2] seconds\n";
Gtk::Gdk->input_remove($v->[0]);
$pending{$k} = undef;
}
@@ -29,8 +30,8 @@
});
}
-sub _wait_for_condition ($$) {
- my ($fd, $cond) = @_;
+sub _wait_for_condition ($$$) {
+ my ($fd, $cond, $timeout) = @_;
my $id;
warn "Already scheduled a $cond on fd $fd\n" if exists $pending{$cond.$fd};
_sweeper() unless $sweepid;
@@ -40,7 +41,7 @@
$pending{$cond.$fd} = 0;
Gtk::Gdk->input_remove($id);
});
- $pending{$cond.$fd} = [$id, time];
+ $pending{$cond.$fd} = [$id, time, $timeout];
Gtk->main_iteration while ($pending{$cond.$fd} || Gtk->events_pending);
return $cond.$fd;
}
@@ -53,9 +54,17 @@
my $fd = $_[0]->fileno();
my $bits = '';
vec($bits, $fd, 1) = 1;
+ my $timeout;
+ if($_[0]->isa('IO::Socket')){
+ $timeout = $_[0]->timeout();
+ }
+ $timeout = Timeout unless(defined $timeout);
+
# short circuit it
+
+
unless (select($bits, undef, undef, 0)) {
- $doit = defined(delete $pending{_wait_for_condition($fd, 'read')})?1:0;
+ $doit = defined(delete $pending{_wait_for_condition($fd, 'read', $timeout)})?1:0;
} else {
$doit++;
}
@@ -72,9 +81,16 @@
my $fd = $_[0]->fileno();
my $bits = '';
vec($bits, $fd, 1) = 1;
+
+ my $timeout;
+ if($_[0]->isa('IO::Socket')){
+ $timeout = $_[0]->timeout();
+ }
+ $timeout = Timeout unless(defined $timeout);
+
# short circuit it
unless (select(undef, $bits, undef, 0)) {
- $doit = defined(delete $pending{_wait_for_condition($fd, 'write')})?1:0;
+ $doit = defined(delete $pending{_wait_for_condition($fd, 'write', $timeout)})?1:0;
} else {
$doit++;
}
@@ -83,10 +99,18 @@
}
package Gtk::io::INET;
+use IO::Socket::INET;
+use vars qw(@ISA);
@ISA = qw(Gtk::io IO::Socket::INET);
+
package Gtk::io::UNIX;
+use IO::Socket::UNIX;
+use vars qw(@ISA);
@ISA = qw(Gtk::io IO::Socket::UNIX);
+
package Gtk::io::Pipe;
+use IO::Pipe;
+use vars qw(@ISA);
@ISA = qw(Gtk::io IO::Pipe);
1;
Attachment:
timetest.pl
Description: Perl program