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