diff options
Diffstat (limited to 'lib/PublicInbox')
| -rw-r--r-- | lib/PublicInbox/DS.pm | 235 | ||||
| -rw-r--r-- | lib/PublicInbox/EvCleanup.pm | 8 | ||||
| -rw-r--r-- | lib/PublicInbox/HTTP.pm | 11 | ||||
| -rw-r--r-- | lib/PublicInbox/HTTPD/Async.pm | 4 | ||||
| -rw-r--r-- | lib/PublicInbox/NNTP.pm | 44 | ||||
| -rw-r--r-- | lib/PublicInbox/SearchView.pm | 59 |
6 files changed, 136 insertions, 225 deletions
diff --git a/lib/PublicInbox/DS.pm b/lib/PublicInbox/DS.pm index 03612ce8..2f028a36 100644 --- a/lib/PublicInbox/DS.pm +++ b/lib/PublicInbox/DS.pm @@ -26,16 +26,13 @@ use warnings; use PublicInbox::Syscall qw(:epoll); use fields ('sock', # underlying socket - 'fd', # numeric file descriptor - 'write_buf', # arrayref of scalars, scalarrefs, or coderefs to write - 'write_buf_offset', # offset into first array of write_buf to start writing at - 'write_buf_size', # total length of data in all write_buf items + 'wbuf', # arrayref of scalars, scalarrefs, or coderefs to write + 'wbuf_off', # offset into first element of wbuf to start writing at 'closed', # bool: socket is closed 'event_watch', # bitmask of events the client is interested in (POLLIN,OUT,etc.) ); -use Errno qw(EINPROGRESS EWOULDBLOCK EISCONN ENOTSOCK - EPIPE EAGAIN EBADF ECONNRESET ENOPROTOOPT); +use Errno qw(EAGAIN EINVAL); use Carp qw(croak confess); use constant DebugLevel => 0; @@ -242,6 +239,21 @@ sub RunTimers { return $timeout; } +sub event_step ($) { + my ($self) = @_; + return if $self->{closed}; + + my $wbuf = $self->{wbuf}; + if (@$wbuf) { + $self->event_write; + return if $self->{closed} || scalar(@$wbuf); + } + + # only read more requests if we've drained the write buffer, + # otherwise we can be buffering infinitely w/o backpressure + $self->event_read; +} + ### The epoll-based event loop. Gets installed as EventLoop if IO::Epoll loads ### okay. sub EpollEventLoop { @@ -261,20 +273,7 @@ sub EpollEventLoop { # that ones in the front triggered unregister-interest actions. if we # can't find the %sock entry, it's because we're no longer interested # in that event. - my PublicInbox::DS $pob = $DescriptorMap{$ev->[0]}; - my $code; - my $state = $ev->[1]; - - DebugLevel >= 1 && $class->DebugMsg("Event: fd=%d (%s), state=%d \@ %s\n", - $ev->[0], ref($pob), $ev->[1], time); - - # standard non-profiling codepat - $pob->event_read if $state & EPOLLIN && ! $pob->{closed}; - $pob->event_write if $state & EPOLLOUT && ! $pob->{closed}; - if ($state & (EPOLLERR|EPOLLHUP)) { - $pob->event_err if $state & EPOLLERR && ! $pob->{closed}; - $pob->event_hup if $state & EPOLLHUP && ! $pob->{closed}; - } + event_step($DescriptorMap{$ev->[0]}); } return unless PostEventLoop(); } @@ -319,12 +318,7 @@ sub PollEventLoop { my ($fd, $state) = splice(@poll, 0, 2); next unless $state; - $pob = $DescriptorMap{$fd}; - - $pob->event_read if $state & POLLIN && ! $pob->{closed}; - $pob->event_write if $state & POLLOUT && ! $pob->{closed}; - $pob->event_err if $state & POLLERR && ! $pob->{closed}; - $pob->event_hup if $state & POLLHUP && ! $pob->{closed}; + event_step($DescriptorMap{$fd}); } return unless PostEventLoop(); @@ -352,20 +346,7 @@ sub KQueueEventLoop { foreach my $kev (@ret) { my ($fd, $filter, $flags, $fflags) = @$kev; - my PublicInbox::DS $pob = $DescriptorMap{$fd}; - - DebugLevel >= 1 && $class->DebugMsg("Event: fd=%d (%s), flags=%d \@ %s\n", - $fd, ref($pob), $flags, time); - - $pob->event_read if $filter == IO::KQueue::EVFILT_READ() && !$pob->{closed}; - $pob->event_write if $filter == IO::KQueue::EVFILT_WRITE() && !$pob->{closed}; - if ($flags == IO::KQueue::EV_EOF() && !$pob->{closed}) { - if ($fflags) { - $pob->event_err; - } else { - $pob->event_hup; - } - } + event_step($DescriptorMap{$fd}); } return unless PostEventLoop(); } @@ -442,16 +423,14 @@ sub new { my ($self, $sock, $exclusive) = @_; $self = fields::new($self) unless ref $self; - $self->{sock} = $sock; + $self->{sock} = $sock; my $fd = fileno($sock); Carp::cluck("undef sock and/or fd in PublicInbox::DS->new. sock=" . ($sock || "") . ", fd=" . ($fd || "")) unless $sock && $fd; - $self->{fd} = $fd; - $self->{write_buf} = []; - $self->{write_buf_offset} = 0; - $self->{write_buf_size} = 0; + $self->{wbuf} = []; + $self->{wbuf_off} = 0; $self->{closed} = 0; my $ev = $self->{event_watch} = POLLERR|POLLHUP|POLLNVAL; @@ -464,7 +443,7 @@ sub new { } retry: if (epoll_ctl($Epoll, EPOLL_CTL_ADD, $fd, $ev)) { - if ($!{EINVAL} && ($ev & $EPOLLEXCLUSIVE)) { + if ($! == EINVAL && ($ev & $EPOLLEXCLUSIVE)) { $EPOLLEXCLUSIVE = 0; # old kernel $ev = $self->{event_watch} = EPOLLIN|EPOLLERR|EPOLLHUP; goto retry; @@ -492,50 +471,22 @@ retry: ### I N S T A N C E M E T H O D S ##################################################################### -=head2 C<< $obj->steal_socket() >> +=head2 C<< $obj->close >> -Basically returns our socket and makes it so that we don't try to close it, -but we do remove it from epoll handlers. THIS CLOSES $self. It is the same -thing as calling close, except it gives you the socket to use. - -=cut -sub steal_socket { - my PublicInbox::DS $self = $_[0]; - return if $self->{closed}; - - # cleanup does most of the work of closing this socket - $self->_cleanup(); - - # now undef our internal sock and fd structures so we don't use them - my $sock = $self->{sock}; - $self->{sock} = undef; - return $sock; -} - -=head2 C<< $obj->close( [$reason] ) >> - -Close the socket. The I<reason> argument will be used in debugging messages. +Close the socket. =cut sub close { my PublicInbox::DS $self = $_[0]; return if $self->{closed}; - # print out debugging info for this close - if (DebugLevel) { - my ($pkg, $filename, $line) = caller; - my $reason = $_[1] || ""; - warn "Closing \#$self->{fd} due to $pkg/$filename/$line ($reason)\n"; - } - # this does most of the work of closing us $self->_cleanup(); # defer closing the actual socket until the event loop is done # processing this round of events. (otherwise we might reuse fds) - if ($self->{sock}) { - push @ToClose, $self->{sock}; - $self->{sock} = undef; + if (my $sock = delete $self->{sock}) { + push @ToClose, $sock; } return 0; @@ -552,15 +503,14 @@ sub _cleanup { # we need to flush our write buffer, as there may # be self-referential closures (sub { $client->close }) # preventing the object from being destroyed - $self->{write_buf} = []; + @{$self->{wbuf}} = (); # if we're using epoll, we have to remove this from our epoll fd so we stop getting # notifications about it - if ($HaveEpoll && $self->{fd}) { - if (epoll_ctl($Epoll, EPOLL_CTL_DEL, $self->{fd}, $self->{event_watch}) != 0) { - # dump_error prints a backtrace so we can try to figure out why this happened - $self->dump_error("epoll_ctl(): failure deleting fd=$self->{fd} during _cleanup(); $! (" . ($!+0) . ")"); - } + if ($HaveEpoll && $self->{sock}) { + my $fd = fileno($self->{sock}); + epoll_ctl($Epoll, EPOLL_CTL_DEL, $fd, $self->{event_watch}) and + confess("EPOLL_CTL_DEL: $!"); } # we explicitly don't delete from DescriptorMap here until we @@ -571,9 +521,6 @@ sub _cleanup { # looked at $pob->{closed} and ignore it. but if it's an # un-accounted for fd, then it (understandably) freak out a bit # and emit warnings, thinking their state got off. - - # and finally get rid of our fd so we can't use it anywhere else - $self->{fd} = undef; } =head2 C<< $obj->sock() >> @@ -612,12 +559,12 @@ sub write { # just queue data if there's already a wait my $need_queue; + my $wbuf = $self->{wbuf}; if (defined $data) { $bref = ref $data ? $data : \$data; - if ($self->{write_buf_size}) { - push @{$self->{write_buf}}, $bref; - $self->{write_buf_size} += ref $bref eq "SCALAR" ? length($$bref) : 1; + if (scalar @$wbuf) { + push @$wbuf, $bref; return 0; } @@ -629,7 +576,7 @@ sub write { WRITE: while (1) { - return 1 unless $bref ||= $self->{write_buf}[0]; + return 1 unless $bref ||= $wbuf->[0]; my $len; eval { @@ -638,8 +585,7 @@ sub write { if ($@) { if (UNIVERSAL::isa($bref, "CODE")) { unless ($need_queue) { - $self->{write_buf_size}--; # code refs are worth 1 - shift @{$self->{write_buf}}; + shift @$wbuf; } $bref->(); @@ -654,46 +600,33 @@ sub write { die "Write error: $@ <$bref>"; } - my $to_write = $len - $self->{write_buf_offset}; + my $to_write = $len - $self->{wbuf_off}; my $written = syswrite($self->{sock}, $$bref, $to_write, - $self->{write_buf_offset}); + $self->{wbuf_off}); if (! defined $written) { - if ($! == EPIPE) { - return $self->close("EPIPE"); - } elsif ($! == EAGAIN) { + if ($! == EAGAIN) { # since connection has stuff to write, it should now be # interested in pending writes: if ($need_queue) { - push @{$self->{write_buf}}, $bref; - $self->{write_buf_size} += $len; + push @$wbuf, $bref; } $self->watch_write(1); return 0; - } elsif ($! == ECONNRESET) { - return $self->close("ECONNRESET"); } - DebugLevel >= 1 && $self->debugmsg("Closing connection ($self) due to write error: $!\n"); - - return $self->close("write_error"); + return $self->close; } elsif ($written != $to_write) { - DebugLevel >= 2 && $self->debugmsg("Wrote PARTIAL %d bytes to %d", - $written, $self->{fd}); if ($need_queue) { - push @{$self->{write_buf}}, $bref; - $self->{write_buf_size} += $len; + push @$wbuf, $bref; } # since connection has stuff to write, it should now be # interested in pending writes: - $self->{write_buf_offset} += $written; - $self->{write_buf_size} -= $written; + $self->{wbuf_off} += $written; $self->on_incomplete_write; return 0; } elsif ($written == $to_write) { - DebugLevel >= 2 && $self->debugmsg("Wrote ALL %d bytes to %d (nq=%d)", - $written, $self->{fd}, $need_queue); - $self->{write_buf_offset} = 0; + $self->{wbuf_off} = 0; $self->watch_write(0); # this was our only write, so we can return immediately @@ -702,8 +635,7 @@ sub write { # can't be anything else to write. return 1 if $need_queue; - $self->{write_buf_size} -= $written; - shift @{$self->{write_buf}}; + shift @$wbuf; undef $bref; next WRITE; } @@ -715,63 +647,14 @@ sub on_incomplete_write { $self->watch_write(1); } -=head2 C<< $obj->read( $bytecount ) >> - -Read at most I<bytecount> bytes from the underlying handle; returns scalar -ref on read, or undef on connection closed. - -=cut -sub read { - my PublicInbox::DS $self = shift; - return if $self->{closed}; - my $bytes = shift; - my $buf; - my $sock = $self->{sock}; - - # if this is too high, perl quits(!!). reports on mailing lists - # don't seem to point to a universal answer. 5MB worked for some, - # crashed for others. 1MB works for more people. let's go with 1MB - # for now. :/ - my $req_bytes = $bytes > 1048576 ? 1048576 : $bytes; - - my $res = sysread($sock, $buf, $req_bytes, 0); - DebugLevel >= 2 && $self->debugmsg("sysread = %d; \$! = %d", $res, $!); - - if (! $res && $! != EWOULDBLOCK) { - # catches 0=conn closed or undef=error - DebugLevel >= 2 && $self->debugmsg("Fd \#%d read hit the end of the road.", $self->{fd}); - return undef; - } - - return \$buf; -} - =head2 (VIRTUAL) C<< $obj->event_read() >> Readable event handler. Concrete deriviatives of PublicInbox::DS should -provide an implementation of this. The default implementation will die if -called. - -=cut -sub event_read { die "Base class event_read called for $_[0]\n"; } - -=head2 (VIRTUAL) C<< $obj->event_err() >> - -Error event handler. Concrete deriviatives of PublicInbox::DS should -provide an implementation of this. The default implementation will die if -called. - -=cut -sub event_err { die "Base class event_err called for $_[0]\n"; } - -=head2 (VIRTUAL) C<< $obj->event_hup() >> - -'Hangup' event handler. Concrete deriviatives of PublicInbox::DS should -provide an implementation of this. The default implementation will die if -called. +provide an implementation of this. The default implementation is a noop +if called. =cut -sub event_hup { die "Base class event_hup called for $_[0]\n"; } +sub event_read {} # noop =head2 C<< $obj->event_write() >> @@ -800,16 +683,16 @@ sub watch_read { $event &= ~POLLIN if ! $val; $event |= POLLIN if $val; + my $fd = fileno($self->{sock}); # If it changed, set it if ($event != $self->{event_watch}) { if ($HaveKQueue) { - $KQueue->EV_SET($self->{fd}, IO::KQueue::EVFILT_READ(), + $KQueue->EV_SET($fd, IO::KQueue::EVFILT_READ(), $val ? IO::KQueue::EV_ENABLE() : IO::KQueue::EV_DISABLE()); } elsif ($HaveEpoll) { - epoll_ctl($Epoll, EPOLL_CTL_MOD, $self->{fd}, $event) - and $self->dump_error("couldn't modify epoll settings for $self->{fd} " . - "from $self->{event_watch} -> $event: $! (" . ($!+0) . ")"); + epoll_ctl($Epoll, EPOLL_CTL_MOD, $fd, $event) and + confess("EPOLL_CTL_MOD: $!"); } $self->{event_watch} = $event; } @@ -829,17 +712,17 @@ sub watch_write { $event &= ~POLLOUT if ! $val; $event |= POLLOUT if $val; + my $fd = fileno($self->{sock}); # If it changed, set it if ($event != $self->{event_watch}) { if ($HaveKQueue) { - $KQueue->EV_SET($self->{fd}, IO::KQueue::EVFILT_WRITE(), + $KQueue->EV_SET($fd, IO::KQueue::EVFILT_WRITE(), $val ? IO::KQueue::EV_ENABLE() : IO::KQueue::EV_DISABLE()); } elsif ($HaveEpoll) { - epoll_ctl($Epoll, EPOLL_CTL_MOD, $self->{fd}, $event) - and $self->dump_error("couldn't modify epoll settings for $self->{fd} " . - "from $self->{event_watch} -> $event: $! (" . ($!+0) . ")"); + epoll_ctl($Epoll, EPOLL_CTL_MOD, $fd, $event) and + confess "EPOLL_CTL_MOD: $!"; } $self->{event_watch} = $event; } diff --git a/lib/PublicInbox/EvCleanup.pm b/lib/PublicInbox/EvCleanup.pm index afed24ff..f76fb681 100644 --- a/lib/PublicInbox/EvCleanup.pm +++ b/lib/PublicInbox/EvCleanup.pm @@ -6,7 +6,6 @@ package PublicInbox::EvCleanup; use strict; use warnings; use base qw(PublicInbox::DS); -use fields qw(rd); my $ENABLED; sub enabled { $ENABLED } @@ -25,7 +24,12 @@ sub once_init () { pipe($r, $w) or die "pipe: $!"; fcntl($w, 1031, 4096) if $^O eq 'linux'; # 1031: F_SETPIPE_SZ $self->SUPER::new($w); - $self->{rd} = $r; # never read, since we never write.. + + # always writable, since PublicInbox::EvCleanup::event_write + # never drains wbuf. We can avoid wasting a hash slot by + # stuffing the read-end of the pipe into the never-to-be-touched + # wbuf + push @{$self->{wbuf}}, $r; $self; } diff --git a/lib/PublicInbox/HTTP.pm b/lib/PublicInbox/HTTP.pm index 977614b4..4fbc34ee 100644 --- a/lib/PublicInbox/HTTP.pm +++ b/lib/PublicInbox/HTTP.pm @@ -260,7 +260,7 @@ sub getline_cb ($$$) { $write->($buf); # may close in PublicInbox::DS::write unless ($self->{closed}) { my $next = $self->{pull}; - if ($self->{write_buf_size}) { + if (scalar @{$self->{wbuf}}) { $self->write($next); } else { PublicInbox::EvCleanup::asap($next); @@ -315,7 +315,7 @@ use constant MSG_MORE => ($^O eq 'linux') ? 0x8000 : 0; sub more ($$) { my $self = $_[0]; return if $self->{closed}; - if (MSG_MORE && !$self->{write_buf_size}) { + if (MSG_MORE && !scalar(@{$self->{wbuf}})) { my $n = send($self->{sock}, $_[1], MSG_MORE); if (defined $n) { my $nlen = length($_[1]) - $n; @@ -466,11 +466,6 @@ sub quit { $self->close; } -# callbacks for PublicInbox::DS - -sub event_hup { $_[0]->close } -sub event_err { $_[0]->close } - sub close { my $self = shift; my $forward = $self->{forward}; @@ -487,7 +482,7 @@ sub close { # for graceful shutdown in PublicInbox::Daemon: sub busy () { my ($self) = @_; - ($self->{rbuf} ne '' || $self->{env} || $self->{write_buf_size}); + ($self->{rbuf} ne '' || $self->{env} || scalar(@{$self->{wbuf}})); } 1; diff --git a/lib/PublicInbox/HTTPD/Async.pm b/lib/PublicInbox/HTTPD/Async.pm index dbe8a84a..4d0c8d5b 100644 --- a/lib/PublicInbox/HTTPD/Async.pm +++ b/lib/PublicInbox/HTTPD/Async.pm @@ -46,7 +46,7 @@ sub main_cb ($$$) { if ($r) { $fh->write($$bref); unless ($http->{closed}) { # PublicInbox::DS sets this - if ($http->{write_buf_size}) { + if (scalar @{$http->{wbuf}}) { $self->watch_read(0); $http->write(restart_read_cb($self)); } @@ -76,8 +76,6 @@ sub async_pass { } sub event_read { $_[0]->{cb}->(@_) } -sub event_hup { $_[0]->{cb}->(@_) } -sub event_err { $_[0]->{cb}->(@_) } sub close { my $self = shift; diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm index 8a31b910..fa412f8c 100644 --- a/lib/PublicInbox/NNTP.pm +++ b/lib/PublicInbox/NNTP.pm @@ -66,7 +66,8 @@ sub next_tick () { sub update_idle_time ($) { my ($self) = @_; - my $fd = $self->{fd}; + my $sock = $self->{sock} or return; + my $fd = fileno($sock); defined $fd and $EXPMAP->{$fd} = [ now(), $self ]; } @@ -622,7 +623,7 @@ sub long_response ($$) { my ($self, $cb) = @_; die "BUG: nested long response" if $self->{long_res}; - my $fd = $self->{fd}; + my $fd = fileno($self->{sock}); defined $fd or return; # make sure we disable reading during a long response, # clients should not be sending us stuff and making us do more @@ -646,7 +647,7 @@ sub long_response ($$) { update_idle_time($self); check_read($self); } - } elsif ($more) { # $self->{write_buf_size}: + } elsif ($more) { # scalar @{$self->{wbuf}}: # no recursion, schedule another call ASAP # but only after all pending writes are done update_idle_time($self); @@ -952,7 +953,7 @@ use constant MSG_MORE => ($^O eq 'linux') ? 0x8000 : 0; sub do_more ($$) { my ($self, $data) = @_; - if (MSG_MORE && !$self->{write_buf_size}) { + if (MSG_MORE && !scalar(@{$self->{wbuf}})) { my $n = send($self->{sock}, $data, MSG_MORE); if (defined $n) { my $dlen = length($data); @@ -963,11 +964,6 @@ sub do_more ($$) { do_write($self, $data); } -# callbacks for PublicInbox::DS - -sub event_hup { $_[0]->close } -sub event_err { $_[0]->close } - sub event_write { my ($self) = @_; update_idle_time($self); @@ -980,17 +976,24 @@ sub event_write { sub event_read { my ($self) = @_; use constant LINE_MAX => 512; # RFC 977 section 2.3 - - if (index($self->{rbuf}, "\n") < 0) { - my $buf = $self->read(LINE_MAX) or return $self->close; - $self->{rbuf} .= $$buf; + my $rbuf = \($self->{rbuf}); + my $r; + + if (index($$rbuf, "\n") < 0) { + my $off = length($$rbuf); + $r = sysread($self->{sock}, $$rbuf, LINE_MAX, $off); + unless (defined $r) { + return if $!{EAGAIN}; + return $self->close; + } + return $self->close if $r == 0; } - my $r = 1; - while ($r > 0 && $self->{rbuf} =~ s/\A[ \t\r\n]*([^\r\n]*)\r?\n//) { + $r = 1; + while ($r > 0 && $$rbuf =~ s/\A[ \t\r\n]*([^\r\n]*)\r?\n//) { my $line = $1; return $self->close if $line =~ /[[:cntrl:]]/s; my $t0 = now(); - my $fd = $self->{fd}; + my $fd = fileno($self->{sock}); $r = eval { process_line($self, $line) }; my $d = $self->{long_res} ? " deferred[$fd]" : ''; @@ -998,7 +1001,7 @@ sub event_read { } return $self->close if $r < 0; - my $len = length($self->{rbuf}); + my $len = length($$rbuf); return $self->close if ($len >= LINE_MAX); update_idle_time($self); } @@ -1022,7 +1025,8 @@ sub check_read { sub not_idle_long ($$) { my ($self, $now) = @_; - defined(my $fd = $self->{fd}) or return; + my $sock = $self->{sock} or return; + defined(my $fd = fileno($sock)) or return; my $ary = $EXPMAP->{$fd} or return; my $exp_at = $ary->[0] + $EXPTIME; $exp_at > $now; @@ -1031,8 +1035,8 @@ sub not_idle_long ($$) { # for graceful shutdown in PublicInbox::Daemon: sub busy { my ($self, $now) = @_; - ($self->{rbuf} ne '' || $self->{long_res} || $self->{write_buf_size} || - not_idle_long($self, $now)); + ($self->{rbuf} ne '' || $self->{long_res} || + scalar(@{$self->{wbuf}}) || not_idle_long($self, $now)); } 1; diff --git a/lib/PublicInbox/SearchView.pm b/lib/PublicInbox/SearchView.pm index b089de9c..6f07279b 100644 --- a/lib/PublicInbox/SearchView.pm +++ b/lib/PublicInbox/SearchView.pm @@ -34,14 +34,21 @@ sub sres_top_html { my $q = PublicInbox::SearchQuery->new($ctx->{qp}); my $x = $q->{x}; my $query = $q->{'q'}; + my $o = $q->{o}; + my $asc; + if ($o < 0) { + $asc = 1; + $o = -($o + 1); # so [-1] is the last element, like Perl lists + } my $code = 200; # double the limit for expanded views: my $opts = { limit => $q->{l}, - offset => $q->{o}, + offset => $o, mset => 1, relevance => $q->{r}, + asc => $asc, }; my ($mset, $total, $err, $cb); retry: @@ -184,30 +191,50 @@ sub search_nav_top { sub search_nav_bot { my ($mset, $q) = @_; my $total = $mset->get_matches_estimated; - my $o = $q->{o}; my $l = $q->{l}; - my $end = $o + $mset->size; - my $beg = $o + 1; my $rv = '</pre><hr><pre id=t>'; + my $o = $q->{o}; + my $off = $o < 0 ? -($o + 1) : $o; + my $end = $off + $mset->size; + my $beg = $off + 1; + if ($beg <= $end) { $rv .= "Results $beg-$end of $total"; $rv .= ' (estimated)' if $end != $total; } else { $rv .= "No more results, only $total"; } - my $n = $o + $l; + my ($next, $join, $prev); - if ($n < $total) { - my $qs = $q->qs_html(o => $n, l => $l); - $rv .= qq{ <a\nhref="?$qs"\nrel=next>next</a>} - } - if ($o > 0) { - $rv .= $n < $total ? '/' : ' '; - my $p = $o - $l; - my $qs = $q->qs_html(o => ($p > 0 ? $p : 0)); - $rv .= qq{<a\nhref="?$qs"\nrel=prev>prev</a>}; + if ($o >= 0) { # sort descending + my $n = $o + $l; + if ($n < $total) { + $next = $q->qs_html(o => $n, l => $l); + } + if ($o > 0) { + $join = $n < $total ? '/' : ' '; + my $p = $o - $l; + $prev = $q->qs_html(o => ($p > 0 ? $p : 0)); + } + } else { # o < 0, sort ascending + my $n = $o - $l; + + if (-$n < $total) { + $next = $q->qs_html(o => $n, l => $l); + } + if ($o < -1) { + $join = -$n < $total ? '/' : ' '; + my $p = $o + $l; + $prev = $q->qs_html(o => ($p < 0 ? $p : 0)); + } } - $rv .= '</pre>'; + + $rv .= qq{ <a\nhref="?$next"\nrel=next>next</a>} if $next; + $rv .= $join if $join; + $rv .= qq{<a\nhref="?$prev"\nrel=prev>prev</a>} if $prev; + + my $rev = $q->qs_html(o => $o < 0 ? 0 : -1); + $rv .= qq{ | <a\nhref="?$rev">reverse results</a></pre>}; } sub sort_relevance { @@ -313,7 +340,7 @@ sub new { bless { q => $qp->{'q'}, x => $qp->{x} || '', - o => (($qp->{o} || '0') =~ /([0-9]+)/), + o => (($qp->{o} || '0') =~ /(-?[0-9]+)/), l => $l, r => (defined $r && $r ne '0'), }, $class; |