typos
[ikiwiki.git] / IkiWiki.pm
1 #!/usr/bin/perl
2
3 package IkiWiki;
4
5 use warnings;
6 use strict;
7 use Encode;
8 use HTML::Entities;
9 use URI::Escape q{uri_escape_utf8};
10 use POSIX;
11 use Storable;
12 use open qw{:utf8 :std};
13
14 use vars qw{%config %links %oldlinks %pagemtime %pagectime %pagecase
15             %pagestate %renderedfiles %oldrenderedfiles %pagesources
16             %destsources %depends %hooks %forcerebuild $gettext_obj};
17
18 use Exporter q{import};
19 our @EXPORT = qw(hook debug error template htmlpage add_depends pagespec_match
20                  bestlink htmllink readfile writefile pagetype srcfile pagename
21                  displaytime will_render gettext urlto targetpage
22                  add_underlay
23                  %config %links %pagestate %renderedfiles
24                  %pagesources %destsources);
25 our $VERSION = 2.00; # plugin interface version, next is ikiwiki version
26 our $version='unknown'; # VERSION_AUTOREPLACE done by Makefile, DNE
27 my $installdir=''; # INSTALLDIR_AUTOREPLACE done by Makefile, DNE
28
29 # Optimisation.
30 use Memoize;
31 memoize("abs2rel");
32 memoize("pagespec_translate");
33 memoize("file_pruned");
34
35 sub getsetup () { #{{{
36         wikiname => {
37                 type => "string",
38                 default => "wiki",
39                 description => "name of the wiki",
40                 safe => 1,
41                 rebuild => 1,
42         },
43         srcdir => {
44                 type => "string",
45                 default => undef,
46                 example => "$ENV{HOME}/wiki",
47                 description => "where the source of the wiki is located",
48                 safe => 0, # path
49                 rebuild => 1,
50         },
51         destdir => {
52                 type => "string",
53                 default => undef,
54                 example => "/var/www/wiki",
55                 description => "where to build the wiki",
56                 safe => 0, # path
57                 rebuild => 1,
58         },
59         adminuser => {
60                 type => "string",
61                 default => [],
62                 description => "user names of wiki admins",
63                 safe => 1,
64                 rebuild => 0,
65         },
66         adminemail => {
67                 type => "string",
68                 default => undef,
69                 example => 'me@example.com',
70                 description => "contact email for wiki",
71                 safe => 1,
72                 rebuild => 0,
73         },
74         url => {
75                 type => "string",
76                 default => '',
77                 example => "http://example.com/wiki",
78                 description => "base url to the wiki",
79                 safe => 1,
80                 rebuild => 1,
81         },
82         cgiurl => {
83                 type => "string",
84                 default => '',
85                 examples => "http://example.com/wiki/ikiwiki.cgi",
86                 description => "url to the ikiwiki.cgi",
87                 safe => 1,
88                 rebuild => 1,
89         },
90         rcs => {
91                 type => "string",
92                 default => '',
93                 description => "rcs backend to use",
94                 safe => 0, # don't allow overriding
95                 rebuild => 0,
96         },
97         historyurl => {
98                 type => "string",
99                 # TODO should be set per-rcs to allow different
100                 # examples and descriptions
101                 default => '',
102                 example => "XXX",
103                 description => "XXX",
104                 safe => 1,
105                 rebuild => 1,
106         },
107         diffurl => {
108                 type => "string",
109                 # TODO ditto above
110                 default => '',
111                 example => "XXX",
112                 description => "XXX",
113                 safe => 1,
114                 rebuild => 1,
115         },
116         discussion => {
117                 type => "boolean",
118                 default => 1,
119                 description => "enable Discussion pages?",
120                 safe => 1,
121                 rebuild => 1,
122         },
123         svnpath => {
124                 # TODO move
125                 type => "string",
126                 default => "trunk",
127                 description => "path inside svn repo where wiki is located",
128                 safe => 0, # could expose/overwrite data
129                 rebuild => 0,
130         },
131         gitorigin_branch => {
132                 type => "string",
133                 default => "origin",
134                 description => "the git origin to pull from",
135                 safe => 0, # paranoia
136                 rebuild => 0,
137         },
138         gitmaster_branch => {
139                 type => "string",
140                 default => "master",
141                 description => "the git master branch",
142                 safe => 0, # paranoia
143                 rebuild => 0,
144         },
145         wrappers => {
146                 type => "string",
147                 default => undef,
148                 description => "definitions of wrappers to generate",
149                 safe => 0,
150                 rebuild => 0,
151         },
152         wrapper => {
153                 type => "internal",
154                 default => undef,
155                 description => "wrapper filename",
156                 safe => 0,
157                 rebuild => 0,
158         },
159         wrappermode => {
160                 type => "internal",
161                 default => undef,
162                 description => "mode of wrapper file",
163                 safe => 0,
164                 rebuild => 0,
165         },
166         templatedir => {
167                 type => "string",
168                 default => "$installdir/share/ikiwiki/templates",
169                 description => "location of template files",
170                 safe => 0, # path
171                 rebuild => 1,
172         },
173         underlaydir => {
174                 type => "string",
175                 default => "$installdir/share/ikiwiki/basewiki",
176                 description => "base wiki source location",
177                 safe => 0, # path
178                 rebuild => 0,
179         },
180         underlaydirs => {
181                 type => "internal",
182                 default => [],
183                 description => "additional underlays to use",
184                 safe => 0,
185                 rebuild => 0,
186         },
187         verbose => {
188                 type => "boolean",
189                 default => 0,
190                 description => "display verbose messages when building?",
191                 safe => 1,
192                 rebuild => 0,
193         },
194         syslog => {
195                 type => "boolean",
196                 default => 0,
197                 description => "log to syslog?",
198                 safe => 1,
199                 rebuild => 0,
200         },
201         usedirs => {
202                 type => "boolean",
203                 default => 1,
204                 description => "create output files named page/index.html?",
205                 safe => 0, # changing requires manual transition
206                 rebuild => 1,
207         },
208         prefix_directives => {
209                 type => "boolean",
210                 default => 0,
211                 description => "use '!'-prefixed preprocessor directives?",
212                 safe => 0, # changing requires manual transition
213                 rebuild => 1,
214         },
215         default_pageext => {
216                 type => "string",
217                 default => "mdwn",
218                 description => "extension to use for new pages",
219                 safe => 0, # not sanitized
220                 rebuild => 0,
221         },
222         htmlext => {
223                 type => "string",
224                 default => "html",
225                 description => "extension to use for html files",
226                 safe => 0, # not sanitized
227                 rebuild => 1,
228         },
229         timeformat => {
230                 type => "string",
231                 default => '%c',
232                 description => "strftime format string to display date",
233                 safe => 1,
234                 rebuild => 1,
235         },
236         locale => {
237                 type => "string",
238                 default => undef,
239                 example => "en_US.UTF-8",
240                 description => "UTF-8 locale to use",
241                 safe => 0,
242                 rebuild => 1,
243         },
244         sslcookie => {
245                 type => "boolean",
246                 default => 0,
247                 description => "only send cookies over SSL connections?",
248                 safe => 1,
249                 rebuild => 0,
250         },
251         userdir => {
252                 type => "string",
253                 default => "",
254                 example => "users",
255                 description => "put user pages below specified page",
256                 safe => 1,
257                 rebuild => 1,
258         },
259         numbacklinks => {
260                 type => "integer",
261                 default => 10,
262                 description => "how many backlinks to show before hiding excess (0 to show all)",
263                 safe => 1,
264                 rebuild => 1,
265         },
266         hardlink => {
267                 type => "boolean",
268                 default => 0,
269                 description => "attempt to hardlink source files? (optimisation for large files)",
270                 safe => 0, # paranoia
271                 rebuild => 0,
272         },
273
274         exclude => {
275                 type => "string",
276                 default => undef,
277                 example => '\.wav$',
278                 description => "regexp of source files to ignore",
279                 safe => 0, # regexp
280                 rebuild => 1,
281         },
282         wiki_file_prune_regexps => {
283                 type => "internal",
284                 default => [qr/(^|\/)\.\.(\/|$)/, qr/^\./, qr/\/\./,
285                         qr/\.x?html?$/, qr/\.ikiwiki-new$/,
286                         qr/(^|\/).svn\//, qr/.arch-ids\//, qr/{arch}\//,
287                         qr/(^|\/)_MTN\//,
288                         qr/\.dpkg-tmp$/],
289                 description => "regexps of source files to ignore",
290                 safe => 0,
291                 rebuild => 1,
292         },
293         wiki_file_regexp => {
294                 type => "internal",
295                 default => qr/(^[-[:alnum:]_.:\/+]+$)/,
296                 description => "regexp of legal source files",
297                 safe => 0,
298                 rebuild => 1,
299         },
300         web_commit_regexp => {
301                 type => "internal",
302                 default => qr/^web commit (by (.*?(?=: |$))|from (\d+\.\d+\.\d+\.\d+)):?(.*)/,
303                 description => "regexp to parse web commits from logs",
304                 safe => 0,
305                 rebuild => 0,
306         },
307         cgi => {
308                 type => "internal",
309                 default => 0,
310                 description => "run as a cgi",
311                 safe => 0,
312                 rebuild => 0,
313         },
314         cgi_disable_uploads => {
315                 type => "internal",
316                 default => 1,
317                 description => "whether CGI should accept file uploads",
318                 safe => 0,
319                 rebuild => 0,
320         },
321         post_commit => {
322                 type => "internal",
323                 default => 0,
324                 description => "run as a post-commit hook",
325                 safe => 0,
326                 rebuild => 0,
327         },
328         rebuild => {
329                 type => "internal",
330                 default => 0,
331                 description => "running in rebuild mode",
332                 safe => 0,
333                 rebuild => 0,
334         },
335         refresh => {
336                 type => "internal",
337                 default => 0,
338                 description => "running in refresh mode",
339                 safe => 0,
340                 rebuild => 0,
341         },
342         getctime => {
343                 type => "internal",
344                 default => 0,
345                 description => "running in getctime mode",
346                 safe => 0,
347                 rebuild => 0,
348         },
349         w3mmode => {
350                 type => "internal",
351                 default => 0,
352                 description => "running in w3mmode",
353                 safe => 0,
354                 rebuild => 0,
355         },
356         setup => {
357                 type => "internal",
358                 default => undef,
359                 description => "setup file to read",
360                 safe => 0,
361                 rebuild => 0,
362         },
363         default_plugins => {
364                 type => "internal",
365                 default => [qw{mdwn link inline htmlscrubber passwordauth
366                                 openid signinedit lockedit conditional
367                                 recentchanges parentlinks}],
368                 description => "plugins to enable by default",
369                 safe => 1,
370                 rebuild => 1,
371         },
372         add_plugins => {
373                 type => "string",
374                 default => [],
375                 description => "plugins to add to the default configuration",
376                 safe => 1,
377                 rebuild => 1,
378         },
379         disable_plugins => {
380                 type => "string",
381                 default => [],
382                 description => "plugins to disable",
383                 safe => 1,
384                 rebuild => 1,
385         },
386         libdir => {
387                 type => "internal",
388                 default => undef,
389                 example => "$ENV{HOME}/.ikiwiki/",
390                 description => "extra library and plugin directory",
391                 safe => 0,
392                 rebuild => 0,
393         },
394 } #}}}
395
396 sub defaultconfig () { #{{{
397         my %s=getsetup();
398         my @ret;
399         foreach my $key (keys %s) {
400                 push @ret, $key, $s{$key}->{default};
401         }
402         use Data::Dumper;
403         return @ret;
404 } #}}}
405
406 sub checkconfig () { #{{{
407         # locale stuff; avoid LC_ALL since it overrides everything
408         if (defined $ENV{LC_ALL}) {
409                 $ENV{LANG} = $ENV{LC_ALL};
410                 delete $ENV{LC_ALL};
411         }
412         if (defined $config{locale}) {
413                 if (POSIX::setlocale(&POSIX::LC_ALL, $config{locale})) {
414                         $ENV{LANG}=$config{locale};
415                         $gettext_obj=undef;
416                 }
417         }
418
419         if (ref $config{ENV} eq 'HASH') {
420                 foreach my $val (keys %{$config{ENV}}) {
421                         $ENV{$val}=$config{ENV}{$val};
422                 }
423         }
424
425         if ($config{w3mmode}) {
426                 eval q{use Cwd q{abs_path}};
427                 error($@) if $@;
428                 $config{srcdir}=possibly_foolish_untaint(abs_path($config{srcdir}));
429                 $config{destdir}=possibly_foolish_untaint(abs_path($config{destdir}));
430                 $config{cgiurl}="file:///\$LIB/ikiwiki-w3m.cgi/".$config{cgiurl}
431                         unless $config{cgiurl} =~ m!file:///!;
432                 $config{url}="file://".$config{destdir};
433         }
434
435         if ($config{cgi} && ! length $config{url}) {
436                 error(gettext("Must specify url to wiki with --url when using --cgi"));
437         }
438         
439         $config{wikistatedir}="$config{srcdir}/.ikiwiki"
440                 unless exists $config{wikistatedir};
441         
442         if ($config{rcs}) {
443                 eval qq{use IkiWiki::Rcs::$config{rcs}};
444                 if ($@) {
445                         error("Failed to load RCS module IkiWiki::Rcs::$config{rcs}: $@");
446                 }
447         }
448         else {
449                 require IkiWiki::Rcs::Stub;
450         }
451
452         if (exists $config{umask}) {
453                 umask(possibly_foolish_untaint($config{umask}));
454         }
455
456         run_hooks(checkconfig => sub { shift->() });
457
458         return 1;
459 } #}}}
460
461 sub loadplugins () { #{{{
462         if (defined $config{libdir}) {
463                 unshift @INC, possibly_foolish_untaint($config{libdir});
464         }
465
466         loadplugin($_) foreach @{$config{default_plugins}}, @{$config{add_plugins}};
467
468         run_hooks(getopt => sub { shift->() });
469         if (grep /^-/, @ARGV) {
470                 print STDERR "Unknown option: $_\n"
471                         foreach grep /^-/, @ARGV;
472                 usage();
473         }
474
475         return 1;
476 } #}}}
477
478 sub loadplugin ($) { #{{{
479         my $plugin=shift;
480
481         return if grep { $_ eq $plugin} @{$config{disable_plugins}};
482
483         foreach my $dir (defined $config{libdir} ? possibly_foolish_untaint($config{libdir}) : undef,
484                          "$installdir/lib/ikiwiki") {
485                 if (defined $dir && -x "$dir/plugins/$plugin") {
486                         require IkiWiki::Plugin::external;
487                         import IkiWiki::Plugin::external "$dir/plugins/$plugin";
488                         return 1;
489                 }
490         }
491
492         my $mod="IkiWiki::Plugin::".possibly_foolish_untaint($plugin);
493         eval qq{use $mod};
494         if ($@) {
495                 error("Failed to load plugin $mod: $@");
496         }
497         return 1;
498 } #}}}
499
500 sub error ($;$) { #{{{
501         my $message=shift;
502         my $cleaner=shift;
503         log_message('err' => $message) if $config{syslog};
504         if (defined $cleaner) {
505                 $cleaner->();
506         }
507         die $message."\n";
508 } #}}}
509
510 sub debug ($) { #{{{
511         return unless $config{verbose};
512         return log_message(debug => @_);
513 } #}}}
514
515 my $log_open=0;
516 sub log_message ($$) { #{{{
517         my $type=shift;
518
519         if ($config{syslog}) {
520                 require Sys::Syslog;
521                 if (! $log_open) {
522                         Sys::Syslog::setlogsock('unix');
523                         Sys::Syslog::openlog('ikiwiki', '', 'user');
524                         $log_open=1;
525                 }
526                 return eval {
527                         Sys::Syslog::syslog($type, "[$config{wikiname}] %s", join(" ", @_));
528                 };
529         }
530         elsif (! $config{cgi}) {
531                 return print "@_\n";
532         }
533         else {
534                 return print STDERR "@_\n";
535         }
536 } #}}}
537
538 sub possibly_foolish_untaint ($) { #{{{
539         my $tainted=shift;
540         my ($untainted)=$tainted=~/(.*)/s;
541         return $untainted;
542 } #}}}
543
544 sub basename ($) { #{{{
545         my $file=shift;
546
547         $file=~s!.*/+!!;
548         return $file;
549 } #}}}
550
551 sub dirname ($) { #{{{
552         my $file=shift;
553
554         $file=~s!/*[^/]+$!!;
555         return $file;
556 } #}}}
557
558 sub pagetype ($) { #{{{
559         my $page=shift;
560         
561         if ($page =~ /\.([^.]+)$/) {
562                 return $1 if exists $hooks{htmlize}{$1};
563         }
564         return;
565 } #}}}
566
567 sub isinternal ($) { #{{{
568         my $page=shift;
569         return exists $pagesources{$page} &&
570                 $pagesources{$page} =~ /\._([^.]+)$/;
571 } #}}}
572
573 sub pagename ($) { #{{{
574         my $file=shift;
575
576         my $type=pagetype($file);
577         my $page=$file;
578         $page=~s/\Q.$type\E*$// if defined $type;
579         return $page;
580 } #}}}
581
582 sub targetpage ($$) { #{{{
583         my $page=shift;
584         my $ext=shift;
585         
586         if (! $config{usedirs} || $page =~ /^index$/ ) {
587                 return $page.".".$ext;
588         } else {
589                 return $page."/index.".$ext;
590         }
591 } #}}}
592
593 sub htmlpage ($) { #{{{
594         my $page=shift;
595         
596         return targetpage($page, $config{htmlext});
597 } #}}}
598
599 sub srcfile_stat { #{{{
600         my $file=shift;
601         my $nothrow=shift;
602
603         return "$config{srcdir}/$file", stat(_) if -e "$config{srcdir}/$file";
604         foreach my $dir (@{$config{underlaydirs}}, $config{underlaydir}) {
605                 return "$dir/$file", stat(_) if -e "$dir/$file";
606         }
607         error("internal error: $file cannot be found in $config{srcdir} or underlay") unless $nothrow;
608         return;
609 } #}}}
610
611 sub srcfile ($;$) { #{{{
612         return (srcfile_stat(@_))[0];
613 } #}}}
614
615 sub add_underlay ($) { #{{{
616         my $dir=shift;
617
618         if ($dir=~/^\//) {
619                 unshift @{$config{underlaydirs}}, $dir;
620         }
621         else {
622                 unshift @{$config{underlaydirs}}, "$config{underlaydir}/../$dir";
623         }
624
625         return 1;
626 } #}}}
627
628 sub readfile ($;$$) { #{{{
629         my $file=shift;
630         my $binary=shift;
631         my $wantfd=shift;
632
633         if (-l $file) {
634                 error("cannot read a symlink ($file)");
635         }
636         
637         local $/=undef;
638         open (my $in, "<", $file) || error("failed to read $file: $!");
639         binmode($in) if ($binary);
640         return \*$in if $wantfd;
641         my $ret=<$in>;
642         close $in || error("failed to read $file: $!");
643         return $ret;
644 } #}}}
645
646 sub prep_writefile ($$) { #{{{
647         my $file=shift;
648         my $destdir=shift;
649         
650         my $test=$file;
651         while (length $test) {
652                 if (-l "$destdir/$test") {
653                         error("cannot write to a symlink ($test)");
654                 }
655                 $test=dirname($test);
656         }
657
658         my $dir=dirname("$destdir/$file");
659         if (! -d $dir) {
660                 my $d="";
661                 foreach my $s (split(m!/+!, $dir)) {
662                         $d.="$s/";
663                         if (! -d $d) {
664                                 mkdir($d) || error("failed to create directory $d: $!");
665                         }
666                 }
667         }
668
669         return 1;
670 } #}}}
671
672 sub writefile ($$$;$$) { #{{{
673         my $file=shift; # can include subdirs
674         my $destdir=shift; # directory to put file in
675         my $content=shift;
676         my $binary=shift;
677         my $writer=shift;
678         
679         prep_writefile($file, $destdir);
680         
681         my $newfile="$destdir/$file.ikiwiki-new";
682         if (-l $newfile) {
683                 error("cannot write to a symlink ($newfile)");
684         }
685         
686         my $cleanup = sub { unlink($newfile) };
687         open (my $out, '>', $newfile) || error("failed to write $newfile: $!", $cleanup);
688         binmode($out) if ($binary);
689         if ($writer) {
690                 $writer->(\*$out, $cleanup);
691         }
692         else {
693                 print $out $content or error("failed writing to $newfile: $!", $cleanup);
694         }
695         close $out || error("failed saving $newfile: $!", $cleanup);
696         rename($newfile, "$destdir/$file") || 
697                 error("failed renaming $newfile to $destdir/$file: $!", $cleanup);
698
699         return 1;
700 } #}}}
701
702 my %cleared;
703 sub will_render ($$;$) { #{{{
704         my $page=shift;
705         my $dest=shift;
706         my $clear=shift;
707
708         # Important security check.
709         if (-e "$config{destdir}/$dest" && ! $config{rebuild} &&
710             ! grep { $_ eq $dest } (@{$renderedfiles{$page}}, @{$oldrenderedfiles{$page}})) {
711                 error("$config{destdir}/$dest independently created, not overwriting with version from $page");
712         }
713
714         if (! $clear || $cleared{$page}) {
715                 $renderedfiles{$page}=[$dest, grep { $_ ne $dest } @{$renderedfiles{$page}}];
716         }
717         else {
718                 foreach my $old (@{$renderedfiles{$page}}) {
719                         delete $destsources{$old};
720                 }
721                 $renderedfiles{$page}=[$dest];
722                 $cleared{$page}=1;
723         }
724         $destsources{$dest}=$page;
725
726         return 1;
727 } #}}}
728
729 sub bestlink ($$) { #{{{
730         my $page=shift;
731         my $link=shift;
732         
733         my $cwd=$page;
734         if ($link=~s/^\/+//) {
735                 # absolute links
736                 $cwd="";
737         }
738         $link=~s/\/$//;
739
740         do {
741                 my $l=$cwd;
742                 $l.="/" if length $l;
743                 $l.=$link;
744
745                 if (exists $links{$l}) {
746                         return $l;
747                 }
748                 elsif (exists $pagecase{lc $l}) {
749                         return $pagecase{lc $l};
750                 }
751         } while $cwd=~s!/?[^/]+$!!;
752
753         if (length $config{userdir}) {
754                 my $l = "$config{userdir}/".lc($link);
755                 if (exists $links{$l}) {
756                         return $l;
757                 }
758                 elsif (exists $pagecase{lc $l}) {
759                         return $pagecase{lc $l};
760                 }
761         }
762
763         #print STDERR "warning: page $page, broken link: $link\n";
764         return "";
765 } #}}}
766
767 sub isinlinableimage ($) { #{{{
768         my $file=shift;
769         
770         return $file =~ /\.(png|gif|jpg|jpeg)$/i;
771 } #}}}
772
773 sub pagetitle ($;$) { #{{{
774         my $page=shift;
775         my $unescaped=shift;
776
777         if ($unescaped) {
778                 $page=~s/(__(\d+)__|_)/$1 eq '_' ? ' ' : chr($2)/eg;
779         }
780         else {
781                 $page=~s/(__(\d+)__|_)/$1 eq '_' ? ' ' : "&#$2;"/eg;
782         }
783
784         return $page;
785 } #}}}
786
787 sub titlepage ($) { #{{{
788         my $title=shift;
789         $title=~s/([^-[:alnum:]:+\/.])/$1 eq ' ' ? '_' : "__".ord($1)."__"/eg;
790         return $title;
791 } #}}}
792
793 sub linkpage ($) { #{{{
794         my $link=shift;
795         $link=~s/([^-[:alnum:]:+\/._])/$1 eq ' ' ? '_' : "__".ord($1)."__"/eg;
796         return $link;
797 } #}}}
798
799 sub cgiurl (@) { #{{{
800         my %params=@_;
801
802         return $config{cgiurl}."?".
803                 join("&amp;", map $_."=".uri_escape_utf8($params{$_}), keys %params);
804 } #}}}
805
806 sub baseurl (;$) { #{{{
807         my $page=shift;
808
809         return "$config{url}/" if ! defined $page;
810         
811         $page=htmlpage($page);
812         $page=~s/[^\/]+$//;
813         $page=~s/[^\/]+\//..\//g;
814         return $page;
815 } #}}}
816
817 sub abs2rel ($$) { #{{{
818         # Work around very innefficient behavior in File::Spec if abs2rel
819         # is passed two relative paths. It's much faster if paths are
820         # absolute! (Debian bug #376658; fixed in debian unstable now)
821         my $path="/".shift;
822         my $base="/".shift;
823
824         require File::Spec;
825         my $ret=File::Spec->abs2rel($path, $base);
826         $ret=~s/^// if defined $ret;
827         return $ret;
828 } #}}}
829
830 sub displaytime ($;$) { #{{{
831         my $time=shift;
832         my $format=shift;
833         if (! defined $format) {
834                 $format=$config{timeformat};
835         }
836
837         # strftime doesn't know about encodings, so make sure
838         # its output is properly treated as utf8
839         return decode_utf8(POSIX::strftime($format, localtime($time)));
840 } #}}}
841
842 sub beautify_urlpath ($) { #{{{
843         my $url=shift;
844
845         if ($config{usedirs}) {
846                 $url =~ s!/index.$config{htmlext}$!/!;
847         }
848
849         # Ensure url is not an empty link, and
850         # if it's relative, make that explicit to avoid colon confusion.
851         if ($url !~ /^\//) {
852                 $url="./$url";
853         }
854
855         return $url;
856 } #}}}
857
858 sub urlto ($$;$) { #{{{
859         my $to=shift;
860         my $from=shift;
861         my $absolute=shift;
862         
863         if (! length $to) {
864                 return beautify_urlpath(baseurl($from)."index.$config{htmlext}");
865         }
866
867         if (! $destsources{$to}) {
868                 $to=htmlpage($to);
869         }
870
871         if ($absolute) {
872                 return $config{url}.beautify_urlpath("/".$to);
873         }
874
875         my $link = abs2rel($to, dirname(htmlpage($from)));
876
877         return beautify_urlpath($link);
878 } #}}}
879
880 sub htmllink ($$$;@) { #{{{
881         my $lpage=shift; # the page doing the linking
882         my $page=shift; # the page that will contain the link (different for inline)
883         my $link=shift;
884         my %opts=@_;
885
886         $link=~s/\/$//;
887
888         my $bestlink;
889         if (! $opts{forcesubpage}) {
890                 $bestlink=bestlink($lpage, $link);
891         }
892         else {
893                 $bestlink="$lpage/".lc($link);
894         }
895
896         my $linktext;
897         if (defined $opts{linktext}) {
898                 $linktext=$opts{linktext};
899         }
900         else {
901                 $linktext=pagetitle(basename($link));
902         }
903         
904         return "<span class=\"selflink\">$linktext</span>"
905                 if length $bestlink && $page eq $bestlink &&
906                    ! defined $opts{anchor};
907         
908         if (! $destsources{$bestlink}) {
909                 $bestlink=htmlpage($bestlink);
910
911                 if (! $destsources{$bestlink}) {
912                         return $linktext unless length $config{cgiurl};
913                         return "<span class=\"createlink\"><a href=\"".
914                                 cgiurl(
915                                         do => "create",
916                                         page => lc($link),
917                                         from => $lpage
918                                 ).
919                                 "\" rel=\"nofollow\">?</a>$linktext</span>"
920                 }
921         }
922         
923         $bestlink=abs2rel($bestlink, dirname(htmlpage($page)));
924         $bestlink=beautify_urlpath($bestlink);
925         
926         if (! $opts{noimageinline} && isinlinableimage($bestlink)) {
927                 return "<img src=\"$bestlink\" alt=\"$linktext\" />";
928         }
929
930         if (defined $opts{anchor}) {
931                 $bestlink.="#".$opts{anchor};
932         }
933
934         my @attrs;
935         if (defined $opts{rel}) {
936                 push @attrs, ' rel="'.$opts{rel}.'"';
937         }
938         if (defined $opts{class}) {
939                 push @attrs, ' class="'.$opts{class}.'"';
940         }
941
942         return "<a href=\"$bestlink\"@attrs>$linktext</a>";
943 } #}}}
944
945 sub userlink ($) { #{{{
946         my $user=shift;
947
948         my $oiduser=eval { openiduser($user) };
949         if (defined $oiduser) {
950                 return "<a href=\"$user\">$oiduser</a>";
951         }
952         else {
953                 eval q{use CGI 'escapeHTML'};
954                 error($@) if $@;
955
956                 return htmllink("", "", escapeHTML(
957                         length $config{userdir} ? $config{userdir}."/".$user : $user
958                 ), noimageinline => 1);
959         }
960 } #}}}
961
962 sub htmlize ($$$$) { #{{{
963         my $page=shift;
964         my $destpage=shift;
965         my $type=shift;
966         my $content=shift;
967         
968         my $oneline = $content !~ /\n/;
969
970         if (exists $hooks{htmlize}{$type}) {
971                 $content=$hooks{htmlize}{$type}{call}->(
972                         page => $page,
973                         content => $content,
974                 );
975         }
976         else {
977                 error("htmlization of $type not supported");
978         }
979
980         run_hooks(sanitize => sub {
981                 $content=shift->(
982                         page => $page,
983                         destpage => $destpage,
984                         content => $content,
985                 );
986         });
987         
988         if ($oneline) {
989                 # hack to get rid of enclosing junk added by markdown
990                 # and other htmlizers
991                 $content=~s/^<p>//i;
992                 $content=~s/<\/p>$//i;
993                 chomp $content;
994         }
995
996         return $content;
997 } #}}}
998
999 sub linkify ($$$) { #{{{
1000         my $page=shift;
1001         my $destpage=shift;
1002         my $content=shift;
1003
1004         run_hooks(linkify => sub {
1005                 $content=shift->(
1006                         page => $page,
1007                         destpage => $destpage,
1008                         content => $content,
1009                 );
1010         });
1011         
1012         return $content;
1013 } #}}}
1014
1015 our %preprocessing;
1016 our $preprocess_preview=0;
1017 sub preprocess ($$$;$$) { #{{{
1018         my $page=shift; # the page the data comes from
1019         my $destpage=shift; # the page the data will appear in (different for inline)
1020         my $content=shift;
1021         my $scan=shift;
1022         my $preview=shift;
1023
1024         # Using local because it needs to be set within any nested calls
1025         # of this function.
1026         local $preprocess_preview=$preview if defined $preview;
1027
1028         my $handle=sub {
1029                 my $escape=shift;
1030                 my $prefix=shift;
1031                 my $command=shift;
1032                 my $params=shift;
1033                 if (length $escape) {
1034                         return "[[$prefix$command $params]]";
1035                 }
1036                 elsif (exists $hooks{preprocess}{$command}) {
1037                         return "" if $scan && ! $hooks{preprocess}{$command}{scan};
1038                         # Note: preserve order of params, some plugins may
1039                         # consider it significant.
1040                         my @params;
1041                         while ($params =~ m{
1042                                 (?:([-\w]+)=)?          # 1: named parameter key?
1043                                 (?:
1044                                         """(.*?)"""     # 2: triple-quoted value
1045                                 |
1046                                         "([^"]+)"       # 3: single-quoted value
1047                                 |
1048                                         (\S+)           # 4: unquoted value
1049                                 )
1050                                 (?:\s+|$)               # delimiter to next param
1051                         }sgx) {
1052                                 my $key=$1;
1053                                 my $val;
1054                                 if (defined $2) {
1055                                         $val=$2;
1056                                         $val=~s/\r\n/\n/mg;
1057                                         $val=~s/^\n+//g;
1058                                         $val=~s/\n+$//g;
1059                                 }
1060                                 elsif (defined $3) {
1061                                         $val=$3;
1062                                 }
1063                                 elsif (defined $4) {
1064                                         $val=$4;
1065                                 }
1066
1067                                 if (defined $key) {
1068                                         push @params, $key, $val;
1069                                 }
1070                                 else {
1071                                         push @params, $val, '';
1072                                 }
1073                         }
1074                         if ($preprocessing{$page}++ > 3) {
1075                                 # Avoid loops of preprocessed pages preprocessing
1076                                 # other pages that preprocess them, etc.
1077                                 #translators: The first parameter is a
1078                                 #translators: preprocessor directive name,
1079                                 #translators: the second a page name, the
1080                                 #translators: third a number.
1081                                 return "[[".sprintf(gettext("%s preprocessing loop detected on %s at depth %i"),
1082                                         $command, $page, $preprocessing{$page}).
1083                                 "]]";
1084                         }
1085                         my $ret;
1086                         if (! $scan) {
1087                                 $ret=eval {
1088                                         $hooks{preprocess}{$command}{call}->(
1089                                                 @params,
1090                                                 page => $page,
1091                                                 destpage => $destpage,
1092                                                 preview => $preprocess_preview,
1093                                         );
1094                                 };
1095                                 if ($@) {
1096                                         chomp $@;
1097                                         $ret="[[!$command <span class=\"error\">".
1098                                                 gettext("Error").": $@"."</span>]]";
1099                                 }
1100                         }
1101                         else {
1102                                 # use void context during scan pass
1103                                 eval {
1104                                         $hooks{preprocess}{$command}{call}->(
1105                                                 @params,
1106                                                 page => $page,
1107                                                 destpage => $destpage,
1108                                                 preview => $preprocess_preview,
1109                                         );
1110                                 };
1111                                 $ret="";
1112                         }
1113                         $preprocessing{$page}--;
1114                         return $ret;
1115                 }
1116                 else {
1117                         return "[[$prefix$command $params]]";
1118                 }
1119         };
1120         
1121         my $regex;
1122         if ($config{prefix_directives}) {
1123                 $regex = qr{
1124                         (\\?)           # 1: escape?
1125                         \[\[(!)         # directive open; 2: prefix
1126                         ([-\w]+)        # 3: command
1127                         (               # 4: the parameters..
1128                                 \s+     # Must have space if parameters present
1129                                 (?:
1130                                         (?:[-\w]+=)?            # named parameter key?
1131                                         (?:
1132                                                 """.*?"""       # triple-quoted value
1133                                                 |
1134                                                 "[^"]+"         # single-quoted value
1135                                                 |
1136                                                 [^\s\]]+        # unquoted value
1137                                         )
1138                                         \s*                     # whitespace or end
1139                                                                 # of directive
1140                                 )
1141                         *)?             # 0 or more parameters
1142                         \]\]            # directive closed
1143                 }sx;
1144         }
1145         else {
1146                 $regex = qr{
1147                         (\\?)           # 1: escape?
1148                         \[\[(!?)        # directive open; 2: optional prefix
1149                         ([-\w]+)        # 3: command
1150                         \s+
1151                         (               # 4: the parameters..
1152                                 (?:
1153                                         (?:[-\w]+=)?            # named parameter key?
1154                                         (?:
1155                                                 """.*?"""       # triple-quoted value
1156                                                 |
1157                                                 "[^"]+"         # single-quoted value
1158                                                 |
1159                                                 [^\s\]]+        # unquoted value
1160                                         )
1161                                         \s*                     # whitespace or end
1162                                                                 # of directive
1163                                 )
1164                         *)              # 0 or more parameters
1165                         \]\]            # directive closed
1166                 }sx;
1167         }
1168
1169         $content =~ s{$regex}{$handle->($1, $2, $3, $4)}eg;
1170         return $content;
1171 } #}}}
1172
1173 sub filter ($$$) { #{{{
1174         my $page=shift;
1175         my $destpage=shift;
1176         my $content=shift;
1177
1178         run_hooks(filter => sub {
1179                 $content=shift->(page => $page, destpage => $destpage, 
1180                         content => $content);
1181         });
1182
1183         return $content;
1184 } #}}}
1185
1186 sub indexlink () { #{{{
1187         return "<a href=\"$config{url}\">$config{wikiname}</a>";
1188 } #}}}
1189
1190 my $wikilock;
1191
1192 sub lockwiki (;$) { #{{{
1193         my $wait=@_ ? shift : 1;
1194         # Take an exclusive lock on the wiki to prevent multiple concurrent
1195         # run issues. The lock will be dropped on program exit.
1196         if (! -d $config{wikistatedir}) {
1197                 mkdir($config{wikistatedir});
1198         }
1199         open($wikilock, '>', "$config{wikistatedir}/lockfile") ||
1200                 error ("cannot write to $config{wikistatedir}/lockfile: $!");
1201         if (! flock($wikilock, 2 | 4)) { # LOCK_EX | LOCK_NB
1202                 if ($wait) {
1203                         debug("wiki seems to be locked, waiting for lock");
1204                         my $wait=600; # arbitrary, but don't hang forever to 
1205                                       # prevent process pileup
1206                         for (1..$wait) {
1207                                 return if flock($wikilock, 2 | 4);
1208                                 sleep 1;
1209                         }
1210                         error("wiki is locked; waited $wait seconds without lock being freed (possible stuck process or stale lock?)");
1211                 }
1212                 else {
1213                         return 0;
1214                 }
1215         }
1216         return 1;
1217 } #}}}
1218
1219 sub unlockwiki () { #{{{
1220         return close($wikilock) if $wikilock;
1221         return;
1222 } #}}}
1223
1224 my $commitlock;
1225
1226 sub commit_hook_enabled () { #{{{
1227         open($commitlock, '+>', "$config{wikistatedir}/commitlock") ||
1228                 error("cannot write to $config{wikistatedir}/commitlock: $!");
1229         if (! flock($commitlock, 1 | 4)) { # LOCK_SH | LOCK_NB to test
1230                 close($commitlock) || error("failed closing commitlock: $!");
1231                 return 0;
1232         }
1233         close($commitlock) || error("failed closing commitlock: $!");
1234         return 1;
1235 } #}}}
1236
1237 sub disable_commit_hook () { #{{{
1238         open($commitlock, '>', "$config{wikistatedir}/commitlock") ||
1239                 error("cannot write to $config{wikistatedir}/commitlock: $!");
1240         if (! flock($commitlock, 2)) { # LOCK_EX
1241                 error("failed to get commit lock");
1242         }
1243         return 1;
1244 } #}}}
1245
1246 sub enable_commit_hook () { #{{{
1247         return close($commitlock) if $commitlock;
1248         return;
1249 } #}}}
1250
1251 sub loadindex () { #{{{
1252         %oldrenderedfiles=%pagectime=();
1253         if (! $config{rebuild}) {
1254                 %pagesources=%pagemtime=%oldlinks=%links=%depends=
1255                 %destsources=%renderedfiles=%pagecase=%pagestate=();
1256         }
1257         my $in;
1258         if (! open ($in, "<", "$config{wikistatedir}/indexdb")) {
1259                 if (-e "$config{wikistatedir}/index") {
1260                         system("ikiwiki-transition", "indexdb", $config{srcdir});
1261                         open ($in, "<", "$config{wikistatedir}/indexdb") || return;
1262                 }
1263                 else {
1264                         return;
1265                 }
1266         }
1267         my $ret=Storable::fd_retrieve($in);
1268         if (! defined $ret) {
1269                 return 0;
1270         }
1271         my %index=%$ret;
1272         foreach my $src (keys %index) {
1273                 my %d=%{$index{$src}};
1274                 my $page=pagename($src);
1275                 $pagectime{$page}=$d{ctime};
1276                 if (! $config{rebuild}) {
1277                         $pagesources{$page}=$src;
1278                         $pagemtime{$page}=$d{mtime};
1279                         $renderedfiles{$page}=$d{dest};
1280                         if (exists $d{links} && ref $d{links}) {
1281                                 $links{$page}=$d{links};
1282                                 $oldlinks{$page}=[@{$d{links}}];
1283                         }
1284                         if (exists $d{depends}) {
1285                                 $depends{$page}=$d{depends};
1286                         }
1287                         if (exists $d{state}) {
1288                                 $pagestate{$page}=$d{state};
1289                         }
1290                 }
1291                 $oldrenderedfiles{$page}=[@{$d{dest}}];
1292         }
1293         foreach my $page (keys %pagesources) {
1294                 $pagecase{lc $page}=$page;
1295         }
1296         foreach my $page (keys %renderedfiles) {
1297                 $destsources{$_}=$page foreach @{$renderedfiles{$page}};
1298         }
1299         return close($in);
1300 } #}}}
1301
1302 sub saveindex () { #{{{
1303         run_hooks(savestate => sub { shift->() });
1304
1305         my %hookids;
1306         foreach my $type (keys %hooks) {
1307                 $hookids{$_}=1 foreach keys %{$hooks{$type}};
1308         }
1309         my @hookids=keys %hookids;
1310
1311         if (! -d $config{wikistatedir}) {
1312                 mkdir($config{wikistatedir});
1313         }
1314         my $newfile="$config{wikistatedir}/indexdb.new";
1315         my $cleanup = sub { unlink($newfile) };
1316         open (my $out, '>', $newfile) || error("cannot write to $newfile: $!", $cleanup);
1317         my %index;
1318         foreach my $page (keys %pagemtime) {
1319                 next unless $pagemtime{$page};
1320                 my $src=$pagesources{$page};
1321
1322                 $index{$src}={
1323                         ctime => $pagectime{$page},
1324                         mtime => $pagemtime{$page},
1325                         dest => $renderedfiles{$page},
1326                         links => $links{$page},
1327                 };
1328
1329                 if (exists $depends{$page}) {
1330                         $index{$src}{depends} = $depends{$page};
1331                 }
1332
1333                 if (exists $pagestate{$page}) {
1334                         foreach my $id (@hookids) {
1335                                 foreach my $key (keys %{$pagestate{$page}{$id}}) {
1336                                         $index{$src}{state}{$id}{$key}=$pagestate{$page}{$id}{$key};
1337                                 }
1338                         }
1339                 }
1340         }
1341         my $ret=Storable::nstore_fd(\%index, $out);
1342         return if ! defined $ret || ! $ret;
1343         close $out || error("failed saving to $newfile: $!", $cleanup);
1344         rename($newfile, "$config{wikistatedir}/indexdb") ||
1345                 error("failed renaming $newfile to $config{wikistatedir}/indexdb", $cleanup);
1346         
1347         return 1;
1348 } #}}}
1349
1350 sub template_file ($) { #{{{
1351         my $template=shift;
1352
1353         foreach my $dir ($config{templatedir}, "$installdir/share/ikiwiki/templates") {
1354                 return "$dir/$template" if -e "$dir/$template";
1355         }
1356         return;
1357 } #}}}
1358
1359 sub template_params (@) { #{{{
1360         my $filename=template_file(shift);
1361
1362         if (! defined $filename) {
1363                 return if wantarray;
1364                 return "";
1365         }
1366
1367         my @ret=(
1368                 filter => sub {
1369                         my $text_ref = shift;
1370                         ${$text_ref} = decode_utf8(${$text_ref});
1371                 },
1372                 filename => $filename,
1373                 loop_context_vars => 1,
1374                 die_on_bad_params => 0,
1375                 @_
1376         );
1377         return wantarray ? @ret : {@ret};
1378 } #}}}
1379
1380 sub template ($;@) { #{{{
1381         require HTML::Template;
1382         return HTML::Template->new(template_params(@_));
1383 } #}}}
1384
1385 sub misctemplate ($$;@) { #{{{
1386         my $title=shift;
1387         my $pagebody=shift;
1388         
1389         my $template=template("misc.tmpl");
1390         $template->param(
1391                 title => $title,
1392                 indexlink => indexlink(),
1393                 wikiname => $config{wikiname},
1394                 pagebody => $pagebody,
1395                 baseurl => baseurl(),
1396                 @_,
1397         );
1398         run_hooks(pagetemplate => sub {
1399                 shift->(page => "", destpage => "", template => $template);
1400         });
1401         return $template->output;
1402 }#}}}
1403
1404 sub hook (@) { # {{{
1405         my %param=@_;
1406         
1407         if (! exists $param{type} || ! ref $param{call} || ! exists $param{id}) {
1408                 error 'hook requires type, call, and id parameters';
1409         }
1410
1411         return if $param{no_override} && exists $hooks{$param{type}}{$param{id}};
1412         
1413         $hooks{$param{type}}{$param{id}}=\%param;
1414         return 1;
1415 } # }}}
1416
1417 sub run_hooks ($$) { # {{{
1418         # Calls the given sub for each hook of the given type,
1419         # passing it the hook function to call.
1420         my $type=shift;
1421         my $sub=shift;
1422
1423         if (exists $hooks{$type}) {
1424                 my @deferred;
1425                 foreach my $id (keys %{$hooks{$type}}) {
1426                         if ($hooks{$type}{$id}{last}) {
1427                                 push @deferred, $id;
1428                                 next;
1429                         }
1430                         $sub->($hooks{$type}{$id}{call});
1431                 }
1432                 foreach my $id (@deferred) {
1433                         $sub->($hooks{$type}{$id}{call});
1434                 }
1435         }
1436
1437         return 1;
1438 } #}}}
1439
1440 sub globlist_to_pagespec ($) { #{{{
1441         my @globlist=split(' ', shift);
1442
1443         my (@spec, @skip);
1444         foreach my $glob (@globlist) {
1445                 if ($glob=~/^!(.*)/) {
1446                         push @skip, $glob;
1447                 }
1448                 else {
1449                         push @spec, $glob;
1450                 }
1451         }
1452
1453         my $spec=join(' or ', @spec);
1454         if (@skip) {
1455                 my $skip=join(' and ', @skip);
1456                 if (length $spec) {
1457                         $spec="$skip and ($spec)";
1458                 }
1459                 else {
1460                         $spec=$skip;
1461                 }
1462         }
1463         return $spec;
1464 } #}}}
1465
1466 sub is_globlist ($) { #{{{
1467         my $s=shift;
1468         return ( $s =~ /[^\s]+\s+([^\s]+)/ && $1 ne "and" && $1 ne "or" );
1469 } #}}}
1470
1471 sub safequote ($) { #{{{
1472         my $s=shift;
1473         $s=~s/[{}]//g;
1474         return "q{$s}";
1475 } #}}}
1476
1477 sub add_depends ($$) { #{{{
1478         my $page=shift;
1479         my $pagespec=shift;
1480         
1481         return unless pagespec_valid($pagespec);
1482
1483         if (! exists $depends{$page}) {
1484                 $depends{$page}=$pagespec;
1485         }
1486         else {
1487                 $depends{$page}=pagespec_merge($depends{$page}, $pagespec);
1488         }
1489
1490         return 1;
1491 } # }}}
1492
1493 sub file_pruned ($$) { #{{{
1494         require File::Spec;
1495         my $file=File::Spec->canonpath(shift);
1496         my $base=File::Spec->canonpath(shift);
1497         $file =~ s#^\Q$base\E/+##;
1498
1499         my $regexp='('.join('|', @{$config{wiki_file_prune_regexps}}).')';
1500         return $file =~ m/$regexp/ && $file ne $base;
1501 } #}}}
1502
1503 sub gettext { #{{{
1504         # Only use gettext in the rare cases it's needed.
1505         if ((exists $ENV{LANG} && length $ENV{LANG}) ||
1506             (exists $ENV{LC_ALL} && length $ENV{LC_ALL}) ||
1507             (exists $ENV{LC_MESSAGES} && length $ENV{LC_MESSAGES})) {
1508                 if (! $gettext_obj) {
1509                         $gettext_obj=eval q{
1510                                 use Locale::gettext q{textdomain};
1511                                 Locale::gettext->domain('ikiwiki')
1512                         };
1513                         if ($@) {
1514                                 print STDERR "$@";
1515                                 $gettext_obj=undef;
1516                                 return shift;
1517                         }
1518                 }
1519                 return $gettext_obj->get(shift);
1520         }
1521         else {
1522                 return shift;
1523         }
1524 } #}}}
1525
1526 sub yesno ($) { #{{{
1527         my $val=shift;
1528
1529         return (defined $val && lc($val) eq gettext("yes"));
1530 } #}}}
1531
1532 sub pagespec_merge ($$) { #{{{
1533         my $a=shift;
1534         my $b=shift;
1535
1536         return $a if $a eq $b;
1537
1538         # Support for old-style GlobLists.
1539         if (is_globlist($a)) {
1540                 $a=globlist_to_pagespec($a);
1541         }
1542         if (is_globlist($b)) {
1543                 $b=globlist_to_pagespec($b);
1544         }
1545
1546         return "($a) or ($b)";
1547 } #}}}
1548
1549 sub pagespec_translate ($) { #{{{
1550         my $spec=shift;
1551
1552         # Support for old-style GlobLists.
1553         if (is_globlist($spec)) {
1554                 $spec=globlist_to_pagespec($spec);
1555         }
1556
1557         # Convert spec to perl code.
1558         my $code="";
1559         while ($spec=~m{
1560                 \s*             # ignore whitespace
1561                 (               # 1: match a single word
1562                         \!              # !
1563                 |
1564                         \(              # (
1565                 |
1566                         \)              # )
1567                 |
1568                         \w+\([^\)]*\)   # command(params)
1569                 |
1570                         [^\s()]+        # any other text
1571                 )
1572                 \s*             # ignore whitespace
1573         }igx) {
1574                 my $word=$1;
1575                 if (lc $word eq 'and') {
1576                         $code.=' &&';
1577                 }
1578                 elsif (lc $word eq 'or') {
1579                         $code.=' ||';
1580                 }
1581                 elsif ($word eq "(" || $word eq ")" || $word eq "!") {
1582                         $code.=' '.$word;
1583                 }
1584                 elsif ($word =~ /^(\w+)\((.*)\)$/) {
1585                         if (exists $IkiWiki::PageSpec::{"match_$1"}) {
1586                                 $code.="IkiWiki::PageSpec::match_$1(\$page, ".safequote($2).", \@_)";
1587                         }
1588                         else {
1589                                 $code.=' 0';
1590                         }
1591                 }
1592                 else {
1593                         $code.=" IkiWiki::PageSpec::match_glob(\$page, ".safequote($word).", \@_)";
1594                 }
1595         }
1596
1597         if (! length $code) {
1598                 $code=0;
1599         }
1600
1601         no warnings;
1602         return eval 'sub { my $page=shift; '.$code.' }';
1603 } #}}}
1604
1605 sub pagespec_match ($$;@) { #{{{
1606         my $page=shift;
1607         my $spec=shift;
1608         my @params=@_;
1609
1610         # Backwards compatability with old calling convention.
1611         if (@params == 1) {
1612                 unshift @params, 'location';
1613         }
1614
1615         my $sub=pagespec_translate($spec);
1616         return IkiWiki::FailReason->new("syntax error in pagespec \"$spec\"") if $@;
1617         return $sub->($page, @params);
1618 } #}}}
1619
1620 sub pagespec_valid ($) { #{{{
1621         my $spec=shift;
1622
1623         my $sub=pagespec_translate($spec);
1624         return ! $@;
1625 } #}}}
1626         
1627 sub glob2re ($) { #{{{
1628         my $re=quotemeta(shift);
1629         $re=~s/\\\*/.*/g;
1630         $re=~s/\\\?/./g;
1631         return $re;
1632 } #}}}
1633
1634 package IkiWiki::FailReason;
1635
1636 use overload ( #{{{
1637         '""'    => sub { ${$_[0]} },
1638         '0+'    => sub { 0 },
1639         '!'     => sub { bless $_[0], 'IkiWiki::SuccessReason'},
1640         fallback => 1,
1641 ); #}}}
1642
1643 sub new { #{{{
1644         my $class = shift;
1645         my $value = shift;
1646         return bless \$value, $class;
1647 } #}}}
1648
1649 package IkiWiki::SuccessReason;
1650
1651 use overload ( #{{{
1652         '""'    => sub { ${$_[0]} },
1653         '0+'    => sub { 1 },
1654         '!'     => sub { bless $_[0], 'IkiWiki::FailReason'},
1655         fallback => 1,
1656 ); #}}}
1657
1658 sub new { #{{{
1659         my $class = shift;
1660         my $value = shift;
1661         return bless \$value, $class;
1662 }; #}}}
1663
1664 package IkiWiki::PageSpec;
1665
1666 sub match_glob ($$;@) { #{{{
1667         my $page=shift;
1668         my $glob=shift;
1669         my %params=@_;
1670         
1671         my $from=exists $params{location} ? $params{location} : '';
1672         
1673         # relative matching
1674         if ($glob =~ m!^\./!) {
1675                 $from=~s#/?[^/]+$##;
1676                 $glob=~s#^\./##;
1677                 $glob="$from/$glob" if length $from;
1678         }
1679
1680         my $regexp=IkiWiki::glob2re($glob);
1681         if ($page=~/^$regexp$/i) {
1682                 if (! IkiWiki::isinternal($page) || $params{internal}) {
1683                         return IkiWiki::SuccessReason->new("$glob matches $page");
1684                 }
1685                 else {
1686                         return IkiWiki::FailReason->new("$glob matches $page, but the page is an internal page");
1687                 }
1688         }
1689         else {
1690                 return IkiWiki::FailReason->new("$glob does not match $page");
1691         }
1692 } #}}}
1693
1694 sub match_internal ($$;@) { #{{{
1695         return match_glob($_[0], $_[1], @_, internal => 1)
1696 } #}}}
1697
1698 sub match_link ($$;@) { #{{{
1699         my $page=shift;
1700         my $link=lc(shift);
1701         my %params=@_;
1702
1703         my $from=exists $params{location} ? $params{location} : '';
1704
1705         # relative matching
1706         if ($link =~ m!^\.! && defined $from) {
1707                 $from=~s#/?[^/]+$##;
1708                 $link=~s#^\./##;
1709                 $link="$from/$link" if length $from;
1710         }
1711
1712         my $links = $IkiWiki::links{$page};
1713         return IkiWiki::FailReason->new("$page has no links") unless $links && @{$links};
1714         my $bestlink = IkiWiki::bestlink($from, $link);
1715         foreach my $p (@{$links}) {
1716                 if (length $bestlink) {
1717                         return IkiWiki::SuccessReason->new("$page links to $link")
1718                                 if $bestlink eq IkiWiki::bestlink($page, $p);
1719                 }
1720                 else {
1721                         return IkiWiki::SuccessReason->new("$page links to page $p matching $link")
1722                                 if match_glob($p, $link, %params);
1723                 }
1724         }
1725         return IkiWiki::FailReason->new("$page does not link to $link");
1726 } #}}}
1727
1728 sub match_backlink ($$;@) { #{{{
1729         return match_link($_[1], $_[0], @_);
1730 } #}}}
1731
1732 sub match_created_before ($$;@) { #{{{
1733         my $page=shift;
1734         my $testpage=shift;
1735
1736         if (exists $IkiWiki::pagectime{$testpage}) {
1737                 if ($IkiWiki::pagectime{$page} < $IkiWiki::pagectime{$testpage}) {
1738                         return IkiWiki::SuccessReason->new("$page created before $testpage");
1739                 }
1740                 else {
1741                         return IkiWiki::FailReason->new("$page not created before $testpage");
1742                 }
1743         }
1744         else {
1745                 return IkiWiki::FailReason->new("$testpage has no ctime");
1746         }
1747 } #}}}
1748
1749 sub match_created_after ($$;@) { #{{{
1750         my $page=shift;
1751         my $testpage=shift;
1752
1753         if (exists $IkiWiki::pagectime{$testpage}) {
1754                 if ($IkiWiki::pagectime{$page} > $IkiWiki::pagectime{$testpage}) {
1755                         return IkiWiki::SuccessReason->new("$page created after $testpage");
1756                 }
1757                 else {
1758                         return IkiWiki::FailReason->new("$page not created after $testpage");
1759                 }
1760         }
1761         else {
1762                 return IkiWiki::FailReason->new("$testpage has no ctime");
1763         }
1764 } #}}}
1765
1766 sub match_creation_day ($$;@) { #{{{
1767         if ((gmtime($IkiWiki::pagectime{shift()}))[3] == shift) {
1768                 return IkiWiki::SuccessReason->new('creation_day matched');
1769         }
1770         else {
1771                 return IkiWiki::FailReason->new('creation_day did not match');
1772         }
1773 } #}}}
1774
1775 sub match_creation_month ($$;@) { #{{{
1776         if ((gmtime($IkiWiki::pagectime{shift()}))[4] + 1 == shift) {
1777                 return IkiWiki::SuccessReason->new('creation_month matched');
1778         }
1779         else {
1780                 return IkiWiki::FailReason->new('creation_month did not match');
1781         }
1782 } #}}}
1783
1784 sub match_creation_year ($$;@) { #{{{
1785         if ((gmtime($IkiWiki::pagectime{shift()}))[5] + 1900 == shift) {
1786                 return IkiWiki::SuccessReason->new('creation_year matched');
1787         }
1788         else {
1789                 return IkiWiki::FailReason->new('creation_year did not match');
1790         }
1791 } #}}}
1792
1793 1