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