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