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