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