$title

X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=lib%2FPublicInbox%2FFeed.pm;h=69ce59bd8cde5b70908c0099fdf6c6369bf70044;hb=68f9da93b11412122fff6e6154a42ecabcdbada0;hp=33406522b59bf53fe4823c5420d18dbae7e83e95;hpb=970da289a8ea3532538846905c7c01778066e1a9;p=public-inbox.git diff --git a/lib/PublicInbox/Feed.pm b/lib/PublicInbox/Feed.pm index 33406522..cbdf5db9 100644 --- a/lib/PublicInbox/Feed.pm +++ b/lib/PublicInbox/Feed.pm @@ -1,242 +1,143 @@ -# Copyright (C) 2013, Eric Wong and all contributors -# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt) +# Copyright (C) 2013-2020 all contributors +# License: AGPL-3.0+ +# +# Used for generating Atom feeds for web-accessible mailing list archives. package PublicInbox::Feed; use strict; use warnings; -use XML::Atom::SimpleFeed; -use Email::MIME; -use Email::Address; -use URI::Escape qw/uri_escape/; -use Encode qw/find_encoding/; -use Encode::MIME::Header; -use CGI qw(escapeHTML); -use POSIX qw(strftime); -use Date::Parse qw(strptime); -use constant DATEFMT => '%Y-%m-%dT%H:%M:%SZ'; use PublicInbox::View; -use Mail::Thread; -my $enc_utf8 = find_encoding('utf8'); -my $enc_ascii = find_encoding('us-ascii'); -my $enc_mime = find_encoding('MIME-Header'); +use PublicInbox::WwwAtomStream; +use PublicInbox::Smsg; # this loads w/o Search::Xapian -# FIXME: workaround https://rt.cpan.org/Public/Bug/Display.html?id=22817 +sub generate_i { + my ($ctx) = @_; + shift @{$ctx->{msgs}}; +} # main function sub generate { - my ($class, $args) = @_; - my $max = $args->{max} || 25; - my $top = $args->{top}; # bool - - local $ENV{GIT_DIR} = $args->{git_dir}; - my $feed_opts = get_feedopts($args); - - my $feed = XML::Atom::SimpleFeed->new( - title => $feed_opts->{description} || "unnamed feed", - link => $feed_opts->{url} || "http://example.com/", - link => { - rel => 'self', - href => $feed_opts->{atomurl} || - "http://example.com/atom", - }, - id => $feed_opts->{address} || 'public-inbox@example.com', - updated => strftime(DATEFMT, gmtime), - ); - - each_recent_blob($max, sub { - my ($add) = @_; - add_to_feed($feed_opts, $feed, $add, $top); - }); - $feed->as_string; + my ($ctx) = @_; + my $msgs = $ctx->{msgs} = recent_msgs($ctx); + return _no_thread() unless @$msgs; + PublicInbox::WwwAtomStream->response($ctx, 200, \&generate_i); } -sub generate_html_index { - my ($class, $args) = @_; - my $max = $args->{max} || 50; - my $top = $args->{top}; # bool - local $ENV{GIT_DIR} = $args->{git_dir}; - my $feed_opts = get_feedopts($args); - my $title = xs_html($feed_opts->{description} || ""); - my @messages; - each_recent_blob($max, sub { - my $str = `git cat-file blob $_[0]`; - return 0 if $? != 0; - my $simple = Email::Simple->new($str); - if ($top && ($simple->header("In-Reply-To") || - $simple->header("References"))) { - return 0; - } - $simple->body_set(""); # save some memory - push @messages, $simple; - 1; - }); - - my $th = Mail::Thread->new(@messages); - $th->thread; - my @args = ( - "$title" . - '' . - '

');
-	push @args, $feed_opts->{midurl};
-	dump_html_line($_, 0, \@args) for $th->rootset;
-	$args[0] . '

'; +sub generate_thread_atom { + my ($ctx) = @_; + my $msgs = $ctx->{msgs} = $ctx->{-inbox}->over->get_thread($ctx->{mid}); + return _no_thread() unless @$msgs; + PublicInbox::WwwAtomStream->response($ctx, 200, \&generate_i); } -# private subs - -sub each_recent_blob { - my ($max, $cb) = @_; - - # get recent messages - # we could use git log -z, but, we already know ssoma will not - # leave us with filenames with spaces in them.. - my $cmd = "git log --no-notes --no-color --raw -r --no-abbrev HEAD |"; - my $pid = open my $log, $cmd or die "open `$cmd' pipe failed: $!\n"; - my %deleted; - my $nr = 0; - foreach my $line (<$log>) { - if ($line =~ /^:000000 100644 0{40} ([a-f0-9]{40})/) { - my $add = $1; - next if $deleted{$add}; - $nr += $cb->($add); - last if $nr >= $max; - } elsif ($line =~ /^:100644 000000 ([a-f0-9]{40}) 0{40}/) { - $deleted{$1} = 1; - } +sub generate_html_index { + my ($ctx) = @_; + # if the 'r' query parameter is given, it is a legacy permalink + # which we must continue supporting: + my $qp = $ctx->{qp}; + my $ibx = $ctx->{-inbox}; + if ($qp && !$qp->{r} && $ibx->over) { + return PublicInbox::View::index_topics($ctx); } - close $log; + my $env = $ctx->{env}; + my $url = $ibx->base_url($env) . 'new.html'; + my $qs = $env->{QUERY_STRING}; + $url .= "?$qs" if $qs ne ''; + [302, [ 'Location', $url, 'Content-Type', 'text/plain'], + [ "Redirecting to $url\n" ] ]; } -# private functions below -sub get_feedopts { - my ($args) = @_; - my $pi_config = $args->{pi_config}; - my $listname = $args->{listname}; - my $cgi = $args->{cgi}; - my %rv; - - if ($pi_config && defined $listname && length $listname) { - foreach my $key (qw(description address)) { - $rv{$key} = $pi_config->get($listname, $key) || ""; - } - } - my $url_base; - if ($cgi) { - my $cgi_url = $cgi->url(-path=>1, -query=>1, -relative=>1); - my $base = $cgi->url(-base); - $url_base = $cgi_url; - if ($url_base =~ s!/(?:|(index|all)\.html)?\z!!) { - my $ia = $1 || 'index'; - $rv{atomurl} = "$base$url_base/$ia.atom.xml"; - } else { - $url_base =~ s!/?(?:index|all)\.atom\.xml\z!!; - $rv{atomurl} = $base . $cgi_url; - $url_base = $base . $url_base; # XXX is this needed? - } - } else { - $url_base = "http://example.com"; - $rv{atomurl} = "$url_base/index.atom.xml"; - } - $rv{url} ||= "$url_base/"; - $rv{midurl} = "$url_base/m/"; - $rv{fullurl} = "$url_base/f/"; +sub new_html_i { + my ($ctx, $eml) = @_; + $ctx->zmore($ctx->html_top) if exists $ctx->{-html_tip}; - \%rv; + $eml and return PublicInbox::View::eml_entry($ctx, $eml); + my $smsg = shift @{$ctx->{msgs}} or + $ctx->zmore(PublicInbox::View::pagination_footer( + $ctx, './new.html')); + $smsg; } -sub utf8_header { - my ($simple, $name) = @_; - my $val = $simple->header($name); - return "" unless defined $val; - $val =~ tr/\t\n / /s; - $val =~ tr/\r//d; - $enc_utf8->encode($enc_mime->decode($val)); +sub new_html { + my ($ctx) = @_; + my $msgs = $ctx->{msgs} = recent_msgs($ctx); + if (!@$msgs) { + return [404, ['Content-Type', 'text/plain'], + ["No messages, yet\n"] ]; + } + $ctx->{-html_tip} = '

';
+	$ctx->{-upfx} = '';
+	$ctx->{-hr} = 1;
+	PublicInbox::WwwStream::aresponse($ctx, 200, \&new_html_i);
 }
 
-sub feed_date {
-	my ($date) = @_;
-	my @t = eval { strptime($date) };
+# private subs
 
-	scalar(@t) ? strftime(DATEFMT, @t) : 0;
+sub _no_thread () {
+	[404, ['Content-Type', 'text/plain'], ["No feed found for thread\n"]];
 }
 
-# returns 0 (skipped) or 1 (added)
-sub add_to_feed {
-	my ($feed_opts, $feed, $add, $top) = @_;
-
-	# we can use git cat-file --batch if performance becomes a
-	# problem, but I doubt it...
-	my $str = `git cat-file blob $add`;
-	return 0 if $? != 0;
-	my $mime = Email::MIME->new($str);
-
-	if ($top && $mime->header("In-Reply-To")) {
-		return 0;
+sub recent_msgs {
+	my ($ctx) = @_;
+	my $ibx = $ctx->{-inbox};
+	my $max = $ibx->{feedmax};
+	return PublicInbox::View::paginate_recent($ctx, $max) if $ibx->over;
+
+	# only for rare v1 inboxes which aren't indexed at all
+	my $qp = $ctx->{qp};
+	my $hex = '[a-f0-9]';
+	my $addmsg = qr!^:000000 100644 \S+ (\S+) A\t${hex}{2}/${hex}{38}$!;
+	my $delmsg = qr!^:100644 000000 (\S+) \S+ D\t(${hex}{2}/${hex}{38})$!;
+	my $refhex = qr/(?:HEAD|${hex}{4,40})(?:~[0-9]+)?/;
+
+	# revision ranges may be specified
+	my $range = 'HEAD';
+	my $r = $qp->{r} if $qp;
+	if ($r && ($r =~ /\A(?:$refhex\.\.)?$refhex\z/o)) {
+		$range = $r;
 	}
 
-	my $midurl = $feed_opts->{midurl} || 'http://example.com/m/';
-	my $fullurl = $feed_opts->{fullurl} || 'http://example.com/f/';
-
-	my $content = PublicInbox::View->as_feed_entry($mime, $fullurl);
-	defined($content) or return 0;
-
-	my $mid = utf8_header($mime, "Message-ID") or return 0;
-	$mid =~ s/\A\z//;
-
-	my $subject = utf8_header($mime, "Subject") || "";
-	length($subject) or return 0;
-
-	my $from = utf8_header($mime, "From") or return 0;
-
-	my @from = Email::Address->parse($from);
-	my $name = $from[0]->name;
-	defined $name or $name = "";
-	my $email = $from[0]->address;
-	defined $email or $email = "";
-
-	my $url = $midurl . uri_escape($mid);
-	my $date = utf8_header($mime, "Date");
-	$date or return 0;
-	$date = feed_date($date) or return 0;
-	$feed->add_entry(
-		author => { name => $name, email => $email },
-		title => $subject,
-		updated => $date,
-		content => { type => "html", content => $content },
-		link => $url,
-		id => $add,
-	);
-	1;
-}
+	# get recent messages
+	# we could use git log -z, but, we already know ssoma will not
+	# leave us with filenames with spaces in them..
+	my $log = $ibx->git->popen(qw/log
+				--no-notes --no-color --raw -r
+				--no-abbrev --abbrev-commit/,
+				"--format=%H", $range);
+	my %deleted; # only an optimization at this point
+	my $last;
+	my $last_commit;
+	local $/ = "\n";
+	my @oids;
+	while (defined(my $line = <$log>)) {
+		if ($line =~ /$addmsg/o) {
+			my $add = $1;
+			next if $deleted{$add}; # optimization-only
+			push @oids, $add;
+			if (scalar(@oids) >= $max) {
+				$last = 1;
+				last;
+			}
+		} elsif ($line =~ /$delmsg/o) {
+			$deleted{$1} = 1;
+		}
+	}
 
-sub dump_html_line {
-	my ($self, $level, $args) = @_; # args => [ $html, $midurl ]
-	$args->[0] .= (' ' x $level);
-	if ($self->message) {
-		my $simple = $self->message;
-		my $subj = utf8_header($simple, "Subject");
-		my $mid = utf8_header($simple, "Message-ID");
-		$mid =~ s/\A\z//;
-		my $url = $args->[1] . uri_escape($mid);
-		my $from = utf8_header($simple, "From");
-		my @from = Email::Address->parse($from);
-		$from = $from[0]->name;
-		(defined($from) && length($from)) or $from = $from[0]->address;
-		$from = xs_html($from);
-		$subj = xs_html($subj);
-		$args->[0] .= "$subj $from\n";
-	} else {
-		$args->[0] .= "[ Message not available ]\n";
+	if ($last) {
+		local $/ = "\n";
+		while (my $line = <$log>) {
+			if ($line =~ /^(${hex}{7,40})/) {
+				$last_commit = $1;
+				last;
+			}
+		}
 	}
-	dump_html_line($self->child, $level+1, $args) if $self->child;
-	dump_html_line($self->next, $level, $args) if $self->next;
-}
 
-sub xs_html {
-	$enc_ascii->encode(escapeHTML($enc_utf8->decode($_[0])),
-			Encode::HTMLCREF);
+	$last_commit and
+		$ctx->{next_page} = qq[] .
+					'next (older)';
+
+	[ map { bless {blob => $_ }, 'PublicInbox::Smsg' } @oids ];
 }
 
 1;