2005-07-11 21:11:11 +02:00
|
|
|
# $Id: Client.pm,v 1.8 2005/02/14 22:06:38 msergeant Exp $
|
|
|
|
|
|
|
|
package Danga::Client;
|
|
|
|
use base 'Danga::TimeoutSocket';
|
2007-02-03 00:47:26 +01:00
|
|
|
use fields qw(line pause_count read_bytes data_bytes callback get_chunks);
|
2005-07-11 21:11:11 +02:00
|
|
|
use Time::HiRes ();
|
|
|
|
|
2007-02-03 00:47:26 +01:00
|
|
|
use bytes;
|
|
|
|
|
2005-07-11 21:11:11 +02:00
|
|
|
# 30 seconds max timeout!
|
|
|
|
sub max_idle_time { 30 }
|
|
|
|
sub max_connect_time { 1200 }
|
|
|
|
|
|
|
|
sub new {
|
|
|
|
my Danga::Client $self = shift;
|
|
|
|
$self = fields::new($self) unless ref $self;
|
|
|
|
$self->SUPER::new( @_ );
|
|
|
|
|
|
|
|
$self->reset_for_next_message;
|
|
|
|
return $self;
|
|
|
|
}
|
|
|
|
|
|
|
|
sub reset_for_next_message {
|
|
|
|
my Danga::Client $self = shift;
|
|
|
|
$self->{line} = '';
|
2006-06-20 15:51:32 +02:00
|
|
|
$self->{pause_count} = 0;
|
2007-02-03 00:47:26 +01:00
|
|
|
$self->{read_bytes} = 0;
|
|
|
|
$self->{callback} = undef;
|
|
|
|
$self->{data_bytes} = '';
|
|
|
|
$self->{get_chunks} = 0;
|
2005-07-11 21:11:11 +02:00
|
|
|
return $self;
|
|
|
|
}
|
|
|
|
|
2007-02-03 00:47:26 +01:00
|
|
|
sub get_bytes {
|
|
|
|
my Danga::Client $self = shift;
|
|
|
|
my ($bytes, $callback) = @_;
|
|
|
|
if ($self->{callback}) {
|
|
|
|
die "get_bytes/get_chunks currently in progress!";
|
|
|
|
}
|
|
|
|
$self->{read_bytes} = $bytes;
|
|
|
|
$self->{data_bytes} = $self->{line};
|
|
|
|
$self->{read_bytes} -= length($self->{data_bytes});
|
|
|
|
$self->{line} = '';
|
|
|
|
if ($self->{read_bytes} <= 0) {
|
|
|
|
if ($self->{read_bytes} < 0) {
|
|
|
|
$self->{line} = substr($self->{data_bytes},
|
|
|
|
$self->{read_bytes}, # negative offset
|
|
|
|
0 - $self->{read_bytes}, # to end of str
|
|
|
|
""); # truncate that substr
|
|
|
|
}
|
|
|
|
$callback->($self->{data_bytes});
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
$self->{callback} = $callback;
|
|
|
|
}
|
|
|
|
|
|
|
|
sub get_chunks {
|
|
|
|
my Danga::Client $self = shift;
|
|
|
|
my ($bytes, $callback) = @_;
|
|
|
|
if ($self->{callback}) {
|
|
|
|
die "get_bytes/get_chunks currently in progress!";
|
|
|
|
}
|
|
|
|
$self->{read_bytes} = $bytes;
|
|
|
|
$callback->($self->{line}) if length($self->{line});
|
|
|
|
$self->{line} = '';
|
|
|
|
$self->{callback} = $callback;
|
|
|
|
$self->{get_chunks} = 1;
|
|
|
|
}
|
|
|
|
|
|
|
|
sub end_get_chunks {
|
|
|
|
my Danga::Client $self = shift;
|
|
|
|
my $remaining = shift;
|
|
|
|
$self->{callback} = undef;
|
|
|
|
$self->{get_chunks} = 0;
|
|
|
|
if (defined($remaining)) {
|
|
|
|
$self->process_read_buf(\$remaining);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2005-07-11 21:11:11 +02:00
|
|
|
sub event_read {
|
|
|
|
my Danga::Client $self = shift;
|
2007-02-03 00:47:26 +01:00
|
|
|
if ($self->{callback}) {
|
|
|
|
$self->{alive_time} = time;
|
|
|
|
if ($self->{get_chunks}) {
|
|
|
|
my $bref = $self->read($self->{read_bytes});
|
|
|
|
return $self->close($!) unless defined $bref;
|
|
|
|
$self->{callback}->($$bref) if length($$bref);
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
if ($self->{read_bytes} > 0) {
|
|
|
|
my $bref = $self->read($self->{read_bytes});
|
|
|
|
return $self->close($!) unless defined $bref;
|
|
|
|
$self->{read_bytes} -= length($$bref);
|
|
|
|
$self->{data_bytes} .= $$bref;
|
|
|
|
}
|
|
|
|
if ($self->{read_bytes} <= 0) {
|
|
|
|
# print "Erk, read too much!\n" if $self->{read_bytes} < 0;
|
|
|
|
my $cb = $self->{callback};
|
|
|
|
$self->{callback} = undef;
|
|
|
|
$cb->($self->{data_bytes});
|
|
|
|
}
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
my $bref = $self->read(8192);
|
|
|
|
return $self->close($!) unless defined $bref;
|
|
|
|
$self->process_read_buf($bref);
|
|
|
|
}
|
2005-07-11 21:11:11 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
sub process_read_buf {
|
|
|
|
my Danga::Client $self = shift;
|
|
|
|
my $bref = shift;
|
|
|
|
$self->{line} .= $$bref;
|
2007-02-03 00:47:26 +01:00
|
|
|
return if $self->{pause_count} || $self->{closed};
|
2005-07-11 21:11:11 +02:00
|
|
|
|
|
|
|
while ($self->{line} =~ s/^(.*?\n)//) {
|
|
|
|
my $line = $1;
|
|
|
|
$self->{alive_time} = time;
|
|
|
|
my $resp = $self->process_line($line);
|
|
|
|
if ($::DEBUG > 1 and $resp) { print "$$:".($self+0)."S: $_\n" for split(/\n/, $resp) }
|
|
|
|
$self->write($resp) if $resp;
|
2006-06-20 15:51:32 +02:00
|
|
|
# $self->watch_read(0) if $self->{pause_count};
|
2007-02-03 00:47:26 +01:00
|
|
|
return if $self->{pause_count} || $self->{closed};
|
2005-07-11 21:11:11 +02:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2006-06-20 15:51:32 +02:00
|
|
|
sub has_data {
|
|
|
|
my Danga::Client $self = shift;
|
|
|
|
return length($self->{line}) ? 1 : 0;
|
|
|
|
}
|
|
|
|
|
|
|
|
sub clear_data {
|
2005-07-11 21:11:11 +02:00
|
|
|
my Danga::Client $self = shift;
|
2006-06-20 15:51:32 +02:00
|
|
|
$self->{line} = '';
|
|
|
|
}
|
|
|
|
|
|
|
|
sub paused {
|
|
|
|
my Danga::Client $self = shift;
|
|
|
|
return 1 if $self->{pause_count};
|
|
|
|
return 1 if $self->{closed};
|
|
|
|
return 0;
|
2005-07-11 21:11:11 +02:00
|
|
|
}
|
|
|
|
|
2006-06-20 15:51:32 +02:00
|
|
|
sub pause_read {
|
2005-07-11 21:11:11 +02:00
|
|
|
my Danga::Client $self = shift;
|
2006-06-20 15:51:32 +02:00
|
|
|
$self->{pause_count}++;
|
|
|
|
# $self->watch_read(0);
|
2005-07-11 21:11:11 +02:00
|
|
|
}
|
|
|
|
|
2006-06-20 15:51:32 +02:00
|
|
|
sub continue_read {
|
2005-07-11 21:11:11 +02:00
|
|
|
my Danga::Client $self = shift;
|
2006-06-20 15:51:32 +02:00
|
|
|
$self->{pause_count}--;
|
|
|
|
if ($self->{pause_count} <= 0) {
|
|
|
|
$self->{pause_count} = 0;
|
|
|
|
# $self->watch_read(1);
|
2005-07-11 21:11:11 +02:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
sub process_line {
|
|
|
|
my Danga::Client $self = shift;
|
|
|
|
return '';
|
|
|
|
}
|
|
|
|
|
|
|
|
sub close {
|
|
|
|
my Danga::Client $self = shift;
|
|
|
|
print "closing @_\n" if $::DEBUG;
|
|
|
|
$self->SUPER::close(@_);
|
|
|
|
}
|
|
|
|
|
|
|
|
sub event_err { my Danga::Client $self = shift; $self->close("Error") }
|
|
|
|
sub event_hup { my Danga::Client $self = shift; $self->close("Disconnect (HUP)") }
|
|
|
|
|
|
|
|
1;
|