summaryrefslogtreecommitdiff
path: root/IkiWiki.pm
blob: 6a6e93e7ec699e250ae72b408dee21b21e39b4d9 (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 Storable;
  10. use open qw{:utf8 :std};
  11. use vars qw{%config %links %oldlinks %pagemtime %pagectime %pagecase
  12. %pagestate %renderedfiles %oldrenderedfiles %pagesources
  13. %destsources %depends %hooks %forcerebuild $gettext_obj};
  14. use Exporter q{import};
  15. our @EXPORT = qw(hook debug error template htmlpage add_depends pagespec_match
  16. bestlink htmllink readfile writefile pagetype srcfile pagename
  17. displaytime will_render gettext urlto targetpage
  18. add_underlay
  19. %config %links %pagestate %renderedfiles
  20. %pagesources %destsources);
  21. our $VERSION = 2.00; # plugin interface version, next is ikiwiki version
  22. our $version='unknown'; # VERSION_AUTOREPLACE done by Makefile, DNE
  23. my $installdir=''; # INSTALLDIR_AUTOREPLACE done by Makefile, DNE
  24. # Optimisation.
  25. use Memoize;
  26. memoize("abs2rel");
  27. memoize("pagespec_translate");
  28. memoize("file_pruned");
  29. sub getsetup () { #{{{
  30. wikiname => {
  31. type => "string",
  32. default => "wiki",
  33. description => "name of the wiki",
  34. safe => 1,
  35. rebuild => 1,
  36. },
  37. srcdir => {
  38. type => "string",
  39. default => undef,
  40. example => "$ENV{HOME}/wiki",
  41. description => "where the source of the wiki is located",
  42. safe => 0, # path
  43. rebuild => 1,
  44. },
  45. destdir => {
  46. type => "string",
  47. default => undef,
  48. example => "/var/www/wiki",
  49. description => "where to build the wiki",
  50. safe => 0, # path
  51. rebuild => 1,
  52. },
  53. adminuser => {
  54. type => "string",
  55. default => [],
  56. description => "user names of wiki admins",
  57. safe => 1,
  58. rebuild => 0,
  59. },
  60. adminemail => {
  61. type => "string",
  62. default => undef,
  63. example => 'me@example.com',
  64. description => "contact email for wiki",
  65. safe => 1,
  66. rebuild => 0,
  67. },
  68. url => {
  69. type => "string",
  70. default => '',
  71. example => "http://example.com/wiki",
  72. description => "base url to the wiki",
  73. safe => 1,
  74. rebuild => 1,
  75. },
  76. cgiurl => {
  77. type => "string",
  78. default => '',
  79. example => "http://example.com/wiki/ikiwiki.cgi",
  80. description => "url to the ikiwiki.cgi",
  81. safe => 1,
  82. rebuild => 1,
  83. },
  84. cgi_wrapper => {
  85. type => "string",
  86. default => '',
  87. example => "/var/www/wiki/ikiwiki.cgi",
  88. description => "cgi executable to generate",
  89. safe => 0, # file
  90. rebuild => 0,
  91. },
  92. cgi_wrappermode => {
  93. type => "string",
  94. default => '06755',
  95. description => "mode for cgi_wrapper (can safely be made suid)",
  96. safe => 0,
  97. rebuild => 0,
  98. },
  99. rcs => {
  100. type => "string",
  101. default => '',
  102. description => "rcs backend to use",
  103. safe => 0, # don't allow overriding
  104. rebuild => 0,
  105. },
  106. default_plugins => {
  107. type => "internal",
  108. default => [qw{mdwn link inline htmlscrubber passwordauth
  109. openid signinedit lockedit conditional
  110. recentchanges parentlinks}],
  111. description => "plugins to enable by default",
  112. safe => 0,
  113. rebuild => 1,
  114. },
  115. add_plugins => {
  116. type => "string",
  117. default => [],
  118. description => "plugins to add to the default configuration",
  119. safe => 1,
  120. rebuild => 1,
  121. },
  122. disable_plugins => {
  123. type => "string",
  124. default => [],
  125. description => "plugins to disable",
  126. safe => 1,
  127. rebuild => 1,
  128. },
  129. templatedir => {
  130. type => "string",
  131. default => "$installdir/share/ikiwiki/templates",
  132. description => "location of template files",
  133. safe => 0, # path
  134. rebuild => 1,
  135. },
  136. underlaydir => {
  137. type => "string",
  138. default => "$installdir/share/ikiwiki/basewiki",
  139. description => "base wiki source location",
  140. safe => 0, # path
  141. rebuild => 0,
  142. },
  143. wrappers => {
  144. type => "internal",
  145. default => [],
  146. description => "wrappers to generate",
  147. safe => 0,
  148. rebuild => 0,
  149. },
  150. underlaydirs => {
  151. type => "internal",
  152. default => [],
  153. description => "additional underlays to use",
  154. safe => 0,
  155. rebuild => 0,
  156. },
  157. verbose => {
  158. type => "boolean",
  159. default => 0,
  160. description => "display verbose messages when building?",
  161. safe => 1,
  162. rebuild => 0,
  163. },
  164. syslog => {
  165. type => "boolean",
  166. default => 0,
  167. description => "log to syslog?",
  168. safe => 1,
  169. rebuild => 0,
  170. },
  171. usedirs => {
  172. type => "boolean",
  173. default => 1,
  174. description => "create output files named page/index.html?",
  175. safe => 0, # changing requires manual transition
  176. rebuild => 1,
  177. },
  178. prefix_directives => {
  179. type => "boolean",
  180. default => 0,
  181. description => "use '!'-prefixed preprocessor directives?",
  182. safe => 0, # changing requires manual transition
  183. rebuild => 1,
  184. },
  185. discussion => {
  186. type => "boolean",
  187. default => 1,
  188. description => "enable Discussion pages?",
  189. safe => 1,
  190. rebuild => 1,
  191. },
  192. default_pageext => {
  193. type => "string",
  194. default => "mdwn",
  195. description => "extension to use for new pages",
  196. safe => 0, # not sanitized
  197. rebuild => 0,
  198. },
  199. htmlext => {
  200. type => "string",
  201. default => "html",
  202. description => "extension to use for html files",
  203. safe => 0, # not sanitized
  204. rebuild => 1,
  205. },
  206. timeformat => {
  207. type => "string",
  208. default => '%c',
  209. description => "strftime format string to display date",
  210. safe => 1,
  211. rebuild => 1,
  212. },
  213. locale => {
  214. type => "string",
  215. default => undef,
  216. example => "en_US.UTF-8",
  217. description => "UTF-8 locale to use",
  218. safe => 0,
  219. rebuild => 1,
  220. },
  221. sslcookie => {
  222. type => "boolean",
  223. default => 0,
  224. description => "only send cookies over SSL connections?",
  225. safe => 1,
  226. rebuild => 0,
  227. },
  228. userdir => {
  229. type => "string",
  230. default => "",
  231. example => "users",
  232. description => "put user pages below specified page",
  233. safe => 1,
  234. rebuild => 1,
  235. },
  236. numbacklinks => {
  237. type => "integer",
  238. default => 10,
  239. description => "how many backlinks to show before hiding excess (0 to show all)",
  240. safe => 1,
  241. rebuild => 1,
  242. },
  243. hardlink => {
  244. type => "boolean",
  245. default => 0,
  246. description => "attempt to hardlink source files? (optimisation for large files)",
  247. safe => 0, # paranoia
  248. rebuild => 0,
  249. },
  250. umask => {
  251. type => "integer",
  252. description => "",
  253. example => "022",
  254. description => "force ikiwiki to use a particular umask",
  255. safe => 0, # paranoia
  256. rebuild => 0,
  257. },
  258. libdir => {
  259. type => "string",
  260. default => "",
  261. example => "$ENV{HOME}/.ikiwiki/",
  262. description => "extra library and plugin directory",
  263. safe => 0, # directory
  264. rebuild => 0,
  265. },
  266. ENV => {
  267. type => "string",
  268. default => {},
  269. description => "environment variables",
  270. safe => 0, # paranoia
  271. rebuild => 0,
  272. },
  273. exclude => {
  274. type => "string",
  275. default => undef,
  276. example => '\.wav$',
  277. description => "regexp of source files to ignore",
  278. safe => 0, # regexp
  279. rebuild => 1,
  280. },
  281. wiki_file_prune_regexps => {
  282. type => "internal",
  283. default => [qr/(^|\/)\.\.(\/|$)/, qr/^\./, qr/\/\./,
  284. qr/\.x?html?$/, qr/\.ikiwiki-new$/,
  285. qr/(^|\/).svn\//, qr/.arch-ids\//, qr/{arch}\//,
  286. qr/(^|\/)_MTN\//,
  287. qr/\.dpkg-tmp$/],
  288. description => "regexps of source files to ignore",
  289. safe => 0,
  290. rebuild => 1,
  291. },
  292. wiki_file_regexp => {
  293. type => "internal",
  294. default => qr/(^[-[:alnum:]_.:\/+]+$)/,
  295. description => "regexp of legal source files",
  296. safe => 0,
  297. rebuild => 1,
  298. },
  299. web_commit_regexp => {
  300. type => "internal",
  301. default => qr/^web commit (by (.*?(?=: |$))|from (\d+\.\d+\.\d+\.\d+)):?(.*)/,
  302. description => "regexp to parse web commits from logs",
  303. safe => 0,
  304. rebuild => 0,
  305. },
  306. cgi => {
  307. type => "internal",
  308. default => 0,
  309. description => "run as a cgi",
  310. safe => 0,
  311. rebuild => 0,
  312. },
  313. cgi_disable_uploads => {
  314. type => "internal",
  315. default => 1,
  316. description => "whether CGI should accept file uploads",
  317. safe => 0,
  318. rebuild => 0,
  319. },
  320. post_commit => {
  321. type => "internal",
  322. default => 0,
  323. description => "run as a post-commit hook",
  324. safe => 0,
  325. rebuild => 0,
  326. },
  327. rebuild => {
  328. type => "internal",
  329. default => 0,
  330. description => "running in rebuild mode",
  331. safe => 0,
  332. rebuild => 0,
  333. },
  334. refresh => {
  335. type => "internal",
  336. default => 0,
  337. description => "running in refresh mode",
  338. safe => 0,
  339. rebuild => 0,
  340. },
  341. getctime => {
  342. type => "internal",
  343. default => 0,
  344. description => "running in getctime mode",
  345. safe => 0,
  346. rebuild => 0,
  347. },
  348. w3mmode => {
  349. type => "internal",
  350. default => 0,
  351. description => "running in w3mmode",
  352. safe => 0,
  353. rebuild => 0,
  354. },
  355. setup => {
  356. type => "internal",
  357. default => undef,
  358. description => "setup file to read",
  359. safe => 0,
  360. rebuild => 0,
  361. },
  362. } #}}}
  363. sub defaultconfig () { #{{{
  364. my %s=getsetup();
  365. my @ret;
  366. foreach my $key (keys %s) {
  367. push @ret, $key, $s{$key}->{default};
  368. }
  369. use Data::Dumper;
  370. return @ret;
  371. } #}}}
  372. sub checkconfig () { #{{{
  373. # locale stuff; avoid LC_ALL since it overrides everything
  374. if (defined $ENV{LC_ALL}) {
  375. $ENV{LANG} = $ENV{LC_ALL};
  376. delete $ENV{LC_ALL};
  377. }
  378. if (defined $config{locale}) {
  379. if (POSIX::setlocale(&POSIX::LC_ALL, $config{locale})) {
  380. $ENV{LANG}=$config{locale};
  381. $gettext_obj=undef;
  382. }
  383. }
  384. if (ref $config{ENV} eq 'HASH') {
  385. foreach my $val (keys %{$config{ENV}}) {
  386. $ENV{$val}=$config{ENV}{$val};
  387. }
  388. }
  389. if ($config{w3mmode}) {
  390. eval q{use Cwd q{abs_path}};
  391. error($@) if $@;
  392. $config{srcdir}=possibly_foolish_untaint(abs_path($config{srcdir}));
  393. $config{destdir}=possibly_foolish_untaint(abs_path($config{destdir}));
  394. $config{cgiurl}="file:///\$LIB/ikiwiki-w3m.cgi/".$config{cgiurl}
  395. unless $config{cgiurl} =~ m!file:///!;
  396. $config{url}="file://".$config{destdir};
  397. }
  398. if ($config{cgi} && ! length $config{url}) {
  399. error(gettext("Must specify url to wiki with --url when using --cgi"));
  400. }
  401. $config{wikistatedir}="$config{srcdir}/.ikiwiki"
  402. unless exists $config{wikistatedir};
  403. if ($config{rcs}) {
  404. loadplugin($config{rcs});
  405. }
  406. else {
  407. loadplugin("norcs");
  408. }
  409. if (defined $config{umask}) {
  410. umask(possibly_foolish_untaint($config{umask}));
  411. }
  412. run_hooks(checkconfig => sub { shift->() });
  413. return 1;
  414. } #}}}
  415. sub listplugins () { #{{{
  416. my %ret;
  417. foreach my $dir (@INC, $config{libdir}) {
  418. next unless defined $dir && length $dir;
  419. foreach my $file (glob("$dir/IkiWiki/Plugin/*.pm")) {
  420. my ($plugin)=$file=~/.*\/(.*)\.pm$/;
  421. $ret{$plugin}=1;
  422. }
  423. }
  424. foreach my $dir ($config{libdir}, "$installdir/lib/ikiwiki") {
  425. next unless defined $dir && length $dir;
  426. foreach my $file (glob("$dir/plugins/*")) {
  427. $ret{basename($file)}=1 if -x $file;
  428. }
  429. }
  430. return keys %ret;
  431. } #}}}
  432. sub loadplugins () { #{{{
  433. if (defined $config{libdir} && length $config{libdir}) {
  434. unshift @INC, possibly_foolish_untaint($config{libdir});
  435. }
  436. loadplugin($_) foreach @{$config{default_plugins}}, @{$config{add_plugins}};
  437. run_hooks(getopt => sub { shift->() });
  438. if (grep /^-/, @ARGV) {
  439. print STDERR "Unknown option: $_\n"
  440. foreach grep /^-/, @ARGV;
  441. usage();
  442. }
  443. return 1;
  444. } #}}}
  445. sub loadplugin ($) { #{{{
  446. my $plugin=shift;
  447. return if grep { $_ eq $plugin} @{$config{disable_plugins}};
  448. foreach my $dir (defined $config{libdir} ? possibly_foolish_untaint($config{libdir}) : undef,
  449. "$installdir/lib/ikiwiki") {
  450. if (defined $dir && -x "$dir/plugins/$plugin") {
  451. require IkiWiki::Plugin::external;
  452. import IkiWiki::Plugin::external "$dir/plugins/$plugin";
  453. return 1;
  454. }
  455. }
  456. my $mod="IkiWiki::Plugin::".possibly_foolish_untaint($plugin);
  457. eval qq{use $mod};
  458. if ($@) {
  459. error("Failed to load plugin $mod: $@");
  460. }
  461. return 1;
  462. } #}}}
  463. sub error ($;$) { #{{{
  464. my $message=shift;
  465. my $cleaner=shift;
  466. log_message('err' => $message) if $config{syslog};
  467. if (defined $cleaner) {
  468. $cleaner->();
  469. }
  470. die $message."\n";
  471. } #}}}
  472. sub debug ($) { #{{{
  473. return unless $config{verbose};
  474. return log_message(debug => @_);
  475. } #}}}
  476. my $log_open=0;
  477. sub log_message ($$) { #{{{
  478. my $type=shift;
  479. if ($config{syslog}) {
  480. require Sys::Syslog;
  481. if (! $log_open) {
  482. Sys::Syslog::setlogsock('unix');
  483. Sys::Syslog::openlog('ikiwiki', '', 'user');
  484. $log_open=1;
  485. }
  486. return eval {
  487. Sys::Syslog::syslog($type, "[$config{wikiname}] %s", join(" ", @_));
  488. };
  489. }
  490. elsif (! $config{cgi}) {
  491. return print "@_\n";
  492. }
  493. else {
  494. return print STDERR "@_\n";
  495. }
  496. } #}}}
  497. sub possibly_foolish_untaint ($) { #{{{
  498. my $tainted=shift;
  499. my ($untainted)=$tainted=~/(.*)/s;
  500. return $untainted;
  501. } #}}}
  502. sub basename ($) { #{{{
  503. my $file=shift;
  504. $file=~s!.*/+!!;
  505. return $file;
  506. } #}}}
  507. sub dirname ($) { #{{{
  508. my $file=shift;
  509. $file=~s!/*[^/]+$!!;
  510. return $file;
  511. } #}}}
  512. sub pagetype ($) { #{{{
  513. my $page=shift;
  514. if ($page =~ /\.([^.]+)$/) {
  515. return $1 if exists $hooks{htmlize}{$1};
  516. }
  517. return;
  518. } #}}}
  519. sub isinternal ($) { #{{{
  520. my $page=shift;
  521. return exists $pagesources{$page} &&
  522. $pagesources{$page} =~ /\._([^.]+)$/;
  523. } #}}}
  524. sub pagename ($) { #{{{
  525. my $file=shift;
  526. my $type=pagetype($file);
  527. my $page=$file;
  528. $page=~s/\Q.$type\E*$// if defined $type;
  529. return $page;
  530. } #}}}
  531. sub targetpage ($$) { #{{{
  532. my $page=shift;
  533. my $ext=shift;
  534. if (! $config{usedirs} || $page =~ /^index$/ ) {
  535. return $page.".".$ext;
  536. } else {
  537. return $page."/index.".$ext;
  538. }
  539. } #}}}
  540. sub htmlpage ($) { #{{{
  541. my $page=shift;
  542. return targetpage($page, $config{htmlext});
  543. } #}}}
  544. sub srcfile_stat { #{{{
  545. my $file=shift;
  546. my $nothrow=shift;
  547. return "$config{srcdir}/$file", stat(_) if -e "$config{srcdir}/$file";
  548. foreach my $dir (@{$config{underlaydirs}}, $config{underlaydir}) {
  549. return "$dir/$file", stat(_) if -e "$dir/$file";
  550. }
  551. error("internal error: $file cannot be found in $config{srcdir} or underlay") unless $nothrow;
  552. return;
  553. } #}}}
  554. sub srcfile ($;$) { #{{{
  555. return (srcfile_stat(@_))[0];
  556. } #}}}
  557. sub add_underlay ($) { #{{{
  558. my $dir=shift;
  559. if ($dir=~/^\//) {
  560. unshift @{$config{underlaydirs}}, $dir;
  561. }
  562. else {
  563. unshift @{$config{underlaydirs}}, "$config{underlaydir}/../$dir";
  564. }
  565. return 1;
  566. } #}}}
  567. sub readfile ($;$$) { #{{{
  568. my $file=shift;
  569. my $binary=shift;
  570. my $wantfd=shift;
  571. if (-l $file) {
  572. error("cannot read a symlink ($file)");
  573. }
  574. local $/=undef;
  575. open (my $in, "<", $file) || error("failed to read $file: $!");
  576. binmode($in) if ($binary);
  577. return \*$in if $wantfd;
  578. my $ret=<$in>;
  579. close $in || error("failed to read $file: $!");
  580. return $ret;
  581. } #}}}
  582. sub prep_writefile ($$) { #{{{
  583. my $file=shift;
  584. my $destdir=shift;
  585. my $test=$file;
  586. while (length $test) {
  587. if (-l "$destdir/$test") {
  588. error("cannot write to a symlink ($test)");
  589. }
  590. $test=dirname($test);
  591. }
  592. my $dir=dirname("$destdir/$file");
  593. if (! -d $dir) {
  594. my $d="";
  595. foreach my $s (split(m!/+!, $dir)) {
  596. $d.="$s/";
  597. if (! -d $d) {
  598. mkdir($d) || error("failed to create directory $d: $!");
  599. }
  600. }
  601. }
  602. return 1;
  603. } #}}}
  604. sub writefile ($$$;$$) { #{{{
  605. my $file=shift; # can include subdirs
  606. my $destdir=shift; # directory to put file in
  607. my $content=shift;
  608. my $binary=shift;
  609. my $writer=shift;
  610. prep_writefile($file, $destdir);
  611. my $newfile="$destdir/$file.ikiwiki-new";
  612. if (-l $newfile) {
  613. error("cannot write to a symlink ($newfile)");
  614. }
  615. my $cleanup = sub { unlink($newfile) };
  616. open (my $out, '>', $newfile) || error("failed to write $newfile: $!", $cleanup);
  617. binmode($out) if ($binary);
  618. if ($writer) {
  619. $writer->(\*$out, $cleanup);
  620. }
  621. else {
  622. print $out $content or error("failed writing to $newfile: $!", $cleanup);
  623. }
  624. close $out || error("failed saving $newfile: $!", $cleanup);
  625. rename($newfile, "$destdir/$file") ||
  626. error("failed renaming $newfile to $destdir/$file: $!", $cleanup);
  627. return 1;
  628. } #}}}
  629. my %cleared;
  630. sub will_render ($$;$) { #{{{
  631. my $page=shift;
  632. my $dest=shift;
  633. my $clear=shift;
  634. # Important security check.
  635. if (-e "$config{destdir}/$dest" && ! $config{rebuild} &&
  636. ! grep { $_ eq $dest } (@{$renderedfiles{$page}}, @{$oldrenderedfiles{$page}})) {
  637. error("$config{destdir}/$dest independently created, not overwriting with version from $page");
  638. }
  639. if (! $clear || $cleared{$page}) {
  640. $renderedfiles{$page}=[$dest, grep { $_ ne $dest } @{$renderedfiles{$page}}];
  641. }
  642. else {
  643. foreach my $old (@{$renderedfiles{$page}}) {
  644. delete $destsources{$old};
  645. }
  646. $renderedfiles{$page}=[$dest];
  647. $cleared{$page}=1;
  648. }
  649. $destsources{$dest}=$page;
  650. return 1;
  651. } #}}}
  652. sub bestlink ($$) { #{{{
  653. my $page=shift;
  654. my $link=shift;
  655. my $cwd=$page;
  656. if ($link=~s/^\/+//) {
  657. # absolute links
  658. $cwd="";
  659. }
  660. $link=~s/\/$//;
  661. do {
  662. my $l=$cwd;
  663. $l.="/" if length $l;
  664. $l.=$link;
  665. if (exists $links{$l}) {
  666. return $l;
  667. }
  668. elsif (exists $pagecase{lc $l}) {
  669. return $pagecase{lc $l};
  670. }
  671. } while $cwd=~s!/?[^/]+$!!;
  672. if (length $config{userdir}) {
  673. my $l = "$config{userdir}/".lc($link);
  674. if (exists $links{$l}) {
  675. return $l;
  676. }
  677. elsif (exists $pagecase{lc $l}) {
  678. return $pagecase{lc $l};
  679. }
  680. }
  681. #print STDERR "warning: page $page, broken link: $link\n";
  682. return "";
  683. } #}}}
  684. sub isinlinableimage ($) { #{{{
  685. my $file=shift;
  686. return $file =~ /\.(png|gif|jpg|jpeg)$/i;
  687. } #}}}
  688. sub pagetitle ($;$) { #{{{
  689. my $page=shift;
  690. my $unescaped=shift;
  691. if ($unescaped) {
  692. $page=~s/(__(\d+)__|_)/$1 eq '_' ? ' ' : chr($2)/eg;
  693. }
  694. else {
  695. $page=~s/(__(\d+)__|_)/$1 eq '_' ? ' ' : "&#$2;"/eg;
  696. }
  697. return $page;
  698. } #}}}
  699. sub titlepage ($) { #{{{
  700. my $title=shift;
  701. $title=~s/([^-[:alnum:]:+\/.])/$1 eq ' ' ? '_' : "__".ord($1)."__"/eg;
  702. return $title;
  703. } #}}}
  704. sub linkpage ($) { #{{{
  705. my $link=shift;
  706. $link=~s/([^-[:alnum:]:+\/._])/$1 eq ' ' ? '_' : "__".ord($1)."__"/eg;
  707. return $link;
  708. } #}}}
  709. sub cgiurl (@) { #{{{
  710. my %params=@_;
  711. return $config{cgiurl}."?".
  712. join("&amp;", map $_."=".uri_escape_utf8($params{$_}), keys %params);
  713. } #}}}
  714. sub baseurl (;$) { #{{{
  715. my $page=shift;
  716. return "$config{url}/" if ! defined $page;
  717. $page=htmlpage($page);
  718. $page=~s/[^\/]+$//;
  719. $page=~s/[^\/]+\//..\//g;
  720. return $page;
  721. } #}}}
  722. sub abs2rel ($$) { #{{{
  723. # Work around very innefficient behavior in File::Spec if abs2rel
  724. # is passed two relative paths. It's much faster if paths are
  725. # absolute! (Debian bug #376658; fixed in debian unstable now)
  726. my $path="/".shift;
  727. my $base="/".shift;
  728. require File::Spec;
  729. my $ret=File::Spec->abs2rel($path, $base);
  730. $ret=~s/^// if defined $ret;
  731. return $ret;
  732. } #}}}
  733. sub displaytime ($;$) { #{{{
  734. my $time=shift;
  735. my $format=shift;
  736. if (! defined $format) {
  737. $format=$config{timeformat};
  738. }
  739. # strftime doesn't know about encodings, so make sure
  740. # its output is properly treated as utf8
  741. return decode_utf8(POSIX::strftime($format, localtime($time)));
  742. } #}}}
  743. sub beautify_urlpath ($) { #{{{
  744. my $url=shift;
  745. if ($config{usedirs}) {
  746. $url =~ s!/index.$config{htmlext}$!/!;
  747. }
  748. # Ensure url is not an empty link, and
  749. # if it's relative, make that explicit to avoid colon confusion.
  750. if ($url !~ /^\//) {
  751. $url="./$url";
  752. }
  753. return $url;
  754. } #}}}
  755. sub urlto ($$;$) { #{{{
  756. my $to=shift;
  757. my $from=shift;
  758. my $absolute=shift;
  759. if (! length $to) {
  760. return beautify_urlpath(baseurl($from)."index.$config{htmlext}");
  761. }
  762. if (! $destsources{$to}) {
  763. $to=htmlpage($to);
  764. }
  765. if ($absolute) {
  766. return $config{url}.beautify_urlpath("/".$to);
  767. }
  768. my $link = abs2rel($to, dirname(htmlpage($from)));
  769. return beautify_urlpath($link);
  770. } #}}}
  771. sub htmllink ($$$;@) { #{{{
  772. my $lpage=shift; # the page doing the linking
  773. my $page=shift; # the page that will contain the link (different for inline)
  774. my $link=shift;
  775. my %opts=@_;
  776. $link=~s/\/$//;
  777. my $bestlink;
  778. if (! $opts{forcesubpage}) {
  779. $bestlink=bestlink($lpage, $link);
  780. }
  781. else {
  782. $bestlink="$lpage/".lc($link);
  783. }
  784. my $linktext;
  785. if (defined $opts{linktext}) {
  786. $linktext=$opts{linktext};
  787. }
  788. else {
  789. $linktext=pagetitle(basename($link));
  790. }
  791. return "<span class=\"selflink\">$linktext</span>"
  792. if length $bestlink && $page eq $bestlink &&
  793. ! defined $opts{anchor};
  794. if (! $destsources{$bestlink}) {
  795. $bestlink=htmlpage($bestlink);
  796. if (! $destsources{$bestlink}) {
  797. return $linktext unless length $config{cgiurl};
  798. return "<span class=\"createlink\"><a href=\"".
  799. cgiurl(
  800. do => "create",
  801. page => lc($link),
  802. from => $lpage
  803. ).
  804. "\" rel=\"nofollow\">?</a>$linktext</span>"
  805. }
  806. }
  807. $bestlink=abs2rel($bestlink, dirname(htmlpage($page)));
  808. $bestlink=beautify_urlpath($bestlink);
  809. if (! $opts{noimageinline} && isinlinableimage($bestlink)) {
  810. return "<img src=\"$bestlink\" alt=\"$linktext\" />";
  811. }
  812. if (defined $opts{anchor}) {
  813. $bestlink.="#".$opts{anchor};
  814. }
  815. my @attrs;
  816. if (defined $opts{rel}) {
  817. push @attrs, ' rel="'.$opts{rel}.'"';
  818. }
  819. if (defined $opts{class}) {
  820. push @attrs, ' class="'.$opts{class}.'"';
  821. }
  822. return "<a href=\"$bestlink\"@attrs>$linktext</a>";
  823. } #}}}
  824. sub userlink ($) { #{{{
  825. my $user=shift;
  826. my $oiduser=eval { openiduser($user) };
  827. if (defined $oiduser) {
  828. return "<a href=\"$user\">$oiduser</a>";
  829. }
  830. else {
  831. eval q{use CGI 'escapeHTML'};
  832. error($@) if $@;
  833. return htmllink("", "", escapeHTML(
  834. length $config{userdir} ? $config{userdir}."/".$user : $user
  835. ), noimageinline => 1);
  836. }
  837. } #}}}
  838. sub htmlize ($$$$) { #{{{
  839. my $page=shift;
  840. my $destpage=shift;
  841. my $type=shift;
  842. my $content=shift;
  843. my $oneline = $content !~ /\n/;
  844. if (exists $hooks{htmlize}{$type}) {
  845. $content=$hooks{htmlize}{$type}{call}->(
  846. page => $page,
  847. content => $content,
  848. );
  849. }
  850. else {
  851. error("htmlization of $type not supported");
  852. }
  853. run_hooks(sanitize => sub {
  854. $content=shift->(
  855. page => $page,
  856. destpage => $destpage,
  857. content => $content,
  858. );
  859. });
  860. if ($oneline) {
  861. # hack to get rid of enclosing junk added by markdown
  862. # and other htmlizers
  863. $content=~s/^<p>//i;
  864. $content=~s/<\/p>$//i;
  865. chomp $content;
  866. }
  867. return $content;
  868. } #}}}
  869. sub linkify ($$$) { #{{{
  870. my $page=shift;
  871. my $destpage=shift;
  872. my $content=shift;
  873. run_hooks(linkify => sub {
  874. $content=shift->(
  875. page => $page,
  876. destpage => $destpage,
  877. content => $content,
  878. );
  879. });
  880. return $content;
  881. } #}}}
  882. our %preprocessing;
  883. our $preprocess_preview=0;
  884. sub preprocess ($$$;$$) { #{{{
  885. my $page=shift; # the page the data comes from
  886. my $destpage=shift; # the page the data will appear in (different for inline)
  887. my $content=shift;
  888. my $scan=shift;
  889. my $preview=shift;
  890. # Using local because it needs to be set within any nested calls
  891. # of this function.
  892. local $preprocess_preview=$preview if defined $preview;
  893. my $handle=sub {
  894. my $escape=shift;
  895. my $prefix=shift;
  896. my $command=shift;
  897. my $params=shift;
  898. if (length $escape) {
  899. return "[[$prefix$command $params]]";
  900. }
  901. elsif (exists $hooks{preprocess}{$command}) {
  902. return "" if $scan && ! $hooks{preprocess}{$command}{scan};
  903. # Note: preserve order of params, some plugins may
  904. # consider it significant.
  905. my @params;
  906. while ($params =~ m{
  907. (?:([-\w]+)=)? # 1: named parameter key?
  908. (?:
  909. """(.*?)""" # 2: triple-quoted value
  910. |
  911. "([^"]+)" # 3: single-quoted value
  912. |
  913. (\S+) # 4: unquoted value
  914. )
  915. (?:\s+|$) # delimiter to next param
  916. }sgx) {
  917. my $key=$1;
  918. my $val;
  919. if (defined $2) {
  920. $val=$2;
  921. $val=~s/\r\n/\n/mg;
  922. $val=~s/^\n+//g;
  923. $val=~s/\n+$//g;
  924. }
  925. elsif (defined $3) {
  926. $val=$3;
  927. }
  928. elsif (defined $4) {
  929. $val=$4;
  930. }
  931. if (defined $key) {
  932. push @params, $key, $val;
  933. }
  934. else {
  935. push @params, $val, '';
  936. }
  937. }
  938. if ($preprocessing{$page}++ > 3) {
  939. # Avoid loops of preprocessed pages preprocessing
  940. # other pages that preprocess them, etc.
  941. return "[[!$command <span class=\"error\">".
  942. sprintf(gettext("preprocessing loop detected on %s at depth %i"),
  943. $page, $preprocessing{$page}).
  944. "</span>]]";
  945. }
  946. my $ret;
  947. if (! $scan) {
  948. $ret=eval {
  949. $hooks{preprocess}{$command}{call}->(
  950. @params,
  951. page => $page,
  952. destpage => $destpage,
  953. preview => $preprocess_preview,
  954. );
  955. };
  956. if ($@) {
  957. chomp $@;
  958. $ret="[[!$command <span class=\"error\">".
  959. gettext("Error").": $@"."</span>]]";
  960. }
  961. }
  962. else {
  963. # use void context during scan pass
  964. eval {
  965. $hooks{preprocess}{$command}{call}->(
  966. @params,
  967. page => $page,
  968. destpage => $destpage,
  969. preview => $preprocess_preview,
  970. );
  971. };
  972. $ret="";
  973. }
  974. $preprocessing{$page}--;
  975. return $ret;
  976. }
  977. else {
  978. return "[[$prefix$command $params]]";
  979. }
  980. };
  981. my $regex;
  982. if ($config{prefix_directives}) {
  983. $regex = qr{
  984. (\\?) # 1: escape?
  985. \[\[(!) # directive open; 2: prefix
  986. ([-\w]+) # 3: command
  987. ( # 4: the parameters..
  988. \s+ # Must have space if parameters present
  989. (?:
  990. (?:[-\w]+=)? # named parameter key?
  991. (?:
  992. """.*?""" # triple-quoted value
  993. |
  994. "[^"]+" # single-quoted value
  995. |
  996. [^\s\]]+ # unquoted value
  997. )
  998. \s* # whitespace or end
  999. # of directive
  1000. )
  1001. *)? # 0 or more parameters
  1002. \]\] # directive closed
  1003. }sx;
  1004. }
  1005. else {
  1006. $regex = qr{
  1007. (\\?) # 1: escape?
  1008. \[\[(!?) # directive open; 2: optional prefix
  1009. ([-\w]+) # 3: command
  1010. \s+
  1011. ( # 4: the parameters..
  1012. (?:
  1013. (?:[-\w]+=)? # named parameter key?
  1014. (?:
  1015. """.*?""" # triple-quoted value
  1016. |
  1017. "[^"]+" # single-quoted value
  1018. |
  1019. [^\s\]]+ # unquoted value
  1020. )
  1021. \s* # whitespace or end
  1022. # of directive
  1023. )
  1024. *) # 0 or more parameters
  1025. \]\] # directive closed
  1026. }sx;
  1027. }
  1028. $content =~ s{$regex}{$handle->($1, $2, $3, $4)}eg;
  1029. return $content;
  1030. } #}}}
  1031. sub filter ($$$) { #{{{
  1032. my $page=shift;
  1033. my $destpage=shift;
  1034. my $content=shift;
  1035. run_hooks(filter => sub {
  1036. $content=shift->(page => $page, destpage => $destpage,
  1037. content => $content);
  1038. });
  1039. return $content;
  1040. } #}}}
  1041. sub indexlink () { #{{{
  1042. return "<a href=\"$config{url}\">$config{wikiname}</a>";
  1043. } #}}}
  1044. my $wikilock;
  1045. sub lockwiki (;$) { #{{{
  1046. my $wait=@_ ? shift : 1;
  1047. # Take an exclusive lock on the wiki to prevent multiple concurrent
  1048. # run issues. The lock will be dropped on program exit.
  1049. if (! -d $config{wikistatedir}) {
  1050. mkdir($config{wikistatedir});
  1051. }
  1052. open($wikilock, '>', "$config{wikistatedir}/lockfile") ||
  1053. error ("cannot write to $config{wikistatedir}/lockfile: $!");
  1054. if (! flock($wikilock, 2 | 4)) { # LOCK_EX | LOCK_NB
  1055. if ($wait) {
  1056. debug("wiki seems to be locked, waiting for lock");
  1057. my $wait=600; # arbitrary, but don't hang forever to
  1058. # prevent process pileup
  1059. for (1..$wait) {
  1060. return if flock($wikilock, 2 | 4);
  1061. sleep 1;
  1062. }
  1063. error("wiki is locked; waited $wait seconds without lock being freed (possible stuck process or stale lock?)");
  1064. }
  1065. else {
  1066. return 0;
  1067. }
  1068. }
  1069. return 1;
  1070. } #}}}
  1071. sub unlockwiki () { #{{{
  1072. return close($wikilock) if $wikilock;
  1073. return;
  1074. } #}}}
  1075. my $commitlock;
  1076. sub commit_hook_enabled () { #{{{
  1077. open($commitlock, '+>', "$config{wikistatedir}/commitlock") ||
  1078. error("cannot write to $config{wikistatedir}/commitlock: $!");
  1079. if (! flock($commitlock, 1 | 4)) { # LOCK_SH | LOCK_NB to test
  1080. close($commitlock) || error("failed closing commitlock: $!");
  1081. return 0;
  1082. }
  1083. close($commitlock) || error("failed closing commitlock: $!");
  1084. return 1;
  1085. } #}}}
  1086. sub disable_commit_hook () { #{{{
  1087. open($commitlock, '>', "$config{wikistatedir}/commitlock") ||
  1088. error("cannot write to $config{wikistatedir}/commitlock: $!");
  1089. if (! flock($commitlock, 2)) { # LOCK_EX
  1090. error("failed to get commit lock");
  1091. }
  1092. return 1;
  1093. } #}}}
  1094. sub enable_commit_hook () { #{{{
  1095. return close($commitlock) if $commitlock;
  1096. return;
  1097. } #}}}
  1098. sub loadindex () { #{{{
  1099. %oldrenderedfiles=%pagectime=();
  1100. if (! $config{rebuild}) {
  1101. %pagesources=%pagemtime=%oldlinks=%links=%depends=
  1102. %destsources=%renderedfiles=%pagecase=%pagestate=();
  1103. }
  1104. my $in;
  1105. if (! open ($in, "<", "$config{wikistatedir}/indexdb")) {
  1106. if (-e "$config{wikistatedir}/index") {
  1107. system("ikiwiki-transition", "indexdb", $config{srcdir});
  1108. open ($in, "<", "$config{wikistatedir}/indexdb") || return;
  1109. }
  1110. else {
  1111. return;
  1112. }
  1113. }
  1114. my $ret=Storable::fd_retrieve($in);
  1115. if (! defined $ret) {
  1116. return 0;
  1117. }
  1118. my %index=%$ret;
  1119. foreach my $src (keys %index) {
  1120. my %d=%{$index{$src}};
  1121. my $page=pagename($src);
  1122. $pagectime{$page}=$d{ctime};
  1123. if (! $config{rebuild}) {
  1124. $pagesources{$page}=$src;
  1125. $pagemtime{$page}=$d{mtime};
  1126. $renderedfiles{$page}=$d{dest};
  1127. if (exists $d{links} && ref $d{links}) {
  1128. $links{$page}=$d{links};
  1129. $oldlinks{$page}=[@{$d{links}}];
  1130. }
  1131. if (exists $d{depends}) {
  1132. $depends{$page}=$d{depends};
  1133. }
  1134. if (exists $d{state}) {
  1135. $pagestate{$page}=$d{state};
  1136. }
  1137. }
  1138. $oldrenderedfiles{$page}=[@{$d{dest}}];
  1139. }
  1140. foreach my $page (keys %pagesources) {
  1141. $pagecase{lc $page}=$page;
  1142. }
  1143. foreach my $page (keys %renderedfiles) {
  1144. $destsources{$_}=$page foreach @{$renderedfiles{$page}};
  1145. }
  1146. return close($in);
  1147. } #}}}
  1148. sub saveindex () { #{{{
  1149. run_hooks(savestate => sub { shift->() });
  1150. my %hookids;
  1151. foreach my $type (keys %hooks) {
  1152. $hookids{$_}=1 foreach keys %{$hooks{$type}};
  1153. }
  1154. my @hookids=keys %hookids;
  1155. if (! -d $config{wikistatedir}) {
  1156. mkdir($config{wikistatedir});
  1157. }
  1158. my $newfile="$config{wikistatedir}/indexdb.new";
  1159. my $cleanup = sub { unlink($newfile) };
  1160. open (my $out, '>', $newfile) || error("cannot write to $newfile: $!", $cleanup);
  1161. my %index;
  1162. foreach my $page (keys %pagemtime) {
  1163. next unless $pagemtime{$page};
  1164. my $src=$pagesources{$page};
  1165. $index{$src}={
  1166. ctime => $pagectime{$page},
  1167. mtime => $pagemtime{$page},
  1168. dest => $renderedfiles{$page},
  1169. links => $links{$page},
  1170. };
  1171. if (exists $depends{$page}) {
  1172. $index{$src}{depends} = $depends{$page};
  1173. }
  1174. if (exists $pagestate{$page}) {
  1175. foreach my $id (@hookids) {
  1176. foreach my $key (keys %{$pagestate{$page}{$id}}) {
  1177. $index{$src}{state}{$id}{$key}=$pagestate{$page}{$id}{$key};
  1178. }
  1179. }
  1180. }
  1181. }
  1182. my $ret=Storable::nstore_fd(\%index, $out);
  1183. return if ! defined $ret || ! $ret;
  1184. close $out || error("failed saving to $newfile: $!", $cleanup);
  1185. rename($newfile, "$config{wikistatedir}/indexdb") ||
  1186. error("failed renaming $newfile to $config{wikistatedir}/indexdb", $cleanup);
  1187. return 1;
  1188. } #}}}
  1189. sub template_file ($) { #{{{
  1190. my $template=shift;
  1191. foreach my $dir ($config{templatedir}, "$installdir/share/ikiwiki/templates") {
  1192. return "$dir/$template" if -e "$dir/$template";
  1193. }
  1194. return;
  1195. } #}}}
  1196. sub template_params (@) { #{{{
  1197. my $filename=template_file(shift);
  1198. if (! defined $filename) {
  1199. return if wantarray;
  1200. return "";
  1201. }
  1202. my @ret=(
  1203. filter => sub {
  1204. my $text_ref = shift;
  1205. ${$text_ref} = decode_utf8(${$text_ref});
  1206. },
  1207. filename => $filename,
  1208. loop_context_vars => 1,
  1209. die_on_bad_params => 0,
  1210. @_
  1211. );
  1212. return wantarray ? @ret : {@ret};
  1213. } #}}}
  1214. sub template ($;@) { #{{{
  1215. require HTML::Template;
  1216. return HTML::Template->new(template_params(@_));
  1217. } #}}}
  1218. sub misctemplate ($$;@) { #{{{
  1219. my $title=shift;
  1220. my $pagebody=shift;
  1221. my $template=template("misc.tmpl");
  1222. $template->param(
  1223. title => $title,
  1224. indexlink => indexlink(),
  1225. wikiname => $config{wikiname},
  1226. pagebody => $pagebody,
  1227. baseurl => baseurl(),
  1228. @_,
  1229. );
  1230. run_hooks(pagetemplate => sub {
  1231. shift->(page => "", destpage => "", template => $template);
  1232. });
  1233. return $template->output;
  1234. }#}}}
  1235. sub hook (@) { # {{{
  1236. my %param=@_;
  1237. if (! exists $param{type} || ! ref $param{call} || ! exists $param{id}) {
  1238. error 'hook requires type, call, and id parameters';
  1239. }
  1240. return if $param{no_override} && exists $hooks{$param{type}}{$param{id}};
  1241. $hooks{$param{type}}{$param{id}}=\%param;
  1242. return 1;
  1243. } # }}}
  1244. sub run_hooks ($$) { # {{{
  1245. # Calls the given sub for each hook of the given type,
  1246. # passing it the hook function to call.
  1247. my $type=shift;
  1248. my $sub=shift;
  1249. if (exists $hooks{$type}) {
  1250. my @deferred;
  1251. foreach my $id (keys %{$hooks{$type}}) {
  1252. if ($hooks{$type}{$id}{last}) {
  1253. push @deferred, $id;
  1254. next;
  1255. }
  1256. $sub->($hooks{$type}{$id}{call});
  1257. }
  1258. foreach my $id (@deferred) {
  1259. $sub->($hooks{$type}{$id}{call});
  1260. }
  1261. }
  1262. return 1;
  1263. } #}}}
  1264. sub rcs_update () { #{{{
  1265. $hooks{rcs}{rcs_update}{call}->(@_);
  1266. } #}}}
  1267. sub rcs_prepedit ($) { #{{{
  1268. $hooks{rcs}{rcs_prepedit}{call}->(@_);
  1269. } #}}}
  1270. sub rcs_commit ($$$;$$) { #{{{
  1271. $hooks{rcs}{rcs_commit}{call}->(@_);
  1272. } #}}}
  1273. sub rcs_commit_staged ($$$) { #{{{
  1274. $hooks{rcs}{rcs_commit_staged}{call}->(@_);
  1275. } #}}}
  1276. sub rcs_add ($) { #{{{
  1277. $hooks{rcs}{rcs_add}{call}->(@_);
  1278. } #}}}
  1279. sub rcs_remove ($) { #{{{
  1280. $hooks{rcs}{rcs_remove}{call}->(@_);
  1281. } #}}}
  1282. sub rcs_rename ($$) { #{{{
  1283. $hooks{rcs}{rcs_rename}{call}->(@_);
  1284. } #}}}
  1285. sub rcs_recentchanges ($) { #{{{
  1286. $hooks{rcs}{rcs_recentchanges}{call}->(@_);
  1287. } #}}}
  1288. sub rcs_diff ($) { #{{{
  1289. $hooks{rcs}{rcs_diff}{call}->(@_);
  1290. } #}}}
  1291. sub rcs_getctime ($) { #{{{
  1292. $hooks{rcs}{rcs_getctime}{call}->(@_);
  1293. } #}}}
  1294. sub globlist_to_pagespec ($) { #{{{
  1295. my @globlist=split(' ', shift);
  1296. my (@spec, @skip);
  1297. foreach my $glob (@globlist) {
  1298. if ($glob=~/^!(.*)/) {
  1299. push @skip, $glob;
  1300. }
  1301. else {
  1302. push @spec, $glob;
  1303. }
  1304. }
  1305. my $spec=join(' or ', @spec);
  1306. if (@skip) {
  1307. my $skip=join(' and ', @skip);
  1308. if (length $spec) {
  1309. $spec="$skip and ($spec)";
  1310. }
  1311. else {
  1312. $spec=$skip;
  1313. }
  1314. }
  1315. return $spec;
  1316. } #}}}
  1317. sub is_globlist ($) { #{{{
  1318. my $s=shift;
  1319. return ( $s =~ /[^\s]+\s+([^\s]+)/ && $1 ne "and" && $1 ne "or" );
  1320. } #}}}
  1321. sub safequote ($) { #{{{
  1322. my $s=shift;
  1323. $s=~s/[{}]//g;
  1324. return "q{$s}";
  1325. } #}}}
  1326. sub add_depends ($$) { #{{{
  1327. my $page=shift;
  1328. my $pagespec=shift;
  1329. return unless pagespec_valid($pagespec);
  1330. if (! exists $depends{$page}) {
  1331. $depends{$page}=$pagespec;
  1332. }
  1333. else {
  1334. $depends{$page}=pagespec_merge($depends{$page}, $pagespec);
  1335. }
  1336. return 1;
  1337. } # }}}
  1338. sub file_pruned ($$) { #{{{
  1339. require File::Spec;
  1340. my $file=File::Spec->canonpath(shift);
  1341. my $base=File::Spec->canonpath(shift);
  1342. $file =~ s#^\Q$base\E/+##;
  1343. my $regexp='('.join('|', @{$config{wiki_file_prune_regexps}}).')';
  1344. return $file =~ m/$regexp/ && $file ne $base;
  1345. } #}}}
  1346. sub gettext { #{{{
  1347. # Only use gettext in the rare cases it's needed.
  1348. if ((exists $ENV{LANG} && length $ENV{LANG}) ||
  1349. (exists $ENV{LC_ALL} && length $ENV{LC_ALL}) ||
  1350. (exists $ENV{LC_MESSAGES} && length $ENV{LC_MESSAGES})) {
  1351. if (! $gettext_obj) {
  1352. $gettext_obj=eval q{
  1353. use Locale::gettext q{textdomain};
  1354. Locale::gettext->domain('ikiwiki')
  1355. };
  1356. if ($@) {
  1357. print STDERR "$@";
  1358. $gettext_obj=undef;
  1359. return shift;
  1360. }
  1361. }
  1362. return $gettext_obj->get(shift);
  1363. }
  1364. else {
  1365. return shift;
  1366. }
  1367. } #}}}
  1368. sub yesno ($) { #{{{
  1369. my $val=shift;
  1370. return (defined $val && lc($val) eq gettext("yes"));
  1371. } #}}}
  1372. sub pagespec_merge ($$) { #{{{
  1373. my $a=shift;
  1374. my $b=shift;
  1375. return $a if $a eq $b;
  1376. # Support for old-style GlobLists.
  1377. if (is_globlist($a)) {
  1378. $a=globlist_to_pagespec($a);
  1379. }
  1380. if (is_globlist($b)) {
  1381. $b=globlist_to_pagespec($b);
  1382. }
  1383. return "($a) or ($b)";
  1384. } #}}}
  1385. sub pagespec_translate ($) { #{{{
  1386. my $spec=shift;
  1387. # Support for old-style GlobLists.
  1388. if (is_globlist($spec)) {
  1389. $spec=globlist_to_pagespec($spec);
  1390. }
  1391. # Convert spec to perl code.
  1392. my $code="";
  1393. while ($spec=~m{
  1394. \s* # ignore whitespace
  1395. ( # 1: match a single word
  1396. \! # !
  1397. |
  1398. \( # (
  1399. |
  1400. \) # )
  1401. |
  1402. \w+\([^\)]*\) # command(params)
  1403. |
  1404. [^\s()]+ # any other text
  1405. )
  1406. \s* # ignore whitespace
  1407. }igx) {
  1408. my $word=$1;
  1409. if (lc $word eq 'and') {
  1410. $code.=' &&';
  1411. }
  1412. elsif (lc $word eq 'or') {
  1413. $code.=' ||';
  1414. }
  1415. elsif ($word eq "(" || $word eq ")" || $word eq "!") {
  1416. $code.=' '.$word;
  1417. }
  1418. elsif ($word =~ /^(\w+)\((.*)\)$/) {
  1419. if (exists $IkiWiki::PageSpec::{"match_$1"}) {
  1420. $code.="IkiWiki::PageSpec::match_$1(\$page, ".safequote($2).", \@_)";
  1421. }
  1422. else {
  1423. $code.=' 0';
  1424. }
  1425. }
  1426. else {
  1427. $code.=" IkiWiki::PageSpec::match_glob(\$page, ".safequote($word).", \@_)";
  1428. }
  1429. }
  1430. if (! length $code) {
  1431. $code=0;
  1432. }
  1433. no warnings;
  1434. return eval 'sub { my $page=shift; '.$code.' }';
  1435. } #}}}
  1436. sub pagespec_match ($$;@) { #{{{
  1437. my $page=shift;
  1438. my $spec=shift;
  1439. my @params=@_;
  1440. # Backwards compatability with old calling convention.
  1441. if (@params == 1) {
  1442. unshift @params, 'location';
  1443. }
  1444. my $sub=pagespec_translate($spec);
  1445. return IkiWiki::FailReason->new("syntax error in pagespec \"$spec\"") if $@;
  1446. return $sub->($page, @params);
  1447. } #}}}
  1448. sub pagespec_valid ($) { #{{{
  1449. my $spec=shift;
  1450. my $sub=pagespec_translate($spec);
  1451. return ! $@;
  1452. } #}}}
  1453. sub glob2re ($) { #{{{
  1454. my $re=quotemeta(shift);
  1455. $re=~s/\\\*/.*/g;
  1456. $re=~s/\\\?/./g;
  1457. return $re;
  1458. } #}}}
  1459. package IkiWiki::FailReason;
  1460. use overload ( #{{{
  1461. '""' => sub { ${$_[0]} },
  1462. '0+' => sub { 0 },
  1463. '!' => sub { bless $_[0], 'IkiWiki::SuccessReason'},
  1464. fallback => 1,
  1465. ); #}}}
  1466. sub new { #{{{
  1467. my $class = shift;
  1468. my $value = shift;
  1469. return bless \$value, $class;
  1470. } #}}}
  1471. package IkiWiki::SuccessReason;
  1472. use overload ( #{{{
  1473. '""' => sub { ${$_[0]} },
  1474. '0+' => sub { 1 },
  1475. '!' => sub { bless $_[0], 'IkiWiki::FailReason'},
  1476. fallback => 1,
  1477. ); #}}}
  1478. sub new { #{{{
  1479. my $class = shift;
  1480. my $value = shift;
  1481. return bless \$value, $class;
  1482. }; #}}}
  1483. package IkiWiki::PageSpec;
  1484. sub match_glob ($$;@) { #{{{
  1485. my $page=shift;
  1486. my $glob=shift;
  1487. my %params=@_;
  1488. my $from=exists $params{location} ? $params{location} : '';
  1489. # relative matching
  1490. if ($glob =~ m!^\./!) {
  1491. $from=~s#/?[^/]+$##;
  1492. $glob=~s#^\./##;
  1493. $glob="$from/$glob" if length $from;
  1494. }
  1495. my $regexp=IkiWiki::glob2re($glob);
  1496. if ($page=~/^$regexp$/i) {
  1497. if (! IkiWiki::isinternal($page) || $params{internal}) {
  1498. return IkiWiki::SuccessReason->new("$glob matches $page");
  1499. }
  1500. else {
  1501. return IkiWiki::FailReason->new("$glob matches $page, but the page is an internal page");
  1502. }
  1503. }
  1504. else {
  1505. return IkiWiki::FailReason->new("$glob does not match $page");
  1506. }
  1507. } #}}}
  1508. sub match_internal ($$;@) { #{{{
  1509. return match_glob($_[0], $_[1], @_, internal => 1)
  1510. } #}}}
  1511. sub match_link ($$;@) { #{{{
  1512. my $page=shift;
  1513. my $link=lc(shift);
  1514. my %params=@_;
  1515. my $from=exists $params{location} ? $params{location} : '';
  1516. # relative matching
  1517. if ($link =~ m!^\.! && defined $from) {
  1518. $from=~s#/?[^/]+$##;
  1519. $link=~s#^\./##;
  1520. $link="$from/$link" if length $from;
  1521. }
  1522. my $links = $IkiWiki::links{$page};
  1523. return IkiWiki::FailReason->new("$page has no links") unless $links && @{$links};
  1524. my $bestlink = IkiWiki::bestlink($from, $link);
  1525. foreach my $p (@{$links}) {
  1526. if (length $bestlink) {
  1527. return IkiWiki::SuccessReason->new("$page links to $link")
  1528. if $bestlink eq IkiWiki::bestlink($page, $p);
  1529. }
  1530. else {
  1531. return IkiWiki::SuccessReason->new("$page links to page $p matching $link")
  1532. if match_glob($p, $link, %params);
  1533. }
  1534. }
  1535. return IkiWiki::FailReason->new("$page does not link to $link");
  1536. } #}}}
  1537. sub match_backlink ($$;@) { #{{{
  1538. return match_link($_[1], $_[0], @_);
  1539. } #}}}
  1540. sub match_created_before ($$;@) { #{{{
  1541. my $page=shift;
  1542. my $testpage=shift;
  1543. if (exists $IkiWiki::pagectime{$testpage}) {
  1544. if ($IkiWiki::pagectime{$page} < $IkiWiki::pagectime{$testpage}) {
  1545. return IkiWiki::SuccessReason->new("$page created before $testpage");
  1546. }
  1547. else {
  1548. return IkiWiki::FailReason->new("$page not created before $testpage");
  1549. }
  1550. }
  1551. else {
  1552. return IkiWiki::FailReason->new("$testpage has no ctime");
  1553. }
  1554. } #}}}
  1555. sub match_created_after ($$;@) { #{{{
  1556. my $page=shift;
  1557. my $testpage=shift;
  1558. if (exists $IkiWiki::pagectime{$testpage}) {
  1559. if ($IkiWiki::pagectime{$page} > $IkiWiki::pagectime{$testpage}) {
  1560. return IkiWiki::SuccessReason->new("$page created after $testpage");
  1561. }
  1562. else {
  1563. return IkiWiki::FailReason->new("$page not created after $testpage");
  1564. }
  1565. }
  1566. else {
  1567. return IkiWiki::FailReason->new("$testpage has no ctime");
  1568. }
  1569. } #}}}
  1570. sub match_creation_day ($$;@) { #{{{
  1571. if ((gmtime($IkiWiki::pagectime{shift()}))[3] == shift) {
  1572. return IkiWiki::SuccessReason->new('creation_day matched');
  1573. }
  1574. else {
  1575. return IkiWiki::FailReason->new('creation_day did not match');
  1576. }
  1577. } #}}}
  1578. sub match_creation_month ($$;@) { #{{{
  1579. if ((gmtime($IkiWiki::pagectime{shift()}))[4] + 1 == shift) {
  1580. return IkiWiki::SuccessReason->new('creation_month matched');
  1581. }
  1582. else {
  1583. return IkiWiki::FailReason->new('creation_month did not match');
  1584. }
  1585. } #}}}
  1586. sub match_creation_year ($$;@) { #{{{
  1587. if ((gmtime($IkiWiki::pagectime{shift()}))[5] + 1900 == shift) {
  1588. return IkiWiki::SuccessReason->new('creation_year matched');
  1589. }
  1590. else {
  1591. return IkiWiki::FailReason->new('creation_year did not match');
  1592. }
  1593. } #}}}
  1594. 1