summaryrefslogtreecommitdiff
path: root/IkiWiki.pm
blob: 70fc6ff736cf7ef9a19104b75ba0d952c1b8942d (plain)
  1. #!/usr/bin/perl
  2. package IkiWiki;
  3. use warnings;
  4. use strict;
  5. use Encode;
  6. use HTML::Entities;
  7. use URI::Escape q{uri_escape_utf8};
  8. use POSIX;
  9. use open qw{:utf8 :std};
  10. use vars qw{%config %links %oldlinks %pagemtime %pagectime %pagecase
  11. %renderedfiles %oldrenderedfiles %pagesources %destsources
  12. %depends %hooks %forcerebuild $gettext_obj};
  13. use Exporter q{import};
  14. our @EXPORT = qw(hook debug error template htmlpage add_depends pagespec_match
  15. bestlink htmllink readfile writefile pagetype srcfile pagename
  16. displaytime will_render gettext urlto targetpage
  17. %config %links %renderedfiles %pagesources %destsources);
  18. our $VERSION = 2.00; # plugin interface version, next is ikiwiki version
  19. our $version='unknown'; # VERSION_AUTOREPLACE done by Makefile, DNE
  20. my $installdir=''; # INSTALLDIR_AUTOREPLACE done by Makefile, DNE
  21. # Optimisation.
  22. use Memoize;
  23. memoize("abs2rel");
  24. memoize("pagespec_translate");
  25. memoize("file_pruned");
  26. sub defaultconfig () { #{{{
  27. wiki_file_prune_regexps => [qr/\.\./, qr/^\./, qr/\/\./,
  28. qr/\.x?html?$/, qr/\.ikiwiki-new$/,
  29. qr/(^|\/).svn\//, qr/.arch-ids\//, qr/{arch}\//,
  30. qr/\.dpkg-tmp$/],
  31. wiki_link_regexp => qr/\[\[(?:([^\]\|]+)\|)?([^\s\]#]+)(?:#([^\s\]]+))?\]\]/,
  32. wiki_file_regexp => qr/(^[-[:alnum:]_.:\/+]+$)/,
  33. web_commit_regexp => qr/^web commit (by (.*?(?=: |$))|from (\d+\.\d+\.\d+\.\d+)):?(.*)/,
  34. verbose => 0,
  35. syslog => 0,
  36. wikiname => "wiki",
  37. default_pageext => "mdwn",
  38. cgi => 0,
  39. post_commit => 0,
  40. rcs => '',
  41. notify => 0,
  42. url => '',
  43. cgiurl => '',
  44. historyurl => '',
  45. diffurl => '',
  46. rss => 0,
  47. atom => 0,
  48. discussion => 1,
  49. rebuild => 0,
  50. refresh => 0,
  51. getctime => 0,
  52. w3mmode => 0,
  53. wrapper => undef,
  54. wrappermode => undef,
  55. svnrepo => undef,
  56. svnpath => "trunk",
  57. gitorigin_branch => "origin",
  58. gitmaster_branch => "master",
  59. srcdir => undef,
  60. destdir => undef,
  61. pingurl => [],
  62. templatedir => "$installdir/share/ikiwiki/templates",
  63. underlaydir => "$installdir/share/ikiwiki/basewiki",
  64. setup => undef,
  65. adminuser => undef,
  66. adminemail => undef,
  67. plugin => [qw{mdwn inline htmlscrubber passwordauth signinedit
  68. lockedit conditional}],
  69. timeformat => '%c',
  70. locale => undef,
  71. sslcookie => 0,
  72. httpauth => 0,
  73. userdir => "",
  74. usedirs => 0,
  75. numbacklinks => 10,
  76. } #}}}
  77. sub checkconfig () { #{{{
  78. # locale stuff; avoid LC_ALL since it overrides everything
  79. if (defined $ENV{LC_ALL}) {
  80. $ENV{LANG} = $ENV{LC_ALL};
  81. delete $ENV{LC_ALL};
  82. }
  83. if (defined $config{locale}) {
  84. if (POSIX::setlocale(&POSIX::LC_ALL, $config{locale})) {
  85. $ENV{LANG}=$config{locale};
  86. $gettext_obj=undef;
  87. }
  88. }
  89. if ($config{w3mmode}) {
  90. eval q{use Cwd q{abs_path}};
  91. error($@) if $@;
  92. $config{srcdir}=possibly_foolish_untaint(abs_path($config{srcdir}));
  93. $config{destdir}=possibly_foolish_untaint(abs_path($config{destdir}));
  94. $config{cgiurl}="file:///\$LIB/ikiwiki-w3m.cgi/".$config{cgiurl}
  95. unless $config{cgiurl} =~ m!file:///!;
  96. $config{url}="file://".$config{destdir};
  97. }
  98. if ($config{cgi} && ! length $config{url}) {
  99. error(gettext("Must specify url to wiki with --url when using --cgi"));
  100. }
  101. $config{wikistatedir}="$config{srcdir}/.ikiwiki"
  102. unless exists $config{wikistatedir};
  103. if ($config{rcs}) {
  104. eval qq{require IkiWiki::Rcs::$config{rcs}};
  105. if ($@) {
  106. error("Failed to load RCS module IkiWiki::Rcs::$config{rcs}: $@");
  107. }
  108. }
  109. else {
  110. require IkiWiki::Rcs::Stub;
  111. }
  112. run_hooks(checkconfig => sub { shift->() });
  113. } #}}}
  114. sub loadplugins () { #{{{
  115. loadplugin($_) foreach @{$config{plugin}};
  116. run_hooks(getopt => sub { shift->() });
  117. if (grep /^-/, @ARGV) {
  118. print STDERR "Unknown option: $_\n"
  119. foreach grep /^-/, @ARGV;
  120. usage();
  121. }
  122. } #}}}
  123. sub loadplugin ($) { #{{{
  124. my $plugin=shift;
  125. return if grep { $_ eq $plugin} @{$config{disable_plugins}};
  126. my $mod="IkiWiki::Plugin::".possibly_foolish_untaint($plugin);
  127. eval qq{use $mod};
  128. if ($@) {
  129. error("Failed to load plugin $mod: $@");
  130. }
  131. } #}}}
  132. sub error ($;$) { #{{{
  133. my $message=shift;
  134. my $cleaner=shift;
  135. if ($config{cgi}) {
  136. print "Content-type: text/html\n\n";
  137. print misctemplate(gettext("Error"),
  138. "<p>".gettext("Error").": $message</p>");
  139. }
  140. log_message('err' => $message) if $config{syslog};
  141. if (defined $cleaner) {
  142. $cleaner->();
  143. }
  144. die $message."\n";
  145. } #}}}
  146. sub debug ($) { #{{{
  147. return unless $config{verbose};
  148. log_message(debug => @_);
  149. } #}}}
  150. my $log_open=0;
  151. sub log_message ($$) { #{{{
  152. my $type=shift;
  153. if ($config{syslog}) {
  154. require Sys::Syslog;
  155. unless ($log_open) {
  156. Sys::Syslog::setlogsock('unix');
  157. Sys::Syslog::openlog('ikiwiki', '', 'user');
  158. $log_open=1;
  159. }
  160. eval {
  161. Sys::Syslog::syslog($type, "[$config{wikiname}] %s", join(" ", @_));
  162. };
  163. }
  164. elsif (! $config{cgi}) {
  165. print "@_\n";
  166. }
  167. else {
  168. print STDERR "@_\n";
  169. }
  170. } #}}}
  171. sub possibly_foolish_untaint ($) { #{{{
  172. my $tainted=shift;
  173. my ($untainted)=$tainted=~/(.*)/;
  174. return $untainted;
  175. } #}}}
  176. sub basename ($) { #{{{
  177. my $file=shift;
  178. $file=~s!.*/+!!;
  179. return $file;
  180. } #}}}
  181. sub dirname ($) { #{{{
  182. my $file=shift;
  183. $file=~s!/*[^/]+$!!;
  184. return $file;
  185. } #}}}
  186. sub pagetype ($) { #{{{
  187. my $page=shift;
  188. if ($page =~ /\.([^.]+)$/) {
  189. return $1 if exists $hooks{htmlize}{$1};
  190. }
  191. return undef;
  192. } #}}}
  193. sub pagename ($) { #{{{
  194. my $file=shift;
  195. my $type=pagetype($file);
  196. my $page=$file;
  197. $page=~s/\Q.$type\E*$// if defined $type;
  198. return $page;
  199. } #}}}
  200. sub targetpage ($$) { #{{{
  201. my $page=shift;
  202. my $ext=shift;
  203. if (! $config{usedirs} || $page =~ /^index$/ ) {
  204. return $page.".".$ext;
  205. } else {
  206. return $page."/index.".$ext;
  207. }
  208. } #}}}
  209. sub htmlpage ($) { #{{{
  210. my $page=shift;
  211. return targetpage($page, "html");
  212. } #}}}
  213. sub srcfile ($) { #{{{
  214. my $file=shift;
  215. return "$config{srcdir}/$file" if -e "$config{srcdir}/$file";
  216. return "$config{underlaydir}/$file" if -e "$config{underlaydir}/$file";
  217. error("internal error: $file cannot be found in $config{srcdir} or $config{underlaydir}");
  218. } #}}}
  219. sub readfile ($;$$) { #{{{
  220. my $file=shift;
  221. my $binary=shift;
  222. my $wantfd=shift;
  223. if (-l $file) {
  224. error("cannot read a symlink ($file)");
  225. }
  226. local $/=undef;
  227. open (IN, $file) || error("failed to read $file: $!");
  228. binmode(IN) if ($binary);
  229. return \*IN if $wantfd;
  230. my $ret=<IN>;
  231. close IN || error("failed to read $file: $!");
  232. return $ret;
  233. } #}}}
  234. sub writefile ($$$;$$) { #{{{
  235. my $file=shift; # can include subdirs
  236. my $destdir=shift; # directory to put file in
  237. my $content=shift;
  238. my $binary=shift;
  239. my $writer=shift;
  240. my $test=$file;
  241. while (length $test) {
  242. if (-l "$destdir/$test") {
  243. error("cannot write to a symlink ($test)");
  244. }
  245. $test=dirname($test);
  246. }
  247. my $newfile="$destdir/$file.ikiwiki-new";
  248. if (-l $newfile) {
  249. error("cannot write to a symlink ($newfile)");
  250. }
  251. my $dir=dirname($newfile);
  252. if (! -d $dir) {
  253. my $d="";
  254. foreach my $s (split(m!/+!, $dir)) {
  255. $d.="$s/";
  256. if (! -d $d) {
  257. mkdir($d) || error("failed to create directory $d: $!");
  258. }
  259. }
  260. }
  261. my $cleanup = sub { unlink($newfile) };
  262. open (OUT, ">$newfile") || error("failed to write $newfile: $!", $cleanup);
  263. binmode(OUT) if ($binary);
  264. if ($writer) {
  265. $writer->(\*OUT, $cleanup);
  266. }
  267. else {
  268. print OUT $content or error("failed writing to $newfile: $!", $cleanup);
  269. }
  270. close OUT || error("failed saving $newfile: $!", $cleanup);
  271. rename($newfile, "$destdir/$file") ||
  272. error("failed renaming $newfile to $destdir/$file: $!", $cleanup);
  273. } #}}}
  274. my %cleared;
  275. sub will_render ($$;$) { #{{{
  276. my $page=shift;
  277. my $dest=shift;
  278. my $clear=shift;
  279. # Important security check.
  280. if (-e "$config{destdir}/$dest" && ! $config{rebuild} &&
  281. ! grep { $_ eq $dest } (@{$renderedfiles{$page}}, @{$oldrenderedfiles{$page}})) {
  282. error("$config{destdir}/$dest independently created, not overwriting with version from $page");
  283. }
  284. if (! $clear || $cleared{$page}) {
  285. $renderedfiles{$page}=[$dest, grep { $_ ne $dest } @{$renderedfiles{$page}}];
  286. }
  287. else {
  288. foreach my $old (@{$renderedfiles{$page}}) {
  289. delete $destsources{$old};
  290. }
  291. $renderedfiles{$page}=[$dest];
  292. $cleared{$page}=1;
  293. }
  294. $destsources{$dest}=$page;
  295. } #}}}
  296. sub bestlink ($$) { #{{{
  297. my $page=shift;
  298. my $link=shift;
  299. my $cwd=$page;
  300. if ($link=~s/^\/+//) {
  301. # absolute links
  302. $cwd="";
  303. }
  304. do {
  305. my $l=$cwd;
  306. $l.="/" if length $l;
  307. $l.=$link;
  308. if (exists $links{$l}) {
  309. return $l;
  310. }
  311. elsif (exists $pagecase{lc $l}) {
  312. return $pagecase{lc $l};
  313. }
  314. } while $cwd=~s!/?[^/]+$!!;
  315. if (length $config{userdir}) {
  316. my $l = "$config{userdir}/".lc($link);
  317. if (exists $links{$l}) {
  318. return $l;
  319. }
  320. elsif (exists $pagecase{lc $l}) {
  321. return $pagecase{lc $l};
  322. }
  323. }
  324. #print STDERR "warning: page $page, broken link: $link\n";
  325. return "";
  326. } #}}}
  327. sub isinlinableimage ($) { #{{{
  328. my $file=shift;
  329. $file=~/\.(png|gif|jpg|jpeg)$/i;
  330. } #}}}
  331. sub pagetitle ($;$) { #{{{
  332. my $page=shift;
  333. my $unescaped=shift;
  334. if ($unescaped) {
  335. $page=~s/(__(\d+)__|_)/$1 eq '_' ? ' ' : chr($2)/eg;
  336. }
  337. else {
  338. $page=~s/(__(\d+)__|_)/$1 eq '_' ? ' ' : "&#$2;"/eg;
  339. }
  340. return $page;
  341. } #}}}
  342. sub titlepage ($) { #{{{
  343. my $title=shift;
  344. $title=~s/([^-[:alnum:]:+\/.])/$1 eq ' ' ? '_' : "__".ord($1)."__"/eg;
  345. return $title;
  346. } #}}}
  347. sub linkpage ($) { #{{{
  348. my $link=shift;
  349. $link=~s/([^-[:alnum:]:+\/._])/$1 eq ' ' ? '_' : "__".ord($1)."__"/eg;
  350. return $link;
  351. } #}}}
  352. sub cgiurl (@) { #{{{
  353. my %params=@_;
  354. return $config{cgiurl}."?".
  355. join("&amp;", map $_."=".uri_escape_utf8($params{$_}), keys %params);
  356. } #}}}
  357. sub baseurl (;$) { #{{{
  358. my $page=shift;
  359. return "$config{url}/" if ! defined $page;
  360. $page=htmlpage($page);
  361. $page=~s/[^\/]+$//;
  362. $page=~s/[^\/]+\//..\//g;
  363. return $page;
  364. } #}}}
  365. sub abs2rel ($$) { #{{{
  366. # Work around very innefficient behavior in File::Spec if abs2rel
  367. # is passed two relative paths. It's much faster if paths are
  368. # absolute! (Debian bug #376658; fixed in debian unstable now)
  369. my $path="/".shift;
  370. my $base="/".shift;
  371. require File::Spec;
  372. my $ret=File::Spec->abs2rel($path, $base);
  373. $ret=~s/^// if defined $ret;
  374. return $ret;
  375. } #}}}
  376. sub displaytime ($) { #{{{
  377. my $time=shift;
  378. # strftime doesn't know about encodings, so make sure
  379. # its output is properly treated as utf8
  380. return decode_utf8(POSIX::strftime(
  381. $config{timeformat}, localtime($time)));
  382. } #}}}
  383. sub beautify_url ($) { #{{{
  384. my $url=shift;
  385. $url =~ s!/index.html$!/!;
  386. $url =~ s!^$!./!; # Browsers don't like empty links...
  387. return $url;
  388. } #}}}
  389. sub urlto ($$) { #{{{
  390. my $to=shift;
  391. my $from=shift;
  392. if (! length $to) {
  393. return beautify_url(baseurl($from));
  394. }
  395. if (! $destsources{$to}) {
  396. $to=htmlpage($to);
  397. }
  398. my $link = abs2rel($to, dirname(htmlpage($from)));
  399. return beautify_url($link);
  400. } #}}}
  401. sub htmllink ($$$;@) { #{{{
  402. my $lpage=shift; # the page doing the linking
  403. my $page=shift; # the page that will contain the link (different for inline)
  404. my $link=shift;
  405. my %opts=@_;
  406. my $bestlink;
  407. if (! $opts{forcesubpage}) {
  408. $bestlink=bestlink($lpage, $link);
  409. }
  410. else {
  411. $bestlink="$lpage/".lc($link);
  412. }
  413. my $linktext;
  414. if (defined $opts{linktext}) {
  415. $linktext=$opts{linktext};
  416. }
  417. else {
  418. $linktext=pagetitle(basename($link));
  419. }
  420. return "<span class=\"selflink\">$linktext</span>"
  421. if length $bestlink && $page eq $bestlink;
  422. if (! $destsources{$bestlink}) {
  423. $bestlink=htmlpage($bestlink);
  424. if (! $destsources{$bestlink}) {
  425. return $linktext unless length $config{cgiurl};
  426. return "<span><a href=\"".
  427. cgiurl(
  428. do => "create",
  429. page => pagetitle(lc($link), 1),
  430. from => $lpage
  431. ).
  432. "\">?</a>$linktext</span>"
  433. }
  434. }
  435. $bestlink=abs2rel($bestlink, dirname(htmlpage($page)));
  436. $bestlink=beautify_url($bestlink);
  437. if (! $opts{noimageinline} && isinlinableimage($bestlink)) {
  438. return "<img src=\"$bestlink\" alt=\"$linktext\" />";
  439. }
  440. if (defined $opts{anchor}) {
  441. $bestlink.="#".$opts{anchor};
  442. }
  443. return "<a href=\"$bestlink\">$linktext</a>";
  444. } #}}}
  445. sub htmlize ($$$) { #{{{
  446. my $page=shift;
  447. my $type=shift;
  448. my $content=shift;
  449. if (exists $hooks{htmlize}{$type}) {
  450. $content=$hooks{htmlize}{$type}{call}->(
  451. page => $page,
  452. content => $content,
  453. );
  454. }
  455. else {
  456. error("htmlization of $type not supported");
  457. }
  458. run_hooks(sanitize => sub {
  459. $content=shift->(
  460. page => $page,
  461. content => $content,
  462. );
  463. });
  464. return $content;
  465. } #}}}
  466. sub linkify ($$$) { #{{{
  467. my $lpage=shift; # the page containing the links
  468. my $page=shift; # the page the link will end up on (different for inline)
  469. my $content=shift;
  470. $content =~ s{(\\?)$config{wiki_link_regexp}}{
  471. defined $2
  472. ? ( $1
  473. ? "[[$2|$3".($4 ? "#$4" : "")."]]"
  474. : htmllink($lpage, $page, linkpage($3),
  475. anchor => $4, linktext => pagetitle($2)))
  476. : ( $1
  477. ? "[[$3".($4 ? "#$4" : "")."]]"
  478. : htmllink($lpage, $page, linkpage($3),
  479. anchor => $4))
  480. }eg;
  481. return $content;
  482. } #}}}
  483. my %preprocessing;
  484. our $preprocess_preview=0;
  485. sub preprocess ($$$;$$) { #{{{
  486. my $page=shift; # the page the data comes from
  487. my $destpage=shift; # the page the data will appear in (different for inline)
  488. my $content=shift;
  489. my $scan=shift;
  490. my $preview=shift;
  491. # Using local because it needs to be set within any nested calls
  492. # of this function.
  493. local $preprocess_preview=$preview if defined $preview;
  494. my $handle=sub {
  495. my $escape=shift;
  496. my $command=shift;
  497. my $params=shift;
  498. if (length $escape) {
  499. return "[[$command $params]]";
  500. }
  501. elsif (exists $hooks{preprocess}{$command}) {
  502. return "" if $scan && ! $hooks{preprocess}{$command}{scan};
  503. # Note: preserve order of params, some plugins may
  504. # consider it significant.
  505. my @params;
  506. while ($params =~ /(?:(\w+)=)?(?:"""(.*?)"""|"([^"]+)"|(\S+))(?:\s+|$)/sg) {
  507. my $key=$1;
  508. my $val;
  509. if (defined $2) {
  510. $val=$2;
  511. $val=~s/\r\n/\n/mg;
  512. $val=~s/^\n+//g;
  513. $val=~s/\n+$//g;
  514. }
  515. elsif (defined $3) {
  516. $val=$3;
  517. }
  518. elsif (defined $4) {
  519. $val=$4;
  520. }
  521. if (defined $key) {
  522. push @params, $key, $val;
  523. }
  524. else {
  525. push @params, $val, '';
  526. }
  527. }
  528. if ($preprocessing{$page}++ > 3) {
  529. # Avoid loops of preprocessed pages preprocessing
  530. # other pages that preprocess them, etc.
  531. #translators: The first parameter is a
  532. #translators: preprocessor directive name,
  533. #translators: the second a page name, the
  534. #translators: third a number.
  535. return "[[".sprintf(gettext("%s preprocessing loop detected on %s at depth %i"),
  536. $command, $page, $preprocessing{$page}).
  537. "]]";
  538. }
  539. my $ret=$hooks{preprocess}{$command}{call}->(
  540. @params,
  541. page => $page,
  542. destpage => $destpage,
  543. preview => $preprocess_preview,
  544. );
  545. $preprocessing{$page}--;
  546. return $ret;
  547. }
  548. else {
  549. return "[[$command $params]]";
  550. }
  551. };
  552. $content =~ s{(\\?)\[\[(\w+)\s+((?:(?:\w+=)?(?:""".*?"""|"[^"]+"|[^\s\]]+)\s*)*)\]\]}{$handle->($1, $2, $3)}seg;
  553. return $content;
  554. } #}}}
  555. sub filter ($$) { #{{{
  556. my $page=shift;
  557. my $content=shift;
  558. run_hooks(filter => sub {
  559. $content=shift->(page => $page, content => $content);
  560. });
  561. return $content;
  562. } #}}}
  563. sub indexlink () { #{{{
  564. return "<a href=\"$config{url}\">$config{wikiname}</a>";
  565. } #}}}
  566. sub lockwiki () { #{{{
  567. # Take an exclusive lock on the wiki to prevent multiple concurrent
  568. # run issues. The lock will be dropped on program exit.
  569. if (! -d $config{wikistatedir}) {
  570. mkdir($config{wikistatedir});
  571. }
  572. open(WIKILOCK, ">$config{wikistatedir}/lockfile") ||
  573. error ("cannot write to $config{wikistatedir}/lockfile: $!");
  574. if (! flock(WIKILOCK, 2 | 4)) { # LOCK_EX | LOCK_NB
  575. debug("wiki seems to be locked, waiting for lock");
  576. my $wait=600; # arbitrary, but don't hang forever to
  577. # prevent process pileup
  578. for (1..$wait) {
  579. return if flock(WIKILOCK, 2 | 4);
  580. sleep 1;
  581. }
  582. error("wiki is locked; waited $wait seconds without lock being freed (possible stuck process or stale lock?)");
  583. }
  584. } #}}}
  585. sub unlockwiki () { #{{{
  586. close WIKILOCK;
  587. } #}}}
  588. sub commit_hook_enabled () { #{{{
  589. open(COMMITLOCK, "+>$config{wikistatedir}/commitlock") ||
  590. error ("cannot write to $config{wikistatedir}/commitlock: $!");
  591. if (! flock(COMMITLOCK, 1 | 4)) { # LOCK_SH | LOCK_NB to test
  592. close COMMITLOCK;
  593. return 0;
  594. }
  595. close COMMITLOCK;
  596. return 1;
  597. } #}}}
  598. sub disable_commit_hook () { #{{{
  599. open(COMMITLOCK, ">$config{wikistatedir}/commitlock") ||
  600. error ("cannot write to $config{wikistatedir}/commitlock: $!");
  601. if (! flock(COMMITLOCK, 2)) { # LOCK_EX
  602. error("failed to get commit lock");
  603. }
  604. } #}}}
  605. sub enable_commit_hook () { #{{{
  606. close COMMITLOCK;
  607. } #}}}
  608. sub loadindex () { #{{{
  609. open (IN, "$config{wikistatedir}/index") || return;
  610. while (<IN>) {
  611. $_=possibly_foolish_untaint($_);
  612. chomp;
  613. my %items;
  614. $items{link}=[];
  615. $items{dest}=[];
  616. foreach my $i (split(/ /, $_)) {
  617. my ($item, $val)=split(/=/, $i, 2);
  618. push @{$items{$item}}, decode_entities($val);
  619. }
  620. next unless exists $items{src}; # skip bad lines for now
  621. my $page=pagename($items{src}[0]);
  622. if (! $config{rebuild}) {
  623. $pagesources{$page}=$items{src}[0];
  624. $pagemtime{$page}=$items{mtime}[0];
  625. $oldlinks{$page}=[@{$items{link}}];
  626. $links{$page}=[@{$items{link}}];
  627. $depends{$page}=$items{depends}[0] if exists $items{depends};
  628. $destsources{$_}=$page foreach @{$items{dest}};
  629. $renderedfiles{$page}=[@{$items{dest}}];
  630. $oldrenderedfiles{$page}=[@{$items{dest}}];
  631. $pagecase{lc $page}=$page;
  632. }
  633. $pagectime{$page}=$items{ctime}[0];
  634. }
  635. close IN;
  636. } #}}}
  637. sub saveindex () { #{{{
  638. run_hooks(savestate => sub { shift->() });
  639. if (! -d $config{wikistatedir}) {
  640. mkdir($config{wikistatedir});
  641. }
  642. my $newfile="$config{wikistatedir}/index.new";
  643. my $cleanup = sub { unlink($newfile) };
  644. open (OUT, ">$newfile") || error("cannot write to $newfile: $!", $cleanup);
  645. foreach my $page (keys %pagemtime) {
  646. next unless $pagemtime{$page};
  647. my $line="mtime=$pagemtime{$page} ".
  648. "ctime=$pagectime{$page} ".
  649. "src=$pagesources{$page}";
  650. $line.=" dest=$_" foreach @{$renderedfiles{$page}};
  651. my %count;
  652. $line.=" link=$_" foreach grep { ++$count{$_} == 1 } @{$links{$page}};
  653. if (exists $depends{$page}) {
  654. $line.=" depends=".encode_entities($depends{$page}, " \t\n");
  655. }
  656. print OUT $line."\n" || error("failed writing to $newfile: $!", $cleanup);
  657. }
  658. close OUT || error("failed saving to $newfile: $!", $cleanup);
  659. rename($newfile, "$config{wikistatedir}/index") ||
  660. error("failed renaming $newfile to $config{wikistatedir}/index", $cleanup);
  661. } #}}}
  662. sub template_file ($) { #{{{
  663. my $template=shift;
  664. foreach my $dir ($config{templatedir}, "$installdir/share/ikiwiki/templates") {
  665. return "$dir/$template" if -e "$dir/$template";
  666. }
  667. return undef;
  668. } #}}}
  669. sub template_params (@) { #{{{
  670. my $filename=template_file(shift);
  671. if (! defined $filename) {
  672. return if wantarray;
  673. return "";
  674. }
  675. require HTML::Template;
  676. my @ret=(
  677. filter => sub {
  678. my $text_ref = shift;
  679. $$text_ref=&Encode::decode_utf8($$text_ref);
  680. },
  681. filename => $filename,
  682. loop_context_vars => 1,
  683. die_on_bad_params => 0,
  684. @_
  685. );
  686. return wantarray ? @ret : {@ret};
  687. } #}}}
  688. sub template ($;@) { #{{{
  689. HTML::Template->new(template_params(@_));
  690. } #}}}
  691. sub misctemplate ($$;@) { #{{{
  692. my $title=shift;
  693. my $pagebody=shift;
  694. my $template=template("misc.tmpl");
  695. $template->param(
  696. title => $title,
  697. indexlink => indexlink(),
  698. wikiname => $config{wikiname},
  699. pagebody => $pagebody,
  700. baseurl => baseurl(),
  701. @_,
  702. );
  703. run_hooks(pagetemplate => sub {
  704. shift->(page => "", destpage => "", template => $template);
  705. });
  706. return $template->output;
  707. }#}}}
  708. sub hook (@) { # {{{
  709. my %param=@_;
  710. if (! exists $param{type} || ! ref $param{call} || ! exists $param{id}) {
  711. error "hook requires type, call, and id parameters";
  712. }
  713. return if $param{no_override} && exists $hooks{$param{type}}{$param{id}};
  714. $hooks{$param{type}}{$param{id}}=\%param;
  715. } # }}}
  716. sub run_hooks ($$) { # {{{
  717. # Calls the given sub for each hook of the given type,
  718. # passing it the hook function to call.
  719. my $type=shift;
  720. my $sub=shift;
  721. if (exists $hooks{$type}) {
  722. my @deferred;
  723. foreach my $id (keys %{$hooks{$type}}) {
  724. if ($hooks{$type}{$id}{last}) {
  725. push @deferred, $id;
  726. next;
  727. }
  728. $sub->($hooks{$type}{$id}{call});
  729. }
  730. foreach my $id (@deferred) {
  731. $sub->($hooks{$type}{$id}{call});
  732. }
  733. }
  734. } #}}}
  735. sub globlist_to_pagespec ($) { #{{{
  736. my @globlist=split(' ', shift);
  737. my (@spec, @skip);
  738. foreach my $glob (@globlist) {
  739. if ($glob=~/^!(.*)/) {
  740. push @skip, $glob;
  741. }
  742. else {
  743. push @spec, $glob;
  744. }
  745. }
  746. my $spec=join(" or ", @spec);
  747. if (@skip) {
  748. my $skip=join(" and ", @skip);
  749. if (length $spec) {
  750. $spec="$skip and ($spec)";
  751. }
  752. else {
  753. $spec=$skip;
  754. }
  755. }
  756. return $spec;
  757. } #}}}
  758. sub is_globlist ($) { #{{{
  759. my $s=shift;
  760. $s=~/[^\s]+\s+([^\s]+)/ && $1 ne "and" && $1 ne "or";
  761. } #}}}
  762. sub safequote ($) { #{{{
  763. my $s=shift;
  764. $s=~s/[{}]//g;
  765. return "q{$s}";
  766. } #}}}
  767. sub add_depends ($$) { #{{{
  768. my $page=shift;
  769. my $pagespec=shift;
  770. if (! exists $depends{$page}) {
  771. $depends{$page}=$pagespec;
  772. }
  773. else {
  774. $depends{$page}=pagespec_merge($depends{$page}, $pagespec);
  775. }
  776. } # }}}
  777. sub file_pruned ($$) { #{{{
  778. require File::Spec;
  779. my $file=File::Spec->canonpath(shift);
  780. my $base=File::Spec->canonpath(shift);
  781. $file=~s#^\Q$base\E/*##;
  782. my $regexp='('.join('|', @{$config{wiki_file_prune_regexps}}).')';
  783. $file =~ m/$regexp/;
  784. } #}}}
  785. sub gettext { #{{{
  786. # Only use gettext in the rare cases it's needed.
  787. if (exists $ENV{LANG} || exists $ENV{LC_ALL} || exists $ENV{LC_MESSAGES}) {
  788. if (! $gettext_obj) {
  789. $gettext_obj=eval q{
  790. use Locale::gettext q{textdomain};
  791. Locale::gettext->domain('ikiwiki')
  792. };
  793. if ($@) {
  794. print STDERR "$@";
  795. $gettext_obj=undef;
  796. return shift;
  797. }
  798. }
  799. return $gettext_obj->get(shift);
  800. }
  801. else {
  802. return shift;
  803. }
  804. } #}}}
  805. sub pagespec_merge ($$) { #{{{
  806. my $a=shift;
  807. my $b=shift;
  808. return $a if $a eq $b;
  809. # Support for old-style GlobLists.
  810. if (is_globlist($a)) {
  811. $a=globlist_to_pagespec($a);
  812. }
  813. if (is_globlist($b)) {
  814. $b=globlist_to_pagespec($b);
  815. }
  816. return "($a) or ($b)";
  817. } #}}}
  818. sub pagespec_translate ($) { #{{{
  819. # This assumes that $page is in scope in the function
  820. # that evalulates the translated pagespec code.
  821. my $spec=shift;
  822. # Support for old-style GlobLists.
  823. if (is_globlist($spec)) {
  824. $spec=globlist_to_pagespec($spec);
  825. }
  826. # Convert spec to perl code.
  827. my $code="";
  828. while ($spec=~m/\s*(\!|\(|\)|\w+\([^\)]+\)|[^\s()]+)\s*/ig) {
  829. my $word=$1;
  830. if (lc $word eq "and") {
  831. $code.=" &&";
  832. }
  833. elsif (lc $word eq "or") {
  834. $code.=" ||";
  835. }
  836. elsif ($word eq "(" || $word eq ")" || $word eq "!") {
  837. $code.=" ".$word;
  838. }
  839. elsif ($word =~ /^(\w+)\((.*)\)$/) {
  840. if (exists $IkiWiki::PageSpec::{"match_$1"}) {
  841. $code.="IkiWiki::PageSpec::match_$1(\$page, ".safequote($2).", \@params)";
  842. }
  843. else {
  844. $code.=" 0";
  845. }
  846. }
  847. else {
  848. $code.=" IkiWiki::PageSpec::match_glob(\$page, ".safequote($word).", \@params)";
  849. }
  850. }
  851. return $code;
  852. } #}}}
  853. sub pagespec_match ($$;@) { #{{{
  854. my $page=shift;
  855. my $spec=shift;
  856. my @params=@_;
  857. # Backwards compatability with old calling convention.
  858. if (@params == 1) {
  859. unshift @params, "location";
  860. }
  861. my $ret=eval pagespec_translate($spec);
  862. return IkiWiki::FailReason->new("syntax error") if $@;
  863. return $ret;
  864. } #}}}
  865. package IkiWiki::FailReason;
  866. use overload ( #{{{
  867. '""' => sub { ${$_[0]} },
  868. '0+' => sub { 0 },
  869. '!' => sub { bless $_[0], 'IkiWiki::SuccessReason'},
  870. fallback => 1,
  871. ); #}}}
  872. sub new { #{{{
  873. bless \$_[1], $_[0];
  874. } #}}}
  875. package IkiWiki::SuccessReason;
  876. use overload ( #{{{
  877. '""' => sub { ${$_[0]} },
  878. '0+' => sub { 1 },
  879. '!' => sub { bless $_[0], 'IkiWiki::FailReason'},
  880. fallback => 1,
  881. ); #}}}
  882. sub new { #{{{
  883. bless \$_[1], $_[0];
  884. }; #}}}
  885. package IkiWiki::PageSpec;
  886. sub match_glob ($$;@) { #{{{
  887. my $page=shift;
  888. my $glob=shift;
  889. my %params=@_;
  890. my $from=exists $params{location} ? $params{location} : "";
  891. # relative matching
  892. if ($glob =~ m!^\./!) {
  893. $from=~s!/?[^/]+$!!;
  894. $glob=~s!^\./!!;
  895. $glob="$from/$glob" if length $from;
  896. }
  897. # turn glob into safe regexp
  898. $glob=quotemeta($glob);
  899. $glob=~s/\\\*/.*/g;
  900. $glob=~s/\\\?/./g;
  901. if ($page=~/^$glob$/i) {
  902. return IkiWiki::SuccessReason->new("$glob matches $page");
  903. }
  904. else {
  905. return IkiWiki::FailReason->new("$glob does not match $page");
  906. }
  907. } #}}}
  908. sub match_link ($$;@) { #{{{
  909. my $page=shift;
  910. my $link=lc(shift);
  911. my %params=@_;
  912. my $from=exists $params{location} ? $params{location} : "";
  913. # relative matching
  914. if ($link =~ m!^\.! && defined $from) {
  915. $from=~s!/?[^/]+$!!;
  916. $link=~s!^\./!!;
  917. $link="$from/$link" if length $from;
  918. }
  919. my $links = $IkiWiki::links{$page} or return undef;
  920. return IkiWiki::FailReason->new("$page has no links") unless @$links;
  921. my $bestlink = IkiWiki::bestlink($from, $link);
  922. return IkiWiki::FailReason->new("no such link") unless length $bestlink;
  923. foreach my $p (@$links) {
  924. return IkiWiki::SuccessReason->new("$page links to $link")
  925. if $bestlink eq IkiWiki::bestlink($page, $p);
  926. }
  927. return IkiWiki::FailReason->new("$page does not link to $link");
  928. } #}}}
  929. sub match_backlink ($$;@) { #{{{
  930. match_link($_[1], $_[0], @_);
  931. } #}}}
  932. sub match_created_before ($$;@) { #{{{
  933. my $page=shift;
  934. my $testpage=shift;
  935. if (exists $IkiWiki::pagectime{$testpage}) {
  936. if ($IkiWiki::pagectime{$page} < $IkiWiki::pagectime{$testpage}) {
  937. IkiWiki::SuccessReason->new("$page created before $testpage");
  938. }
  939. else {
  940. IkiWiki::FailReason->new("$page not created before $testpage");
  941. }
  942. }
  943. else {
  944. return IkiWiki::FailReason->new("$testpage has no ctime");
  945. }
  946. } #}}}
  947. sub match_created_after ($$;@) { #{{{
  948. my $page=shift;
  949. my $testpage=shift;
  950. if (exists $IkiWiki::pagectime{$testpage}) {
  951. if ($IkiWiki::pagectime{$page} > $IkiWiki::pagectime{$testpage}) {
  952. IkiWiki::SuccessReason->new("$page created after $testpage");
  953. }
  954. else {
  955. IkiWiki::FailReason->new("$page not created after $testpage");
  956. }
  957. }
  958. else {
  959. return IkiWiki::FailReason->new("$testpage has no ctime");
  960. }
  961. } #}}}
  962. sub match_creation_day ($$;@) { #{{{
  963. if ((gmtime($IkiWiki::pagectime{shift()}))[3] == shift) {
  964. return IkiWiki::SuccessReason->new("creation_day matched");
  965. }
  966. else {
  967. return IkiWiki::FailReason->new("creation_day did not match");
  968. }
  969. } #}}}
  970. sub match_creation_month ($$;@) { #{{{
  971. if ((gmtime($IkiWiki::pagectime{shift()}))[4] + 1 == shift) {
  972. return IkiWiki::SuccessReason->new("creation_month matched");
  973. }
  974. else {
  975. return IkiWiki::FailReason->new("creation_month did not match");
  976. }
  977. } #}}}
  978. sub match_creation_year ($$;@) { #{{{
  979. if ((gmtime($IkiWiki::pagectime{shift()}))[5] + 1900 == shift) {
  980. return IkiWiki::SuccessReason->new("creation_year matched");
  981. }
  982. else {
  983. return IkiWiki::FailReason->new("creation_year did not match");
  984. }
  985. } #}}}
  986. sub match_user ($$;@) { #{{{
  987. shift;
  988. my $user=shift;
  989. my %params=@_;
  990. return IkiWiki::FailReason->new("cannot match user") unless exists $params{user};
  991. if ($user eq $params{user}) {
  992. return IkiWiki::SuccessReason->new("user is $user")
  993. }
  994. else {
  995. return IkiWiki::FailReason->new("user is not $user");
  996. }
  997. } #}}}
  998. 1