prune: do not prune beyond an optional base directory, and add a test
[ikiwiki.git] / IkiWiki / Plugin / aggregate.pm
1 #!/usr/bin/perl
2 # Feed aggregation plugin.
3 package IkiWiki::Plugin::aggregate;
4
5 use warnings;
6 use strict;
7 use IkiWiki 3.00;
8 use HTML::Parser;
9 use HTML::Tagset;
10 use HTML::Entities;
11 use open qw{:utf8 :std};
12
13 my %feeds;
14 my %guids;
15
16 sub import {
17         hook(type => "getopt", id => "aggregate", call => \&getopt);
18         hook(type => "getsetup", id => "aggregate", call => \&getsetup);
19         hook(type => "checkconfig", id => "aggregate", call => \&checkconfig,
20                 last => 1);
21         hook(type => "needsbuild", id => "aggregate", call => \&needsbuild);
22         hook(type => "preprocess", id => "aggregate", call => \&preprocess);
23         hook(type => "delete", id => "aggregate", call => \&delete);
24         hook(type => "savestate", id => "aggregate", call => \&savestate);
25         hook(type => "htmlize", id => "_aggregated", call => \&htmlize);
26         if (exists $config{aggregate_webtrigger} && $config{aggregate_webtrigger}) {
27                 hook(type => "cgi", id => "aggregate", call => \&cgi);
28         }
29 }
30
31 sub getopt () {
32         eval q{use Getopt::Long};
33         error($@) if $@;
34         Getopt::Long::Configure('pass_through');
35         GetOptions(
36                 "aggregate" => \$config{aggregate},
37                 "aggregateinternal!" => \$config{aggregateinternal},
38         );
39 }
40
41 sub getsetup () {
42         return
43                 plugin => {
44                         safe => 1,
45                         rebuild => undef,
46                 },
47                 aggregateinternal => {
48                         type => "boolean",
49                         example => 1,
50                         description => "enable aggregation to internal pages?",
51                         safe => 0, # enabling needs manual transition
52                         rebuild => 0,
53                 },
54                 aggregate_webtrigger => {
55                         type => "boolean",
56                         example => 0,
57                         description => "allow aggregation to be triggered via the web?",
58                         safe => 1,
59                         rebuild => 0,
60                 },
61                 cookiejar => {
62                         type => "string",
63                         example => { file => "$ENV{HOME}/.ikiwiki/cookies" },
64                         safe => 0, # hooks into perl module internals
65                         description => "cookie control",
66                 },
67 }
68
69 sub checkconfig () {
70         if (! defined $config{aggregateinternal}) {
71                 $config{aggregateinternal}=1;
72         }
73         if (! defined $config{cookiejar}) {
74                 $config{cookiejar}={ file => "$ENV{HOME}/.ikiwiki/cookies" };
75         }
76
77         # This is done here rather than in a refresh hook because it
78         # needs to run before the wiki is locked.
79         if ($config{aggregate} && ! ($config{post_commit} && 
80                                      IkiWiki::commit_hook_enabled())) {
81                 launchaggregation();
82         }
83 }
84
85 sub cgi ($) {
86         my $cgi=shift;
87
88         if (defined $cgi->param('do') &&
89             $cgi->param("do") eq "aggregate_webtrigger") {
90                 $|=1;
91                 print "Content-Type: text/plain\n\n";
92                 $config{cgi}=0;
93                 $config{verbose}=1;
94                 $config{syslog}=0;
95                 print gettext("Aggregation triggered via web.")."\n\n";
96                 if (launchaggregation()) {
97                         IkiWiki::lockwiki();
98                         IkiWiki::loadindex();
99                         require IkiWiki::Render;
100                         IkiWiki::refresh();
101                         IkiWiki::saveindex();
102                 }
103                 else {
104                         print gettext("Nothing to do right now, all feeds are up-to-date!")."\n";
105                 }
106                 exit 0;
107         }
108 }
109
110 sub launchaggregation () {
111         # See if any feeds need aggregation.
112         loadstate();
113         my @feeds=needsaggregate();
114         return unless @feeds;
115         if (! lockaggregate()) {
116                 debug("an aggregation process is already running");
117                 return;
118         }
119         # force a later rebuild of source pages
120         $IkiWiki::forcerebuild{$_->{sourcepage}}=1
121                 foreach @feeds;
122
123         # Fork a child process to handle the aggregation.
124         # The parent process will then handle building the
125         # result. This avoids messy code to clear state
126         # accumulated while aggregating.
127         defined(my $pid = fork) or error("Can't fork: $!");
128         if (! $pid) {
129                 IkiWiki::loadindex();
130                 # Aggregation happens without the main wiki lock
131                 # being held. This allows editing pages etc while
132                 # aggregation is running.
133                 aggregate(@feeds);
134
135                 IkiWiki::lockwiki;
136                 # Merge changes, since aggregation state may have
137                 # changed on disk while the aggregation was happening.
138                 mergestate();
139                 expire();
140                 savestate();
141                 IkiWiki::unlockwiki;
142                 exit 0;
143         }
144         waitpid($pid,0);
145         if ($?) {
146                 error "aggregation failed with code $?";
147         }
148
149         clearstate();
150         unlockaggregate();
151
152         return 1;
153 }
154
155 #  Pages with extension _aggregated have plain html markup, pass through.
156 sub htmlize (@) {
157         my %params=@_;
158         return $params{content};
159 }
160
161 # Used by ikiwiki-transition aggregateinternal.
162 sub migrate_to_internal {
163         if (! lockaggregate()) {
164                 error("an aggregation process is currently running");
165         }
166
167         IkiWiki::lockwiki();
168         loadstate();
169         $config{verbose}=1;
170
171         foreach my $data (values %guids) {
172                 next unless $data->{page};
173                 next if $data->{expired};
174                 
175                 $config{aggregateinternal} = 0;
176                 my $oldname = "$config{srcdir}/".htmlfn($data->{page});
177                 if (! -e $oldname) {
178                         $oldname = $IkiWiki::Plugin::transient::transientdir."/".htmlfn($data->{page});
179                 }
180
181                 my $oldoutput = $config{destdir}."/".IkiWiki::htmlpage($data->{page});
182                 
183                 $config{aggregateinternal} = 1;
184                 my $newname = $IkiWiki::Plugin::transient::transientdir."/".htmlfn($data->{page});
185                 
186                 debug "moving $oldname -> $newname";
187                 if (-e $newname) {
188                         if (-e $oldname) {
189                                 error("$newname already exists");
190                         }
191                         else {
192                                 debug("already renamed to $newname?");
193                         }
194                 }
195                 elsif (-e $oldname) {
196                         rename($oldname, $newname) || error("$!");
197                 }
198                 else {
199                         debug("$oldname not found");
200                 }
201                 if (-e $oldoutput) {
202                         require IkiWiki::Render;
203                         debug("removing output file $oldoutput");
204                         IkiWiki::prune($oldoutput, $config{destdir});
205                 }
206         }
207         
208         savestate();
209         IkiWiki::unlockwiki;
210         
211         unlockaggregate();
212 }
213
214 sub needsbuild (@) {
215         my $needsbuild=shift;
216         
217         loadstate();
218
219         foreach my $feed (values %feeds) {
220                 if (exists $pagesources{$feed->{sourcepage}} && 
221                     grep { $_ eq $pagesources{$feed->{sourcepage}} } @$needsbuild) {
222                         # Mark all feeds originating on this page as 
223                         # not yet seen; preprocess will unmark those that
224                         # still exist.
225                         markunseen($feed->{sourcepage});
226                 }
227         }
228
229         return $needsbuild;
230 }
231
232 sub preprocess (@) {
233         my %params=@_;
234
235         foreach my $required (qw{name url}) {
236                 if (! exists $params{$required}) {
237                         error sprintf(gettext("missing %s parameter"), $required)
238                 }
239         }
240
241         my $feed={};
242         my $name=$params{name};
243         if (exists $feeds{$name}) {
244                 $feed=$feeds{$name};
245         }
246         else {
247                 $feeds{$name}=$feed;
248         }
249         $feed->{name}=$name;
250         $feed->{sourcepage}=$params{page};
251         $feed->{url}=$params{url};
252         my $dir=exists $params{dir} ? $params{dir} : $params{page}."/".titlepage($params{name});
253         $dir=~s/^\/+//;
254         ($dir)=$dir=~/$config{wiki_file_regexp}/;
255         $feed->{dir}=$dir;
256         $feed->{feedurl}=defined $params{feedurl} ? $params{feedurl} : "";
257         $feed->{updateinterval}=defined $params{updateinterval} ? $params{updateinterval} * 60 : 15 * 60;
258         $feed->{expireage}=defined $params{expireage} ? $params{expireage} : 0;
259         $feed->{expirecount}=defined $params{expirecount} ? $params{expirecount} : 0;
260         if (exists $params{template}) {
261                 $params{template}=~s/[^-_a-zA-Z0-9]+//g;
262         }
263         else {
264                 $params{template} = "aggregatepost"
265         }
266         $feed->{template}=$params{template} . ".tmpl";
267         delete $feed->{unseen};
268         $feed->{lastupdate}=0 unless defined $feed->{lastupdate};
269         $feed->{lasttry}=$feed->{lastupdate} unless defined $feed->{lasttry};
270         $feed->{numposts}=0 unless defined $feed->{numposts};
271         $feed->{newposts}=0 unless defined $feed->{newposts};
272         $feed->{message}=gettext("new feed") unless defined $feed->{message};
273         $feed->{error}=0 unless defined $feed->{error};
274         $feed->{tags}=[];
275         while (@_) {
276                 my $key=shift;
277                 my $value=shift;
278                 if ($key eq 'tag') {
279                         push @{$feed->{tags}}, $value;
280                 }
281         }
282
283         return "<a href=\"".$feed->{url}."\">".$feed->{name}."</a>: ".
284                ($feed->{error} ? "<em>" : "").$feed->{message}.
285                ($feed->{error} ? "</em>" : "").
286                " (".$feed->{numposts}." ".gettext("posts").
287                ($feed->{newposts} ? "; ".$feed->{newposts}.
288                                     " ".gettext("new") : "").
289                ")";
290 }
291
292 sub delete (@) {
293         my @files=@_;
294
295         # Remove feed data for removed pages.
296         foreach my $file (@files) {
297                 my $page=pagename($file);
298                 markunseen($page);
299         }
300 }
301
302 sub markunseen ($) {
303         my $page=shift;
304
305         foreach my $id (keys %feeds) {
306                 if ($feeds{$id}->{sourcepage} eq $page) {
307                         $feeds{$id}->{unseen}=1;
308                 }
309         }
310 }
311
312 my $state_loaded=0;
313
314 sub loadstate () {
315         return if $state_loaded;
316         $state_loaded=1;
317         if (-e "$config{wikistatedir}/aggregate") {
318                 open(IN, "<", "$config{wikistatedir}/aggregate") ||
319                         die "$config{wikistatedir}/aggregate: $!";
320                 while (<IN>) {
321                         $_=IkiWiki::possibly_foolish_untaint($_);
322                         chomp;
323                         my $data={};
324                         foreach my $i (split(/ /, $_)) {
325                                 my ($field, $val)=split(/=/, $i, 2);
326                                 if ($field eq "name" || $field eq "feed" ||
327                                     $field eq "guid" || $field eq "message") {
328                                         $data->{$field}=decode_entities($val, " \t\n");
329                                 }
330                                 elsif ($field eq "tag") {
331                                         push @{$data->{tags}}, $val;
332                                 }
333                                 else {
334                                         $data->{$field}=$val;
335                                 }
336                         }
337                         
338                         if (exists $data->{name}) {
339                                 $feeds{$data->{name}}=$data;
340                         }
341                         elsif (exists $data->{guid}) {
342                                 $guids{$data->{guid}}=$data;
343                         }
344                 }
345
346                 close IN;
347         }
348 }
349
350 sub savestate () {
351         return unless $state_loaded;
352         garbage_collect();
353         my $newfile="$config{wikistatedir}/aggregate.new";
354         my $cleanup = sub { unlink($newfile) };
355         open (OUT, ">", $newfile) || error("open $newfile: $!", $cleanup);
356         foreach my $data (values %feeds, values %guids) {
357                 my @line;
358                 foreach my $field (keys %$data) {
359                         if ($field eq "name" || $field eq "feed" ||
360                             $field eq "guid" || $field eq "message") {
361                                 push @line, "$field=".encode_entities($data->{$field}, " \t\n");
362                         }
363                         elsif ($field eq "tags") {
364                                 push @line, "tag=$_" foreach @{$data->{tags}};
365                         }
366                         else {
367                                 push @line, "$field=".$data->{$field}
368                                         if defined $data->{$field};
369                         }
370                 }
371                 print OUT join(" ", @line)."\n" || error("write $newfile: $!", $cleanup);
372         }
373         close OUT || error("save $newfile: $!", $cleanup);
374         rename($newfile, "$config{wikistatedir}/aggregate") ||
375                 error("rename $newfile: $!", $cleanup);
376
377         my $timestamp=undef;
378         foreach my $feed (keys %feeds) {
379                 my $t=$feeds{$feed}->{lastupdate}+$feeds{$feed}->{updateinterval};
380                 if (! defined $timestamp || $timestamp > $t) {
381                         $timestamp=$t;
382                 }
383         }
384         $newfile=~s/\.new$/time/;
385         open (OUT, ">", $newfile) || error("open $newfile: $!", $cleanup);
386         if (defined $timestamp) {
387                 print OUT $timestamp."\n";
388         }
389         close OUT || error("save $newfile: $!", $cleanup);
390 }
391
392 sub garbage_collect () {
393         foreach my $name (keys %feeds) {
394                 # remove any feeds that were not seen while building the pages
395                 # that used to contain them
396                 if ($feeds{$name}->{unseen}) {
397                         delete $feeds{$name};
398                 }
399         }
400
401         foreach my $guid (values %guids) {
402                 # any guid whose feed is gone should be removed
403                 if (! exists $feeds{$guid->{feed}}) {
404                         if (exists $guid->{page}) {
405                                 unlink $IkiWiki::Plugin::transient::transientdir."/".htmlfn($guid->{page})
406                                         || unlink "$config{srcdir}/".htmlfn($guid->{page});
407                         }
408                         delete $guids{$guid->{guid}};
409                 }
410                 # handle expired guids
411                 elsif ($guid->{expired} && exists $guid->{page}) {
412                         unlink "$config{srcdir}/".htmlfn($guid->{page});
413                         unlink $IkiWiki::Plugin::transient::transientdir."/".htmlfn($guid->{page});
414                         delete $guid->{page};
415                         delete $guid->{md5};
416                 }
417         }
418 }
419
420 sub mergestate () {
421         # Load the current state in from disk, and merge into it
422         # values from the state in memory that might have changed
423         # during aggregation.
424         my %myfeeds=%feeds;
425         my %myguids=%guids;
426         clearstate();
427         loadstate();
428
429         # All that can change in feed state during aggregation is a few
430         # fields.
431         foreach my $name (keys %myfeeds) {
432                 if (exists $feeds{$name}) {
433                         foreach my $field (qw{message lastupdate lasttry
434                                               numposts newposts error}) {
435                                 $feeds{$name}->{$field}=$myfeeds{$name}->{$field};
436                         }
437                 }
438         }
439
440         # New guids can be created during aggregation.
441         # Guids have a few fields that may be updated during aggregation.
442         # It's also possible that guids were removed from the on-disk state
443         # while the aggregation was in process. That would only happen if
444         # their feed was also removed, so any removed guids added back here
445         # will be garbage collected later.
446         foreach my $guid (keys %myguids) {
447                 if (! exists $guids{$guid}) {
448                         $guids{$guid}=$myguids{$guid};
449                 }
450                 else {
451                         foreach my $field (qw{md5}) {
452                                 $guids{$guid}->{$field}=$myguids{$guid}->{$field};
453                         }
454                 }
455         }
456 }
457
458 sub clearstate () {
459         %feeds=();
460         %guids=();
461         $state_loaded=0;
462 }
463
464 sub expire () {
465         foreach my $feed (values %feeds) {
466                 next unless $feed->{expireage} || $feed->{expirecount};
467                 my $count=0;
468                 my %seen;
469                 foreach my $item (sort { ($IkiWiki::pagectime{$b->{page}} || 0) <=> ($IkiWiki::pagectime{$a->{page}} || 0) }
470                                   grep { exists $_->{page} && $_->{feed} eq $feed->{name} }
471                                   values %guids) {
472                         if ($feed->{expireage}) {
473                                 my $days_old = (time - ($IkiWiki::pagectime{$item->{page}} || 0)) / 60 / 60 / 24;
474                                 if ($days_old > $feed->{expireage}) {
475                                         debug(sprintf(gettext("expiring %s (%s days old)"),
476                                                 $item->{page}, int($days_old)));
477                                         $item->{expired}=1;
478                                 }
479                         }
480                         elsif ($feed->{expirecount} &&
481                                $count >= $feed->{expirecount}) {
482                                 debug(sprintf(gettext("expiring %s"), $item->{page}));
483                                 $item->{expired}=1;
484                         }
485                         else {
486                                 if (! $seen{$item->{page}}) {
487                                         $seen{$item->{page}}=1;
488                                         $count++;
489                                 }
490                         }
491                 }
492         }
493 }
494
495 sub needsaggregate () {
496         return values %feeds if $config{rebuild};
497         return grep { time - $_->{lastupdate} >= $_->{updateinterval} } values %feeds;
498 }
499
500 sub aggregate (@) {
501         eval q{use Net::INET6Glue::INET_is_INET6}; # may not be available
502         eval q{use XML::Feed};
503         error($@) if $@;
504         eval q{use URI::Fetch};
505         error($@) if $@;
506
507         foreach my $feed (@_) {
508                 $feed->{lasttry}=time;
509                 $feed->{newposts}=0;
510                 $feed->{message}=sprintf(gettext("last checked %s"),
511                         displaytime($feed->{lasttry}));
512                 $feed->{error}=0;
513
514                 debug(sprintf(gettext("checking feed %s ..."), $feed->{name}));
515
516                 if (! length $feed->{feedurl}) {
517                         my @urls=XML::Feed->find_feeds($feed->{url});
518                         if (! @urls) {
519                                 $feed->{message}=sprintf(gettext("could not find feed at %s"), $feed->{url});
520                                 $feed->{error}=1;
521                                 debug($feed->{message});
522                                 next;
523                         }
524                         $feed->{feedurl}=pop @urls;
525                 }
526                 my $res=URI::Fetch->fetch($feed->{feedurl},
527                         UserAgent => LWP::UserAgent->new(
528                                 cookie_jar => $config{cookiejar},
529                         ),
530                 );
531                 if (! $res) {
532                         $feed->{message}=URI::Fetch->errstr;
533                         $feed->{error}=1;
534                         debug($feed->{message});
535                         next;
536                 }
537
538                 # lastupdate is only set if we were able to contact the server
539                 $feed->{lastupdate}=$feed->{lasttry};
540
541                 if ($res->status == URI::Fetch::URI_GONE()) {
542                         $feed->{message}=gettext("feed not found");
543                         $feed->{error}=1;
544                         debug($feed->{message});
545                         next;
546                 }
547                 my $content=$res->content;
548                 my $f=eval{XML::Feed->parse(\$content)};
549                 if ($@) {
550                         # One common cause of XML::Feed crashing is a feed
551                         # that contains invalid UTF-8 sequences. Convert
552                         # feed to ascii to try to work around.
553                         $feed->{message}.=" ".sprintf(gettext("(invalid UTF-8 stripped from feed)"));
554                         $f=eval {
555                                 $content=Encode::decode_utf8($content, 0);
556                                 XML::Feed->parse(\$content)
557                         };
558                 }
559                 if ($@) {
560                         # Another possibility is badly escaped entities.
561                         $feed->{message}.=" ".sprintf(gettext("(feed entities escaped)"));
562                         $content=~s/\&(?!amp)(\w+);/&amp;$1;/g;
563                         $f=eval {
564                                 $content=Encode::decode_utf8($content, 0);
565                                 XML::Feed->parse(\$content)
566                         };
567                 }
568                 if ($@) {
569                         $feed->{message}=gettext("feed crashed XML::Feed!")." ($@)";
570                         $feed->{error}=1;
571                         debug($feed->{message});
572                         next;
573                 }
574                 if (! $f) {
575                         $feed->{message}=XML::Feed->errstr;
576                         $feed->{error}=1;
577                         debug($feed->{message});
578                         next;
579                 }
580
581                 foreach my $entry ($f->entries) {
582                         # XML::Feed doesn't work around XML::Atom's bizarre
583                         # API, so we will. Real unicode strings? Yes please.
584                         # See [[bugs/Aggregated_Atom_feeds_are_double-encoded]]
585                         local $XML::Atom::ForceUnicode = 1;
586
587                         my $c=$entry->content;
588                         # atom feeds may have no content, only a summary
589                         if (! defined $c && ref $entry->summary) {
590                                 $c=$entry->summary;
591                         }
592
593                         add_page(
594                                 feed => $feed,
595                                 copyright => $f->copyright,
596                                 title => defined $entry->title ? decode_entities($entry->title) : "untitled",
597                                 link => $entry->link,
598                                 content => (defined $c && defined $c->body) ? $c->body : "",
599                                 guid => defined $entry->id ? $entry->id : time."_".$feed->{name},
600                                 ctime => $entry->issued ? ($entry->issued->epoch || time) : time,
601                                 base => (defined $c && $c->can("base")) ? $c->base : undef,
602                         );
603                 }
604         }
605 }
606
607 sub add_page (@) {
608         my %params=@_;
609         
610         my $feed=$params{feed};
611         my $guid={};
612         my $mtime;
613         if (exists $guids{$params{guid}}) {
614                 # updating an existing post
615                 $guid=$guids{$params{guid}};
616                 return if $guid->{expired};
617                 write_page($feed, $guid, $mtime, \%params);
618         }
619         else {
620                 # new post
621                 $guid->{guid}=$params{guid};
622                 $guids{$params{guid}}=$guid;
623                 $mtime=$params{ctime};
624                 $feed->{numposts}++;
625                 $feed->{newposts}++;
626
627                 # assign it an unused page
628                 my $page=titlepage($params{title});
629                 # escape slashes and periods in title so it doesn't specify
630                 # directory name or trigger ".." disallowing code.
631                 $page=~s!([/.])!"__".ord($1)."__"!eg;
632                 $page=$feed->{dir}."/".$page;
633                 ($page)=$page=~/$config{wiki_file_regexp}/;
634                 if (! defined $page || ! length $page) {
635                         $page=$feed->{dir}."/item";
636                 }
637                 my $c="";
638                 while (exists $IkiWiki::pagecase{lc $page.$c} ||
639                        -e $IkiWiki::Plugin::transient::transientdir."/".htmlfn($page.$c) ||
640                        -e "$config{srcdir}/".htmlfn($page.$c)) {
641                         $c++
642                 }
643
644                 $guid->{page}=$page;
645                 eval { write_page($feed, $guid, $mtime, \%params) };
646                 if ($@) {
647                         # assume failure was due to a too long filename
648                         # (or o
649                         $c="";
650                         $page=$feed->{dir}."/item";
651                         while (exists $IkiWiki::pagecase{lc $page.$c} ||
652                               -e $IkiWiki::Plugin::transient::transientdir."/".htmlfn($page.$c) ||
653                               -e "$config{srcdir}/".htmlfn($page.$c)) {
654                                 $c++
655                         }
656
657                         $guid->{page}=$page;
658                         write_page($feed, $guid, $mtime, \%params);
659                 }
660
661                 debug(sprintf(gettext("creating new page %s"), $page));
662         }
663 }
664
665 sub write_page ($$$$$) {
666         my $feed=shift;
667         my $guid=shift;
668         my $mtime=shift;
669         my %params=%{shift()};
670
671         $guid->{feed}=$feed->{name};
672         
673         # To write or not to write? Need to avoid writing unchanged pages
674         # to avoid unneccessary rebuilding. The mtime from rss cannot be
675         # trusted; let's use a digest.
676         eval q{use Digest::MD5 'md5_hex'};
677         error($@) if $@;
678         require Encode;
679         my $digest=md5_hex(Encode::encode_utf8($params{content}));
680         return unless ! exists $guid->{md5} || $guid->{md5} ne $digest || $config{rebuild};
681         $guid->{md5}=$digest;
682
683         # Create the page.
684         my $template;
685         eval {
686                 $template=template($feed->{template}, blind_cache => 1);
687         };
688         if ($@) {
689                 print STDERR gettext("failed to process template:")." $@";
690                 return;
691         }
692         $template->param(title => $params{title})
693                 if defined $params{title} && length($params{title});
694         $template->param(content => wikiescape(htmlabs($params{content},
695                 defined $params{base} ? $params{base} : $feed->{feedurl})));
696         $template->param(name => $feed->{name});
697         $template->param(url => $feed->{url});
698         $template->param(copyright => $params{copyright})
699                 if defined $params{copyright} && length $params{copyright};
700         $template->param(permalink => IkiWiki::urlabs($params{link}, $feed->{feedurl}))
701                 if defined $params{link};
702         if (ref $feed->{tags}) {
703                 $template->param(tags => [map { tag => $_ }, @{$feed->{tags}}]);
704         }
705         writefile(htmlfn($guid->{page}),
706                 $IkiWiki::Plugin::transient::transientdir, $template->output);
707
708         if (defined $mtime && $mtime <= time) {
709                 # Set the mtime, this lets the build process get the right
710                 # creation time on record for the new page.
711                 utime $mtime, $mtime,
712                         $IkiWiki::Plugin::transient::transientdir."/".htmlfn($guid->{page});
713                 # Store it in pagectime for expiry code to use also.
714                 $IkiWiki::pagectime{$guid->{page}}=$mtime
715                         unless exists $IkiWiki::pagectime{$guid->{page}};
716         }
717         else {
718                 # Dummy value for expiry code.
719                 $IkiWiki::pagectime{$guid->{page}}=time
720                         unless exists $IkiWiki::pagectime{$guid->{page}};
721         }
722 }
723
724 sub wikiescape ($) {
725         # escape accidental wikilinks and preprocessor stuff
726         return encode_entities(shift, '\[\]');
727 }
728
729 sub htmlabs ($$) {
730         # Convert links in html from relative to absolute.
731         # Note that this is a heuristic, which is not specified by the rss
732         # spec and may not be right for all feeds. Also, see Debian
733         # bug #381359.
734         my $html=shift;
735         my $urlbase=shift;
736
737         my $ret="";
738         my $p = HTML::Parser->new(api_version => 3);
739         $p->handler(default => sub { $ret.=join("", @_) }, "text");
740         $p->handler(start => sub {
741                 my ($tagname, $pos, $text) = @_;
742                 if (ref $HTML::Tagset::linkElements{$tagname}) {
743                         while (4 <= @$pos) {
744                                 # use attribute sets from right to left
745                                 # to avoid invalidating the offsets
746                                 # when replacing the values
747                                 my($k_offset, $k_len, $v_offset, $v_len) =
748                                         splice(@$pos, -4);
749                                 my $attrname = lc(substr($text, $k_offset, $k_len));
750                                 next unless grep { $_ eq $attrname } @{$HTML::Tagset::linkElements{$tagname}};
751                                 next unless $v_offset; # 0 v_offset means no value
752                                 my $v = substr($text, $v_offset, $v_len);
753                                 $v =~ s/^([\'\"])(.*)\1$/$2/;
754                                 my $new_v=IkiWiki::urlabs($v, $urlbase);
755                                 $new_v =~ s/\"/&quot;/g; # since we quote with ""
756                                 substr($text, $v_offset, $v_len) = qq("$new_v");
757                         }
758                 }
759                 $ret.=$text;
760         }, "tagname, tokenpos, text");
761         $p->parse($html);
762         $p->eof;
763
764         return $ret;
765 }
766
767 sub htmlfn ($) {
768         return shift().".".($config{aggregateinternal} ? "_aggregated" : $config{htmlext});
769 }
770
771 my $aggregatelock;
772
773 sub lockaggregate () {
774         # Take an exclusive lock to prevent multiple concurrent aggregators.
775         # Returns true if the lock was aquired.
776         if (! -d $config{wikistatedir}) {
777                 mkdir($config{wikistatedir});
778         }
779         open($aggregatelock, '>', "$config{wikistatedir}/aggregatelock") ||
780                 error ("cannot open to $config{wikistatedir}/aggregatelock: $!");
781         if (! flock($aggregatelock, 2 | 4)) { # LOCK_EX | LOCK_NB
782                 close($aggregatelock) || error("failed closing aggregatelock: $!");
783                 return 0;
784         }
785         return 1;
786 }
787
788 sub unlockaggregate () {
789         return close($aggregatelock) if $aggregatelock;
790         return;
791 }
792
793 1