<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/perl
# Blog aggregation plugin.
package IkiWiki::Plugin::aggregate;

use warnings;
use strict;
use IkiWiki;
use HTML::Entities;
use HTML::Parser;
use HTML::Tagset;
use URI;
use open qw{:utf8 :std};

my %feeds;
my %guids;

sub import { #{{{
	hook(type =&gt; "getopt", id =&gt; "aggregate", call =&gt; \&amp;getopt);
	hook(type =&gt; "checkconfig", id =&gt; "aggregate", call =&gt; \&amp;checkconfig);
	hook(type =&gt; "filter", id =&gt; "aggregate", call =&gt; \&amp;filter);
	hook(type =&gt; "preprocess", id =&gt; "aggregate", call =&gt; \&amp;preprocess);
        hook(type =&gt; "delete", id =&gt; "aggregate", call =&gt; \&amp;delete);
	hook(type =&gt; "savestate", id =&gt; "aggregate", call =&gt; \&amp;savestate);
} # }}}

sub getopt () { #{{{
        eval q{use Getopt::Long};
	error($@) if $@;
        Getopt::Long::Configure('pass_through');
        GetOptions("aggregate" =&gt; \$config{aggregate});
} #}}}

sub checkconfig () { #{{{
	IkiWiki::lockwiki();
	loadstate();
	if ($config{aggregate}) {
		IkiWiki::loadindex();
		aggregate();
		expire();
		savestate();
	}
	IkiWiki::unlockwiki();
} #}}}

sub filter (@) { #{{{
	my %params=@_;
	my $page=$params{page};

	# Mark all feeds originating on this page as removable;
	# preprocess will unmark those that still exist.
	remove_feeds($page);

	return $params{content};
} # }}}

sub preprocess (@) { #{{{
	my %params=@_;

	foreach my $required (qw{name url}) {
		if (! exists $params{$required}) {
			return "[[".sprintf(gettext("aggregate plugin missing %s parameter"), $required)."]]";
		}
	}

	my $feed={};
	my $name=$params{name};
	if (exists $feeds{$name}) {
		$feed=$feeds{$name};
	}
	else {
		$feeds{$name}=$feed;
	}
	$feed-&gt;{name}=$name;
	$feed-&gt;{sourcepage}=$params{page};
	$feed-&gt;{url}=$params{url};
	my $dir=exists $params{dir} ? $params{dir} : $params{page}."/".IkiWiki::titlepage($params{name});
	$dir=~s/^\/+//;
	($dir)=$dir=~/$config{wiki_file_regexp}/;
	$feed-&gt;{dir}=$dir;
	$feed-&gt;{feedurl}=defined $params{feedurl} ? $params{feedurl} : "";
	$feed-&gt;{updateinterval}=defined $params{updateinterval} ? $params{updateinterval} * 60 : 15 * 60;
	$feed-&gt;{expireage}=defined $params{expireage} ? $params{expireage} : 0;
	$feed-&gt;{expirecount}=defined $params{expirecount} ? $params{expirecount} : 0;
	delete $feed-&gt;{remove};
	delete $feed-&gt;{expired};
	$feed-&gt;{lastupdate}=0 unless defined $feed-&gt;{lastupdate};
	$feed-&gt;{numposts}=0 unless defined $feed-&gt;{numposts};
	$feed-&gt;{newposts}=0 unless defined $feed-&gt;{newposts};
	$feed-&gt;{message}=gettext("new feed") unless defined $feed-&gt;{message};
	$feed-&gt;{error}=0 unless defined $feed-&gt;{error};
	$feed-&gt;{tags}=[];
	while (@_) {
		my $key=shift;
		my $value=shift;
		if ($key eq 'tag') {
			push @{$feed-&gt;{tags}}, $value;
		}
	}

	return "&lt;a href=\"".$feed-&gt;{url}."\"&gt;".$feed-&gt;{name}."&lt;/a&gt;: ".
	       ($feed-&gt;{error} ? "&lt;em&gt;" : "").$feed-&gt;{message}.
	       ($feed-&gt;{error} ? "&lt;/em&gt;" : "").
	       " (".$feed-&gt;{numposts}." ".gettext("posts").
	       ($feed-&gt;{newposts} ? "; ".$feed-&gt;{newposts}.
	                            " ".gettext("new") : "").
	       ")";
} # }}}

sub delete (@) { #{{{
	my @files=@_;

	# Remove feed data for removed pages.
	foreach my $file (@files) {
		my $page=pagename($file);
		remove_feeds($page);
	}
} #}}}

sub loadstate () { #{{{
	if (-e "$config{wikistatedir}/aggregate") {
		open (IN, "$config{wikistatedir}/aggregate" ||
			die "$config{wikistatedir}/aggregate: $!");
		while (&lt;IN&gt;) {
			$_=IkiWiki::possibly_foolish_untaint($_);
			chomp;
			my $data={};
			foreach my $i (split(/ /, $_)) {
				my ($field, $val)=split(/=/, $i, 2);
				if ($field eq "name" || $field eq "feed" ||
				    $field eq "guid" || $field eq "message") {
					$data-&gt;{$field}=decode_entities($val, " \t\n");
				}
				elsif ($field eq "tag") {
					push @{$data-&gt;{tags}}, $val;
				}
				else {
					$data-&gt;{$field}=$val;
				}
			}
			
			if (exists $data-&gt;{name}) {
				$feeds{$data-&gt;{name}}=$data;
			}
			elsif (exists $data-&gt;{guid}) {
				$guids{$data-&gt;{guid}}=$data;
			}
		}

		close IN;
	}
} #}}}

sub savestate () { #{{{
	eval q{use HTML::Entities};
	error($@) if $@;
	open (OUT, "&gt;$config{wikistatedir}/aggregate" ||
		die "$config{wikistatedir}/aggregate: $!");
	foreach my $data (values %feeds, values %guids) {
		if ($data-&gt;{remove}) {
			if ($data-&gt;{name}) {
				foreach my $guid (values %guids) {
					if ($guid-&gt;{feed} eq $data-&gt;{name}) {
						$guid-&gt;{remove}=1;
					}
				}
			}
			else {
				unlink pagefile($data-&gt;{page});
			}
			next;
		}
		elsif ($data-&gt;{expired} &amp;&amp; exists $data-&gt;{page}) {
			unlink pagefile($data-&gt;{page});
			delete $data-&gt;{page};
			delete $data-&gt;{md5};
		}

		my @line;
		foreach my $field (keys %$data) {
			if ($field eq "name" || $field eq "feed" ||
			    $field eq "guid" || $field eq "message") {
				push @line, "$field=".encode_entities($data-&gt;{$field}, " \t\n");
			}
			elsif ($field eq "tags") {
				push @line, "tag=$_" foreach @{$data-&gt;{tags}};
			}
			else {
				push @line, "$field=".$data-&gt;{$field};
			}
		}
		print OUT join(" ", @line)."\n";
	}
	close OUT;
} #}}}

sub expire () { #{{{
	foreach my $feed (values %feeds) {
		next unless $feed-&gt;{expireage} || $feed-&gt;{expirecount};
		my $count=0;
		foreach my $item (sort { $IkiWiki::pagectime{$b-&gt;{page}} &lt;=&gt; $IkiWiki::pagectime{$a-&gt;{page}} }
		                  grep { exists $_-&gt;{page} &amp;&amp; $_-&gt;{feed} eq $feed-&gt;{name} &amp;&amp; $IkiWiki::pagectime{$_-&gt;{page}} }
		                  values %guids) {
			if ($feed-&gt;{expireage}) {
				my $days_old = (time - $IkiWiki::pagectime{$item-&gt;{page}}) / 60 / 60 / 24;
				if ($days_old &gt; $feed-&gt;{expireage}) {
					debug(sprintf(gettext("expiring %s (%s days old)"),
						$item-&gt;{page}, $days_old));
					$item-&gt;{expired}=1;
				}
			}
			elsif ($feed-&gt;{expirecount} &amp;&amp;
			       $count &gt;= $feed-&gt;{expirecount}) {
				debug(sprintf(gettext("expiring %s"), $item-&gt;{page}));
				$item-&gt;{expired}=1;
			}
			else {
				$count++;
			}
		}
	}
} #}}}

sub aggregate () { #{{{
	eval q{use XML::Feed};
	error($@) if $@;
	eval q{use HTML::Entities};
	error($@) if $@;

	foreach my $feed (values %feeds) {
		next unless $config{rebuild} || 
			time - $feed-&gt;{lastupdate} &gt;= $feed-&gt;{updateinterval};
		$feed-&gt;{lastupdate}=time;
		$feed-&gt;{newposts}=0;
		$IkiWiki::forcerebuild{$feed-&gt;{sourcepage}}=1;

		debug(sprintf(gettext("checking feed %s ..."), $feed-&gt;{name}));

		if (! length $feed-&gt;{feedurl}) {
			my @urls=XML::Feed-&gt;find_feeds($feed-&gt;{url});
			if (! @urls) {
				$feed-&gt;{message}=sprintf(gettext("could not find feed at %s"), $feed-&gt;{feedurl});
				$feed-&gt;{error}=1;
				debug($feed-&gt;{message});
				next;
			}
			$feed-&gt;{feedurl}=pop @urls;
		}
		my $f=eval{XML::Feed-&gt;parse(URI-&gt;new($feed-&gt;{feedurl}))};
		if ($@) {
			$feed-&gt;{message}=gettext("feed crashed XML::Feed!")." ($@)";
			$feed-&gt;{error}=1;
			debug($feed-&gt;{message});
			next;
		}
		if (! $f) {
			$feed-&gt;{message}=XML::Feed-&gt;errstr;
			$feed-&gt;{error}=1;
			debug($feed-&gt;{message});
			next;
		}

		foreach my $entry ($f-&gt;entries) {
			add_page(
				feed =&gt; $feed,
				title =&gt; defined $entry-&gt;title ? decode_entities($entry-&gt;title) : "untitled",
				link =&gt; $entry-&gt;link,
				content =&gt; $entry-&gt;content-&gt;body,
				guid =&gt; defined $entry-&gt;id ? $entry-&gt;id : time."_".$feed-&gt;name,
				ctime =&gt; $entry-&gt;issued ? ($entry-&gt;issued-&gt;epoch || time) : time,
			);
		}

		$feed-&gt;{message}=sprintf(gettext("processed ok at %s"),
			displaytime($feed-&gt;{lastupdate}));
		$feed-&gt;{error}=0;
	}
} #}}}

sub add_page (@) { #{{{
	my %params=@_;
	
	my $feed=$params{feed};
	my $guid={};
	my $mtime;
	if (exists $guids{$params{guid}}) {
		# updating an existing post
		$guid=$guids{$params{guid}};
		return if $guid-&gt;{expired};
	}
	else {
		# new post
		$guid-&gt;{guid}=$params{guid};
		$guids{$params{guid}}=$guid;
		$mtime=$params{ctime};
		$feed-&gt;{numposts}++;
		$feed-&gt;{newposts}++;

		# assign it an unused page
		my $page=IkiWiki::titlepage($params{title});
		# escape slashes and periods in title so it doesn't specify
		# directory name or trigger ".." disallowing code.
		$page=~s!([/.])!"__".ord($1)."__"!eg;
		$page=$feed-&gt;{dir}."/".$page;
		($page)=$page=~/$config{wiki_file_regexp}/;
		if (! defined $page || ! length $page) {
			$page=$feed-&gt;{dir}."/item";
		}
		my $c="";
		while (exists $IkiWiki::pagecase{lc $page.$c} ||
		       -e pagefile($page.$c)) {
			$c++
		}

		# Make sure that the file name isn't too long. 
		# NB: This doesn't check for path length limits.
		eval q{use POSIX};
		my $max=POSIX::pathconf($config{srcdir}, &amp;POSIX::_PC_NAME_MAX);
		if (defined $max &amp;&amp; length(htmlpage($page)) &gt;= $max) {
			$c="";
			$page=$feed-&gt;{dir}."/item";
			while (exists $IkiWiki::pagecase{lc $page.$c} ||
			       -e pagefile($page.$c)) {
				$c++
			}
		}

		$guid-&gt;{page}=$page;
		debug(sprintf(gettext("creating new page %s"), $page));
	}
	$guid-&gt;{feed}=$feed-&gt;{name};
	
	# To write or not to write? Need to avoid writing unchanged pages
	# to avoid unneccessary rebuilding. The mtime from rss cannot be
	# trusted; let's use a digest.
	eval q{use Digest::MD5 'md5_hex'};
	error($@) if $@;
	require Encode;
	my $digest=md5_hex(Encode::encode_utf8($params{content}));
	return unless ! exists $guid-&gt;{md5} || $guid-&gt;{md5} ne $digest || $config{rebuild};
	$guid-&gt;{md5}=$digest;

	# Create the page.
	my $template=template("aggregatepost.tmpl", blind_cache =&gt; 1);
	$template-&gt;param(title =&gt; $params{title})
		if defined $params{title} &amp;&amp; length($params{title});
	$template-&gt;param(content =&gt; htmlescape(htmlabs($params{content}, $feed-&gt;{feedurl})));
	$template-&gt;param(name =&gt; $feed-&gt;{name});
	$template-&gt;param(url =&gt; $feed-&gt;{url});
	$template-&gt;param(permalink =&gt; urlabs($params{link}, $feed-&gt;{feedurl}))
		if defined $params{link};
	if (ref $feed-&gt;{tags}) {
		$template-&gt;param(tags =&gt; [map { tag =&gt; $_ }, @{$feed-&gt;{tags}}]);
	}
	writefile(htmlpage($guid-&gt;{page}), $config{srcdir},
		$template-&gt;output);

	# Set the mtime, this lets the build process get the right creation
	# time on record for the new page.
	utime $mtime, $mtime, pagefile($guid-&gt;{page}) if defined $mtime;
} #}}}

sub htmlescape ($) { #{{{
	# escape accidental wikilinks and preprocessor stuff
	my $html=shift;
	$html=~s/(?&lt;!\\)\[\[/\\\[\[/g;
	return $html;
} #}}}

sub urlabs ($$) { #{{{
	my $url=shift;
	my $urlbase=shift;

	URI-&gt;new_abs($url, $urlbase)-&gt;as_string;
} #}}}

sub htmlabs ($$) { #{{{
	# Convert links in html from relative to absolute.
	# Note that this is a heuristic, which is not specified by the rss
	# spec and may not be right for all feeds. Also, see Debian
	# bug #381359.
	my $html=shift;
	my $urlbase=shift;

	my $ret="";
	my $p = HTML::Parser-&gt;new(api_version =&gt; 3);
	$p-&gt;handler(default =&gt; sub { $ret.=join("", @_) }, "text");
	$p-&gt;handler(start =&gt; sub {
		my ($tagname, $pos, $text) = @_;
		if (ref $HTML::Tagset::linkElements{$tagname}) {
			while (4 &lt;= @$pos) {
				# use attribute sets from right to left
				# to avoid invalidating the offsets
				# when replacing the values
				my($k_offset, $k_len, $v_offset, $v_len) =
					splice(@$pos, -4);
				my $attrname = lc(substr($text, $k_offset, $k_len));
				next unless grep { $_ eq $attrname } @{$HTML::Tagset::linkElements{$tagname}};
				next unless $v_offset; # 0 v_offset means no value
				my $v = substr($text, $v_offset, $v_len);
				$v =~ s/^([\'\"])(.*)\1$/$2/;
				my $new_v=urlabs($v, $urlbase);
				$new_v =~ s/\"/&amp;quot;/g; # since we quote with ""
				substr($text, $v_offset, $v_len) = qq("$new_v");
			}
		}
		$ret.=$text;
	}, "tagname, tokenpos, text");
	$p-&gt;parse($html);
	$p-&gt;eof;

	return $ret;
} #}}}

sub remove_feeds () { #{{{
	my $page=shift;

	my %removed;
	foreach my $id (keys %feeds) {
		if ($feeds{$id}-&gt;{sourcepage} eq $page) {
			$feeds{$id}-&gt;{remove}=1;
			$removed{$id}=1;
		}
	}
} #}}}

sub pagefile ($) { #{{{
	my $page=shift;

	return "$config{srcdir}/".htmlpage($page);
} #}}}

1
</pre></body></html>