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