2012-06-22 11:38:01 +02:00
|
|
|
# $Id: Client.pm,v 1.8 2005/02/14 22:06:38 msergeant Exp $
|
|
|
|
|
|
|
|
package Danga::Client;
|
|
|
|
use base 'Danga::TimeoutSocket';
|
|
|
|
use fields qw(
|
2013-04-21 06:08:43 +02:00
|
|
|
line
|
|
|
|
pause_count
|
|
|
|
read_bytes
|
|
|
|
data_bytes
|
|
|
|
callback
|
|
|
|
get_chunks
|
|
|
|
reader_object
|
|
|
|
);
|
2012-06-22 11:38:01 +02:00
|
|
|
use Time::HiRes ();
|
|
|
|
|
|
|
|
use bytes;
|
|
|
|
|
|
|
|
# 30 seconds max timeout!
|
2013-04-21 06:08:43 +02:00
|
|
|
sub max_idle_time { 30 }
|
|
|
|
sub max_connect_time { 1200 }
|
2012-06-22 11:38:01 +02:00
|
|
|
|
|
|
|
sub new {
|
|
|
|
my Danga::Client $self = shift;
|
|
|
|
$self = fields::new($self) unless ref $self;
|
2013-04-21 06:08:43 +02:00
|
|
|
$self->SUPER::new(@_);
|
2012-06-22 11:38:01 +02:00
|
|
|
|
|
|
|
$self->reset_for_next_message;
|
|
|
|
return $self;
|
|
|
|
}
|
|
|
|
|
|
|
|
sub reset_for_next_message {
|
|
|
|
my Danga::Client $self = shift;
|
2013-04-21 06:08:43 +02:00
|
|
|
$self->{line} = '';
|
|
|
|
$self->{pause_count} = 0;
|
|
|
|
$self->{read_bytes} = 0;
|
|
|
|
$self->{callback} = undef;
|
2012-06-22 11:38:01 +02:00
|
|
|
$self->{reader_object} = undef;
|
2013-04-21 06:08:43 +02:00
|
|
|
$self->{data_bytes} = '';
|
|
|
|
$self->{get_chunks} = 0;
|
2012-06-22 11:38:01 +02:00
|
|
|
return $self;
|
|
|
|
}
|
|
|
|
|
|
|
|
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) {
|
2013-04-21 06:08:43 +02:00
|
|
|
$self->{line} = substr(
|
|
|
|
$self->{data_bytes},
|
|
|
|
$self->{read_bytes}, # negative offset
|
|
|
|
0 - $self->{read_bytes}, # to end of str
|
|
|
|
""
|
|
|
|
); # truncate that substr
|
2012-06-22 11:38:01 +02:00
|
|
|
}
|
|
|
|
$callback->($self->{data_bytes});
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
$self->{callback} = $callback;
|
|
|
|
}
|
|
|
|
|
|
|
|
sub process_chunk {
|
|
|
|
my Danga::Client $self = shift;
|
|
|
|
my $callback = shift;
|
|
|
|
|
|
|
|
my $last_crlf = rindex($self->{line}, "\r\n");
|
|
|
|
|
|
|
|
if ($last_crlf != -1) {
|
|
|
|
if ($last_crlf + 2 == length($self->{line})) {
|
|
|
|
my $data = $self->{line};
|
|
|
|
$self->{line} = '';
|
|
|
|
$callback->($data);
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
my $data = substr($self->{line}, 0, $last_crlf + 2);
|
|
|
|
$self->{line} = substr($self->{line}, $last_crlf + 2);
|
|
|
|
$callback->($data);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
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;
|
|
|
|
$self->process_chunk($callback) if length($self->{line});
|
2013-04-21 06:08:43 +02:00
|
|
|
$self->{callback} = $callback;
|
2012-06-22 11:38:01 +02:00
|
|
|
$self->{get_chunks} = 1;
|
|
|
|
}
|
|
|
|
|
|
|
|
sub end_get_chunks {
|
|
|
|
my Danga::Client $self = shift;
|
|
|
|
my $remaining = shift;
|
2013-04-21 06:08:43 +02:00
|
|
|
$self->{callback} = undef;
|
2012-06-22 11:38:01 +02:00
|
|
|
$self->{get_chunks} = 0;
|
|
|
|
if (defined($remaining)) {
|
|
|
|
$self->process_read_buf(\$remaining);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
sub set_reader_object {
|
|
|
|
my Danga::Client $self = shift;
|
|
|
|
$self->{reader_object} = shift;
|
|
|
|
}
|
|
|
|
|
|
|
|
sub event_read {
|
|
|
|
my Danga::Client $self = shift;
|
|
|
|
if (my $obj = $self->{reader_object}) {
|
|
|
|
$self->{reader_object} = undef;
|
|
|
|
$obj->event_read($self);
|
|
|
|
}
|
|
|
|
elsif ($self->{callback}) {
|
|
|
|
$self->{alive_time} = time;
|
|
|
|
if ($self->{get_chunks}) {
|
|
|
|
my $bref = $self->read($self->{read_bytes});
|
|
|
|
return $self->close($!) unless defined $bref;
|
|
|
|
$self->{line} .= $$bref;
|
|
|
|
$self->process_chunk($self->{callback}) if length($self->{line});
|
|
|
|
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) {
|
2013-04-21 06:08:43 +02:00
|
|
|
|
2012-06-22 11:38:01 +02:00
|
|
|
# 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);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
sub process_read_buf {
|
|
|
|
my Danga::Client $self = shift;
|
|
|
|
my $bref = shift;
|
|
|
|
$self->{line} .= $$bref;
|
|
|
|
return if $self->{pause_count} || $self->{closed};
|
2013-04-21 06:08:43 +02:00
|
|
|
|
2012-06-22 11:38:01 +02:00
|
|
|
if ($self->{line} =~ s/^(.*?\n)//) {
|
|
|
|
my $line = $1;
|
|
|
|
$self->{alive_time} = time;
|
|
|
|
my $resp = $self->process_line($line);
|
2013-04-21 06:08:43 +02:00
|
|
|
if ($::DEBUG > 1 and $resp) {
|
|
|
|
print "$$:" . ($self + 0) . "S: $_\n" for split(/\n/, $resp);
|
|
|
|
}
|
2012-06-22 11:38:01 +02:00
|
|
|
$self->write($resp) if $resp;
|
2013-04-21 06:08:43 +02:00
|
|
|
|
2012-06-22 11:38:01 +02:00
|
|
|
# $self->watch_read(0) if $self->{pause_count};
|
|
|
|
return if $self->{pause_count} || $self->{closed};
|
2013-04-21 06:08:43 +02:00
|
|
|
|
2012-06-22 11:38:01 +02:00
|
|
|
# read more in a timer, to give other clients a look in
|
2013-04-21 06:08:43 +02:00
|
|
|
$self->AddTimer(
|
|
|
|
0,
|
|
|
|
sub {
|
|
|
|
if (length($self->{line}) && !$self->paused) {
|
|
|
|
$self->process_read_buf(\"")
|
|
|
|
; # " for bad syntax highlighters
|
|
|
|
}
|
2012-06-22 11:38:01 +02:00
|
|
|
}
|
2013-04-21 06:08:43 +02:00
|
|
|
);
|
2012-06-22 11:38:01 +02:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
sub has_data {
|
|
|
|
my Danga::Client $self = shift;
|
|
|
|
return length($self->{line}) ? 1 : 0;
|
|
|
|
}
|
|
|
|
|
|
|
|
sub clear_data {
|
|
|
|
my Danga::Client $self = shift;
|
|
|
|
$self->{line} = '';
|
|
|
|
}
|
|
|
|
|
|
|
|
sub paused {
|
|
|
|
my Danga::Client $self = shift;
|
|
|
|
return 1 if $self->{pause_count};
|
|
|
|
return 1 if $self->{closed};
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
|
|
|
|
sub pause_read {
|
|
|
|
my Danga::Client $self = shift;
|
|
|
|
$self->{pause_count}++;
|
2013-04-21 06:08:43 +02:00
|
|
|
|
2012-06-22 11:38:01 +02:00
|
|
|
# $self->watch_read(0);
|
|
|
|
}
|
|
|
|
|
|
|
|
sub continue_read {
|
|
|
|
my Danga::Client $self = shift;
|
|
|
|
$self->{pause_count}--;
|
|
|
|
if ($self->{pause_count} <= 0) {
|
|
|
|
$self->{pause_count} = 0;
|
2013-04-21 06:08:43 +02:00
|
|
|
$self->AddTimer(
|
|
|
|
0,
|
|
|
|
sub {
|
|
|
|
if (length($self->{line}) && !$self->paused) {
|
|
|
|
$self->process_read_buf(\"")
|
|
|
|
; # " for bad syntax highlighters
|
|
|
|
}
|
2012-06-22 11:38:01 +02:00
|
|
|
}
|
2013-04-21 06:08:43 +02:00
|
|
|
);
|
2012-06-22 11:38:01 +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") }
|
2013-04-21 06:08:43 +02:00
|
|
|
|
|
|
|
sub event_hup {
|
|
|
|
my Danga::Client $self = shift;
|
|
|
|
$self->close("Disconnect (HUP)");
|
|
|
|
}
|
2012-06-22 11:38:01 +02:00
|
|
|
|
|
|
|
1;
|