Mercurial > hg > nginx-tests

comparison lib/Test/Nginx/POP3.pm @ 1678:d0025a0dead7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Tests: better timeout handling in mail tests. The eval + alarm model used previously does not work on Windows (see perlport(1) for alarm), so it was replaced with non-blocking I/O.
author Maxim Dounin <mdounin@mdounin.ru>
date Wed, 19 May 2021 04:32:57 +0300
parents 29d0961bc3f7
children 3629eda94c1b
comparison
equal deleted inserted replaced
1677:f13ead27f89c 1678:d0025a0dead7
32 IO::Socket::SSL->start_SSL($self->{_socket}, @_) 32 IO::Socket::SSL->start_SSL($self->{_socket}, @_)
33 or die $IO::Socket::SSL::SSL_ERROR . "\n"; 33 or die $IO::Socket::SSL::SSL_ERROR . "\n";
34 } 34 }
35 35
36 $self->{_socket}->autoflush(1); 36 $self->{_socket}->autoflush(1);
37 $self->{_read_buffer} = '';
37 38
38 return $self; 39 return $self;
39 } 40 }
40 41
41 sub eof { 42 sub eof {
53 my ($self, $cmd) = @_; 54 my ($self, $cmd) = @_;
54 log_out($cmd); 55 log_out($cmd);
55 $self->{_socket}->print($cmd . CRLF); 56 $self->{_socket}->print($cmd . CRLF);
56 } 57 }
57 58
59 sub getline {
60 my ($self) = @_;
61 my $socket = $self->{_socket};
62
63 if ($self->{_read_buffer} =~ /^(.*?\x0a)(.*)/ms) {
64 $self->{_read_buffer} = $2;
65 return $1;
66 }
67
68 while (IO::Select->new($socket)->can_read(8)) {
69 $socket->blocking(0);
70 my $n = $socket->sysread(my $buf, 1024);
71 $socket->blocking(1);
72 last unless $n;
73
74 $self->{_read_buffer} .= $buf;
75
76 if ($self->{_read_buffer} =~ /^(.*?\x0a)(.*)/ms) {
77 $self->{_read_buffer} = $2;
78 return $1;
79 }
80 };
81 }
82
58 sub read { 83 sub read {
59 my ($self) = @_; 84 my ($self) = @_;
60 my $socket = $self->{_socket}; 85 my $socket = $self->{_socket};
61 eval { 86
62 local $SIG{ALRM} = sub { die "timeout\n" }; 87 while (defined($_ = $self->getline())) {
63 alarm(8); 88 log_in($_);
64 while (<$socket>) { 89 last;
65 log_in($_);
66 # XXX
67 next if m/^\d\d\d-/;
68 last;
69 }
70 alarm(0);
71 };
72 alarm(0);
73 if ($@) {
74 log_in("died: $@");
75 return undef;
76 } 90 }
91
77 return $_; 92 return $_;
78 } 93 }
79 94
80 sub check { 95 sub check {
81 my ($self, $regex, $name) = @_; 96 my ($self, $regex, $name) = @_;