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