X-Git-Url: http://www.git.stargrave.org/?p=public-inbox.git;a=blobdiff_plain;f=lib%2FPublicInbox%2FNNTP.pm;h=3929f81737901507e06c80994a694718617e3910;hp=5eb6112ceb2f932286bd263a11795b4c163590b1;hb=9b0c238f887475d920a8589b492ec15c63770152;hpb=1c3e60b66e01df89afdf74990a849a5a7386f9c7

diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm
index 5eb6112c..3929f817 100644
--- a/lib/PublicInbox/NNTP.pm
+++ b/lib/PublicInbox/NNTP.pm
@@ -108,60 +108,63 @@ sub list_overview_fmt ($) { $OVERVIEW_FMT }
 
 sub list_headers ($;$) { $LIST_HEADERS }
 
-sub list_active_i { # "LIST ACTIVE" and also just "LIST" (no args)
-	my ($self, $groupnames) = @_;
-	my @window = splice(@$groupnames, 0, 100) or return 0;
-	my $ibx;
+sub names2ibx ($;$) {
+	my ($self, $names) = @_;
 	my $groups = $self->{nntpd}->{pi_cfg}->{-by_newsgroup};
-	for my $ngname (@window) {
-		$ibx = $groups->{$ngname} and group_line($self, $ibx);
+	if ($names) { # modify arrayref in-place
+		$_ = $groups->{$_} for @$names;
+		$names; # now an arrayref of ibx
+	} else {
+		my @ret = map { $groups->{$_} } @{$self->{nntpd}->{groupnames}};
+		\@ret;
 	}
-	scalar(@$groupnames); # continue if there's more
+}
+
+sub list_active_i { # "LIST ACTIVE" and also just "LIST" (no args)
+	my ($self, $ibxs) = @_;
+	my @window = splice(@$ibxs, 0, 1000);
+	$self->msg_more(join('', map { group_line($_) } @window));
+	scalar @$ibxs; # continue if there's more
 }
 
 sub list_active ($;$) { # called by cmd_list
 	my ($self, $wildmat) = @_;
 	wildmat2re($wildmat);
-	long_response($self, \&list_active_i, [
-		grep(/$wildmat/, @{$self->{nntpd}->{groupnames}}) ]);
+	my @names = grep(/$wildmat/, @{$self->{nntpd}->{groupnames}});
+	$self->long_response(\&list_active_i, names2ibx($self, \@names));
 }
 
 sub list_active_times_i {
-	my ($self, $groupnames) = @_;
-	my @window = splice(@$groupnames, 0, 100) or return 0;
-	my $groups = $self->{nntpd}->{pi_cfg}->{-by_newsgroup};
-	for my $ngname (@window) {
-		my $ibx = $groups->{$ngname} or next;
-		my $c = eval { $ibx->uidvalidity } // time;
-		$self->msg_more("$ngname $c <$ibx->{-primary_address}>\r\n");
-	}
-	scalar(@$groupnames); # continue if there's more
+	my ($self, $ibxs) = @_;
+	my @window = splice(@$ibxs, 0, 1000);
+	$self->msg_more(join('', map {
+		my $c = eval { $_->uidvalidity } // time;
+		"$_->{newsgroup} $c <$_->{-primary_address}>\r\n";
+	} @window));
+	scalar @$ibxs; # continue if there's more
 }
 
 sub list_active_times ($;$) { # called by cmd_list
 	my ($self, $wildmat) = @_;
 	wildmat2re($wildmat);
-	long_response($self, \&list_active_times_i, [
-		grep(/$wildmat/, @{$self->{nntpd}->{groupnames}}) ]);
+	my @names = grep(/$wildmat/, @{$self->{nntpd}->{groupnames}});
+	$self->long_response(\&list_active_times_i, names2ibx($self, \@names));
 }
 
 sub list_newsgroups_i {
-	my ($self, $groupnames) = @_;
-	my @window = splice(@$groupnames, 0, 100) or return 0;
-	my $groups = $self->{nntpd}->{pi_cfg}->{-by_newsgroup};
-	my $ibx;
-	for my $ngname (@window) {
-		$ibx = $groups->{$ngname} and
-			$self->msg_more("$ngname ".$ibx->description."\r\n");
-	}
-	scalar(@$groupnames); # continue if there's more
+	my ($self, $ibxs) = @_;
+	my @window = splice(@$ibxs, 0, 1000);
+	$self->msg_more(join('', map {
+		"$_->{newsgroup} ".$_->description."\r\n"
+	} @window));
+	scalar @$ibxs; # continue if there's more
 }
 
 sub list_newsgroups ($;$) { # called by cmd_list
 	my ($self, $wildmat) = @_;
 	wildmat2re($wildmat);
-	long_response($self, \&list_newsgroups_i, [
-		grep(/$wildmat/, @{$self->{nntpd}->{groupnames}}) ]);
+	my @names = grep(/$wildmat/, @{$self->{nntpd}->{groupnames}});
+	$self->long_response(\&list_newsgroups_i, names2ibx($self, \@names));
 }
 
 # LIST SUBSCRIPTIONS, DISTRIB.PATS are not supported
@@ -178,8 +181,7 @@ sub cmd_list ($;$$) {
 		$arg->($self, @args);
 	} else {
 		$self->msg_more("215 list of newsgroups follows\r\n");
-		long_response($self, \&list_active_i, [ # copy array
-			@{$self->{nntpd}->{groupnames}} ]);
+		$self->long_response(\&list_active_i, names2ibx($self));
 	}
 }
 
@@ -210,9 +212,9 @@ sub cmd_listgroup ($;$$) {
 	if (defined $range) {
 		my $r = get_range($self, $range);
 		return $r unless ref $r;
-		long_response($self, \&listgroup_range_i, @$r);
+		$self->long_response(\&listgroup_range_i, @$r);
 	} else { # grab every article number
-		long_response($self, \&listgroup_all_i, \(my $num = 0));
+		$self->long_response(\&listgroup_all_i, \(my $num = 0));
 	}
 }
 
@@ -242,23 +244,19 @@ sub parse_time ($$;$) {
 	}
 }
 
-sub group_line ($$) {
-	my ($self, $ibx) = @_;
+sub group_line ($) {
+	my ($ibx) = @_;
 	my ($min, $max) = $ibx->mm(1)->minmax;
-	$self->msg_more("$ibx->{newsgroup} $max $min n\r\n");
+	"$ibx->{newsgroup} $max $min n\r\n";
 }
 
 sub newgroups_i {
-	my ($self, $ts, $i, $groupnames) = @_;
-	my $end = $$i + 100;
-	my $groups = $self->{nntpd}->{pi_cfg}->{-by_newsgroup};
-	while ($$i < $end) {
-		my $ngname = $groupnames->[$$i++] // return;
-		my $ibx = $groups->{$ngname} or next; # expired on reload
-		next unless (eval { $ibx->uidvalidity } // 0) > $ts;
-		group_line($self, $ibx);
-	}
-	1;
+	my ($self, $ts, $ibxs) = @_;
+	my @window = splice(@$ibxs, 0, 1000);
+	$self->msg_more(join('', map { group_line($_) } grep {
+		 (eval { $_->uidvalidity } // 0) > $ts
+	} @window));
+	scalar @$ibxs;
 }
 
 sub cmd_newgroups ($$$;$$) {
@@ -268,8 +266,7 @@ sub cmd_newgroups ($$$;$$) {
 
 	# TODO dists
 	$self->msg_more("231 list of new newsgroups follows\r\n");
-	long_response($self, \&newgroups_i, $ts, \(my $i = 0),
-				$self->{nntpd}->{groupnames});
+	$self->long_response(\&newgroups_i, $ts, names2ibx($self));
 }
 
 sub wildmat2re (;$) {
@@ -304,22 +301,19 @@ sub ngpat2re (;$) {
 }
 
 sub newnews_i {
-	my ($self, $names, $ts, $prev) = @_;
-	my $ngname = $names->[0];
-	if (my $ibx = $self->{nntpd}->{pi_cfg}->{-by_newsgroup}->{$ngname}) {
-		if (my $over = $ibx->over) {
-			my $msgs = $over->query_ts($ts, $$prev);
-			if (scalar @$msgs) {
-				$self->msg_more(join('', map {
-							"<$_->{mid}>\r\n";
-						} @$msgs));
-				$$prev = $msgs->[-1]->{num};
-				return 1; # continue on current group
-			}
+	my ($self, $ibxs, $ts, $prev) = @_;
+	if (my $over = $ibxs->[0]->over) {
+		my $msgs = $over->query_ts($ts, $$prev);
+		if (scalar @$msgs) {
+			$self->msg_more(join('', map {
+						"<$_->{mid}>\r\n";
+					} @$msgs));
+			$$prev = $msgs->[-1]->{num};
+			return 1; # continue on current group
 		}
 	}
-	shift @$names;
-	if (@$names) { # continue onto next newsgroup
+	shift @$ibxs;
+	if (@$ibxs) { # continue onto next newsgroup
 		$$prev = 0;
 		1;
 	} else { # all done, break out of the long_response
@@ -335,11 +329,12 @@ sub cmd_newnews ($$$$;$$) {
 	my ($keep, $skip) = split(/!/, $newsgroups, 2);
 	ngpat2re($keep);
 	ngpat2re($skip);
-	my @names = grep(!/$skip/, grep(/$keep/,
-				@{$self->{nntpd}->{groupnames}}));
-	return ".\r\n" unless scalar(@names);
+	my @names = grep(/$keep/, @{$self->{nntpd}->{groupnames}});
+	@names = grep(!/$skip/, @names);
+	return \".\r\n" unless scalar(@names);
 	my $prev = 0;
-	long_response($self, \&newnews_i, \@names, $ts, \$prev);
+	$self->long_response(\&newnews_i, names2ibx($self, \@names),
+				$ts, \$prev);
 }
 
 sub cmd_group ($$) {
@@ -613,46 +608,7 @@ sub get_range ($$) {
 	$beg > $end ? "420 No article(s) selected\r\n" : [ \$beg, $end ];
 }
 
-sub long_step {
-	my ($self) = @_;
-	# wbuf is unset or empty, here; {long} may add to it
-	my ($fd, $cb, $t0, @args) = @{$self->{long_cb}};
-	my $more = eval { $cb->($self, @args) };
-	if ($@ || !$self->{sock}) { # something bad happened...
-		delete $self->{long_cb};
-		my $elapsed = now() - $t0;
-		if ($@) {
-			err($self,
-			    "%s during long response[$fd] - %0.6f",
-			    $@, $elapsed);
-		}
-		out($self, " deferred[$fd] aborted - %0.6f", $elapsed);
-		$self->close;
-	} elsif ($more) { # $self->{wbuf}:
-		# control passed to ibx_async_cat if $more == \undef
-		$self->requeue_once if !ref($more);
-	} else { # all done!
-		delete $self->{long_cb};
-		$self->write(\".\r\n"); # TODO get rid of this
-		my $elapsed = now() - $t0;
-		my $fd = fileno($self->{sock});
-		out($self, " deferred[$fd] done - %0.6f", $elapsed);
-		my $wbuf = $self->{wbuf}; # do NOT autovivify
-		$self->requeue unless $wbuf && @$wbuf;
-	}
-}
-
-sub long_response ($$;@) {
-	my ($self, $cb, @args) = @_; # cb returns true if more, false if done
-
-	my $sock = $self->{sock} or return;
-	# make sure we disable reading during a long response,
-	# clients should not be sending us stuff and making us do more
-	# work while we are stream a response to them
-	$self->{long_cb} = [ fileno($sock), $cb, now(), @args ];
-	long_step($self); # kick off!
-	undef;
-}
+sub long_response_done { $_[0]->write(\".\r\n") } # overrides superclass
 
 sub hdr_msgid_range_i {
 	my ($self, $beg, $end) = @_;
@@ -674,7 +630,7 @@ sub hdr_message_id ($$$) { # optimize XHDR Message-ID [range] for slrnpull.
 		my $r = get_range($self, $range);
 		return $r unless ref $r;
 		$self->msg_more($xhdr ? r221 : r225);
-		long_response($self, \&hdr_msgid_range_i, @$r);
+		$self->long_response(\&hdr_msgid_range_i, @$r);
 	}
 }
 
@@ -746,7 +702,7 @@ sub hdr_xref ($$$) { # optimize XHDR Xref [range] for rtin
 		my $r = get_range($self, $range);
 		return $r unless ref $r;
 		$self->msg_more($xhdr ? r221 : r225);
-		long_response($self, \&xref_range_i, @$r);
+		$self->long_response(\&xref_range_i, @$r);
 	}
 }
 
@@ -790,7 +746,7 @@ sub hdr_smsg ($$$$) {
 		my $r = get_range($self, $range);
 		return $r unless ref $r;
 		$self->msg_more($xhdr ? r221 : r225);
-		long_response($self, \&smsg_range_i, @$r, $field);
+		$self->long_response(\&smsg_range_i, @$r, $field);
 	}
 }
 
@@ -860,7 +816,7 @@ sub cmd_xrover ($;$) {
 	my $r = get_range($self, $range);
 	return $r unless ref $r;
 	$self->msg_more("224 Overview information follows\r\n");
-	long_response($self, \&xrover_i, @$r);
+	$self->long_response(\&xrover_i, @$r);
 }
 
 sub over_line ($$$) {
@@ -924,7 +880,7 @@ sub cmd_xover ($;$) {
 	my ($beg, $end) = @$r;
 	$self->msg_more(
 		"224 Overview information follows for $$beg to $end\r\n");
-	long_response($self, \&xover_i, @$r);
+	$self->long_response(\&xover_i, @$r);
 }
 
 sub compressed { undef }