]> sipb.mit.edu Git - ikiwiki.git/blob - IkiWiki.pm
resp
[ikiwiki.git] / IkiWiki.pm
1 #!/usr/bin/perl
2
3 package IkiWiki;
4 use warnings;
5 use strict;
6 use Encode;
7 use HTML::Entities;
8 use URI::Escape q{uri_escape_utf8};
9 use POSIX;
10 use open qw{:utf8 :std};
11
12 use vars qw{%config %links %oldlinks %pagemtime %pagectime %pagecase
13             %renderedfiles %oldrenderedfiles %pagesources %destsources
14             %depends %hooks %forcerebuild $gettext_obj};
15
16 use Exporter q{import};
17 our @EXPORT = qw(hook debug error template htmlpage add_depends pagespec_match
18                  bestlink htmllink readfile writefile pagetype srcfile pagename
19                  displaytime will_render gettext urlto targetpage
20                  %config %links %renderedfiles %pagesources %destsources);
21 our $VERSION = 2.00; # plugin interface version, next is ikiwiki version
22 our $version='unknown'; # VERSION_AUTOREPLACE done by Makefile, DNE
23 my $installdir=''; # INSTALLDIR_AUTOREPLACE done by Makefile, DNE
24
25 # Optimisation.
26 use Memoize;
27 memoize("abs2rel");
28 memoize("pagespec_translate");
29 memoize("file_pruned");
30
31 sub defaultconfig () { #{{{
32         wiki_file_prune_regexps => [qr/\.\./, qr/^\./, qr/\/\./,
33                 qr/\.x?html?$/, qr/\.ikiwiki-new$/,
34                 qr/(^|\/).svn\//, qr/.arch-ids\//, qr/{arch}\//,
35                 qr/\.dpkg-tmp$/],
36         wiki_link_regexp => qr{
37                 \[\[                    # beginning of link
38                 (?:
39                         ([^\]\|]+)      # 1: link text
40                         \|              # followed by '|'
41                 )?                      # optional
42
43                 ([^\s\]#]+)             # 2: page to link to
44                 (?:
45                         \#              # '#', beginning of anchor
46                         ([^\s\]]+)      # 3: anchor text
47                 )?                      # optional
48
49                 \]\]                    # end of link
50         }x,
51         wiki_file_regexp => qr/(^[-[:alnum:]_.:\/+]+$)/,
52         web_commit_regexp => qr/^web commit (by (.*?(?=: |$))|from (\d+\.\d+\.\d+\.\d+)):?(.*)/,
53         verbose => 0,
54         syslog => 0,
55         wikiname => "wiki",
56         default_pageext => "mdwn",
57         htmlext => "html",
58         cgi => 0,
59         post_commit => 0,
60         rcs => '',
61         notify => 0,
62         url => '',
63         cgiurl => '',
64         historyurl => '',
65         diffurl => '',
66         rss => 0,
67         atom => 0,
68         discussion => 1,
69         rebuild => 0,
70         refresh => 0,
71         getctime => 0,
72         w3mmode => 0,
73         wrapper => undef,
74         wrappermode => undef,
75         svnrepo => undef,
76         svnpath => "trunk",
77         gitorigin_branch => "origin",
78         gitmaster_branch => "master",
79         srcdir => undef,
80         destdir => undef,
81         pingurl => [],
82         templatedir => "$installdir/share/ikiwiki/templates",
83         underlaydir => "$installdir/share/ikiwiki/basewiki",
84         setup => undef,
85         adminuser => undef,
86         adminemail => undef,
87         plugin => [qw{mdwn inline htmlscrubber passwordauth openid signinedit
88                       lockedit conditional}],
89         libdir => undef,
90         timeformat => '%c',
91         locale => undef,
92         sslcookie => 0,
93         httpauth => 0,
94         userdir => "",
95         usedirs => 1,
96         numbacklinks => 10,
97         account_creation_password => "",
98 } #}}}
99    
100 sub checkconfig () { #{{{
101         # locale stuff; avoid LC_ALL since it overrides everything
102         if (defined $ENV{LC_ALL}) {
103                 $ENV{LANG} = $ENV{LC_ALL};
104                 delete $ENV{LC_ALL};
105         }
106         if (defined $config{locale}) {
107                 if (POSIX::setlocale(&POSIX::LC_ALL, $config{locale})) {
108                         $ENV{LANG}=$config{locale};
109                         $gettext_obj=undef;
110                 }
111         }
112
113         if ($config{w3mmode}) {
114                 eval q{use Cwd q{abs_path}};
115                 error($@) if $@;
116                 $config{srcdir}=possibly_foolish_untaint(abs_path($config{srcdir}));
117                 $config{destdir}=possibly_foolish_untaint(abs_path($config{destdir}));
118                 $config{cgiurl}="file:///\$LIB/ikiwiki-w3m.cgi/".$config{cgiurl}
119                         unless $config{cgiurl} =~ m!file:///!;
120                 $config{url}="file://".$config{destdir};
121         }
122
123         if ($config{cgi} && ! length $config{url}) {
124                 error(gettext("Must specify url to wiki with --url when using --cgi"));
125         }
126         
127         $config{wikistatedir}="$config{srcdir}/.ikiwiki"
128                 unless exists $config{wikistatedir};
129         
130         if ($config{rcs}) {
131                 eval qq{use IkiWiki::Rcs::$config{rcs}};
132                 if ($@) {
133                         error("Failed to load RCS module IkiWiki::Rcs::$config{rcs}: $@");
134                 }
135         }
136         else {
137                 require IkiWiki::Rcs::Stub;
138         }
139
140         run_hooks(checkconfig => sub { shift->() });
141 } #}}}
142
143 sub loadplugins () { #{{{
144         if (defined $config{libdir}) {
145                 unshift @INC, $config{libdir};
146         }
147
148         loadplugin($_) foreach @{$config{plugin}};
149
150         run_hooks(getopt => sub { shift->() });
151         if (grep /^-/, @ARGV) {
152                 print STDERR "Unknown option: $_\n"
153                         foreach grep /^-/, @ARGV;
154                 usage();
155         }
156 } #}}}
157
158 sub loadplugin ($) { #{{{
159         my $plugin=shift;
160
161         return if grep { $_ eq $plugin} @{$config{disable_plugins}};
162
163         my $mod="IkiWiki::Plugin::".possibly_foolish_untaint($plugin);
164         eval qq{use $mod};
165         if ($@) {
166                 error("Failed to load plugin $mod: $@");
167         }
168 } #}}}
169
170 sub error ($;$) { #{{{
171         my $message=shift;
172         my $cleaner=shift;
173         if ($config{cgi}) {
174                 print "Content-type: text/html\n\n";
175                 print misctemplate(gettext("Error"),
176                         "<p>".gettext("Error").": $message</p>");
177         }
178         log_message('err' => $message) if $config{syslog};
179         if (defined $cleaner) {
180                 $cleaner->();
181         }
182         die $message."\n";
183 } #}}}
184
185 sub debug ($) { #{{{
186         return unless $config{verbose};
187         log_message(debug => @_);
188 } #}}}
189
190 my $log_open=0;
191 sub log_message ($$) { #{{{
192         my $type=shift;
193
194         if ($config{syslog}) {
195                 require Sys::Syslog;
196                 unless ($log_open) {
197                         Sys::Syslog::setlogsock('unix');
198                         Sys::Syslog::openlog('ikiwiki', '', 'user');
199                         $log_open=1;
200                 }
201                 eval {
202                         Sys::Syslog::syslog($type, "[$config{wikiname}] %s", join(" ", @_));
203                 };
204         }
205         elsif (! $config{cgi}) {
206                 print "@_\n";
207         }
208         else {
209                 print STDERR "@_\n";
210         }
211 } #}}}
212
213 sub possibly_foolish_untaint ($) { #{{{
214         my $tainted=shift;
215         my ($untainted)=$tainted=~/(.*)/s;
216         return $untainted;
217 } #}}}
218
219 sub basename ($) { #{{{
220         my $file=shift;
221
222         $file=~s!.*/+!!;
223         return $file;
224 } #}}}
225
226 sub dirname ($) { #{{{
227         my $file=shift;
228
229         $file=~s!/*[^/]+$!!;
230         return $file;
231 } #}}}
232
233 sub pagetype ($) { #{{{
234         my $page=shift;
235         
236         if ($page =~ /\.([^.]+)$/) {
237                 return $1 if exists $hooks{htmlize}{$1};
238         }
239         return undef;
240 } #}}}
241
242 sub pagename ($) { #{{{
243         my $file=shift;
244
245         my $type=pagetype($file);
246         my $page=$file;
247         $page=~s/\Q.$type\E*$// if defined $type;
248         return $page;
249 } #}}}
250
251 sub targetpage ($$) { #{{{
252         my $page=shift;
253         my $ext=shift;
254         
255         if (! $config{usedirs} || $page =~ /^index$/ ) {
256                 return $page.".".$ext;
257         } else {
258                 return $page."/index.".$ext;
259         }
260 } #}}}
261
262 sub htmlpage ($) { #{{{
263         my $page=shift;
264         
265         return targetpage($page, $config{htmlext});
266 } #}}}
267
268 sub srcfile ($) { #{{{
269         my $file=shift;
270
271         return "$config{srcdir}/$file" if -e "$config{srcdir}/$file";
272         return "$config{underlaydir}/$file" if -e "$config{underlaydir}/$file";
273         error("internal error: $file cannot be found in $config{srcdir} or $config{underlaydir}");
274 } #}}}
275
276 sub readfile ($;$$) { #{{{
277         my $file=shift;
278         my $binary=shift;
279         my $wantfd=shift;
280
281         if (-l $file) {
282                 error("cannot read a symlink ($file)");
283         }
284         
285         local $/=undef;
286         open (IN, $file) || error("failed to read $file: $!");
287         binmode(IN) if ($binary);
288         return \*IN if $wantfd;
289         my $ret=<IN>;
290         close IN || error("failed to read $file: $!");
291         return $ret;
292 } #}}}
293
294 sub writefile ($$$;$$) { #{{{
295         my $file=shift; # can include subdirs
296         my $destdir=shift; # directory to put file in
297         my $content=shift;
298         my $binary=shift;
299         my $writer=shift;
300         
301         my $test=$file;
302         while (length $test) {
303                 if (-l "$destdir/$test") {
304                         error("cannot write to a symlink ($test)");
305                 }
306                 $test=dirname($test);
307         }
308         my $newfile="$destdir/$file.ikiwiki-new";
309         if (-l $newfile) {
310                 error("cannot write to a symlink ($newfile)");
311         }
312
313         my $dir=dirname($newfile);
314         if (! -d $dir) {
315                 my $d="";
316                 foreach my $s (split(m!/+!, $dir)) {
317                         $d.="$s/";
318                         if (! -d $d) {
319                                 mkdir($d) || error("failed to create directory $d: $!");
320                         }
321                 }
322         }
323
324         my $cleanup = sub { unlink($newfile) };
325         open (OUT, ">$newfile") || error("failed to write $newfile: $!", $cleanup);
326         binmode(OUT) if ($binary);
327         if ($writer) {
328                 $writer->(\*OUT, $cleanup);
329         }
330         else {
331                 print OUT $content or error("failed writing to $newfile: $!", $cleanup);
332         }
333         close OUT || error("failed saving $newfile: $!", $cleanup);
334         rename($newfile, "$destdir/$file") || 
335                 error("failed renaming $newfile to $destdir/$file: $!", $cleanup);
336 } #}}}
337
338 my %cleared;
339 sub will_render ($$;$) { #{{{
340         my $page=shift;
341         my $dest=shift;
342         my $clear=shift;
343
344         # Important security check.
345         if (-e "$config{destdir}/$dest" && ! $config{rebuild} &&
346             ! grep { $_ eq $dest } (@{$renderedfiles{$page}}, @{$oldrenderedfiles{$page}})) {
347                 error("$config{destdir}/$dest independently created, not overwriting with version from $page");
348         }
349
350         if (! $clear || $cleared{$page}) {
351                 $renderedfiles{$page}=[$dest, grep { $_ ne $dest } @{$renderedfiles{$page}}];
352         }
353         else {
354                 foreach my $old (@{$renderedfiles{$page}}) {
355                         delete $destsources{$old};
356                 }
357                 $renderedfiles{$page}=[$dest];
358                 $cleared{$page}=1;
359         }
360         $destsources{$dest}=$page;
361 } #}}}
362
363 sub bestlink ($$) { #{{{
364         my $page=shift;
365         my $link=shift;
366         
367         my $cwd=$page;
368         if ($link=~s/^\/+//) {
369                 # absolute links
370                 $cwd="";
371         }
372
373         do {
374                 my $l=$cwd;
375                 $l.="/" if length $l;
376                 $l.=$link;
377
378                 if (exists $links{$l}) {
379                         return $l;
380                 }
381                 elsif (exists $pagecase{lc $l}) {
382                         return $pagecase{lc $l};
383                 }
384         } while $cwd=~s!/?[^/]+$!!;
385
386         if (length $config{userdir}) {
387                 my $l = "$config{userdir}/".lc($link);
388                 if (exists $links{$l}) {
389                         return $l;
390                 }
391                 elsif (exists $pagecase{lc $l}) {
392                         return $pagecase{lc $l};
393                 }
394         }
395
396         #print STDERR "warning: page $page, broken link: $link\n";
397         return "";
398 } #}}}
399
400 sub isinlinableimage ($) { #{{{
401         my $file=shift;
402         
403         $file=~/\.(png|gif|jpg|jpeg)$/i;
404 } #}}}
405
406 sub pagetitle ($;$) { #{{{
407         my $page=shift;
408         my $unescaped=shift;
409
410         if ($unescaped) {
411                 $page=~s/(__(\d+)__|_)/$1 eq '_' ? ' ' : chr($2)/eg;
412         }
413         else {
414                 $page=~s/(__(\d+)__|_)/$1 eq '_' ? ' ' : "&#$2;"/eg;
415         }
416
417         return $page;
418 } #}}}
419
420 sub titlepage ($) { #{{{
421         my $title=shift;
422         $title=~s/([^-[:alnum:]:+\/.])/$1 eq ' ' ? '_' : "__".ord($1)."__"/eg;
423         return $title;
424 } #}}}
425
426 sub linkpage ($) { #{{{
427         my $link=shift;
428         $link=~s/([^-[:alnum:]:+\/._])/$1 eq ' ' ? '_' : "__".ord($1)."__"/eg;
429         return $link;
430 } #}}}
431
432 sub cgiurl (@) { #{{{
433         my %params=@_;
434
435         return $config{cgiurl}."?".
436                 join("&amp;", map $_."=".uri_escape_utf8($params{$_}), keys %params);
437 } #}}}
438
439 sub baseurl (;$) { #{{{
440         my $page=shift;
441
442         return "$config{url}/" if ! defined $page;
443         
444         $page=htmlpage($page);
445         $page=~s/[^\/]+$//;
446         $page=~s/[^\/]+\//..\//g;
447         return $page;
448 } #}}}
449
450 sub abs2rel ($$) { #{{{
451         # Work around very innefficient behavior in File::Spec if abs2rel
452         # is passed two relative paths. It's much faster if paths are
453         # absolute! (Debian bug #376658; fixed in debian unstable now)
454         my $path="/".shift;
455         my $base="/".shift;
456
457         require File::Spec;
458         my $ret=File::Spec->abs2rel($path, $base);
459         $ret=~s/^// if defined $ret;
460         return $ret;
461 } #}}}
462
463 sub displaytime ($) { #{{{
464         my $time=shift;
465
466         # strftime doesn't know about encodings, so make sure
467         # its output is properly treated as utf8
468         return decode_utf8(POSIX::strftime(
469                         $config{timeformat}, localtime($time)));
470 } #}}}
471
472 sub beautify_url ($) { #{{{
473         my $url=shift;
474
475         $url =~ s!/index.$config{htmlext}$!/!;
476         $url =~ s!^$!./!; # Browsers don't like empty links...
477
478         return $url;
479 } #}}}
480
481 sub urlto ($$) { #{{{
482         my $to=shift;
483         my $from=shift;
484
485         if (! length $to) {
486                 return beautify_url(baseurl($from));
487         }
488
489         if (! $destsources{$to}) {
490                 $to=htmlpage($to);
491         }
492
493         my $link = abs2rel($to, dirname(htmlpage($from)));
494
495         return beautify_url($link);
496 } #}}}
497
498 sub htmllink ($$$;@) { #{{{
499         my $lpage=shift; # the page doing the linking
500         my $page=shift; # the page that will contain the link (different for inline)
501         my $link=shift;
502         my %opts=@_;
503
504         my $bestlink;
505         if (! $opts{forcesubpage}) {
506                 $bestlink=bestlink($lpage, $link);
507         }
508         else {
509                 $bestlink="$lpage/".lc($link);
510         }
511
512         my $linktext;
513         if (defined $opts{linktext}) {
514                 $linktext=$opts{linktext};
515         }
516         else {
517                 $linktext=pagetitle(basename($link));
518         }
519         
520         return "<span class=\"selflink\">$linktext</span>"
521                 if length $bestlink && $page eq $bestlink;
522         
523         if (! $destsources{$bestlink}) {
524                 $bestlink=htmlpage($bestlink);
525
526                 if (! $destsources{$bestlink}) {
527                         return $linktext unless length $config{cgiurl};
528                         return "<span><a href=\"".
529                                 cgiurl(
530                                         do => "create",
531                                         page => pagetitle(lc($link), 1),
532                                         from => $lpage
533                                 ).
534                                 "\">?</a>$linktext</span>"
535                 }
536         }
537         
538         $bestlink=abs2rel($bestlink, dirname(htmlpage($page)));
539         $bestlink=beautify_url($bestlink);
540         
541         if (! $opts{noimageinline} && isinlinableimage($bestlink)) {
542                 return "<img src=\"$bestlink\" alt=\"$linktext\" />";
543         }
544
545         if (defined $opts{anchor}) {
546                 $bestlink.="#".$opts{anchor};
547         }
548
549         return "<a href=\"$bestlink\">$linktext</a>";
550 } #}}}
551
552 sub htmlize ($$$) { #{{{
553         my $page=shift;
554         my $type=shift;
555         my $content=shift;
556
557         if (exists $hooks{htmlize}{$type}) {
558                 $content=$hooks{htmlize}{$type}{call}->(
559                         page => $page,
560                         content => $content,
561                 );
562         }
563         else {
564                 error("htmlization of $type not supported");
565         }
566
567         run_hooks(sanitize => sub {
568                 $content=shift->(
569                         page => $page,
570                         content => $content,
571                 );
572         });
573
574         return $content;
575 } #}}}
576
577 sub linkify ($$$) { #{{{
578         my $lpage=shift; # the page containing the links
579         my $page=shift; # the page the link will end up on (different for inline)
580         my $content=shift;
581
582         $content =~ s{(\\?)$config{wiki_link_regexp}}{
583                 defined $2
584                         ? ( $1 
585                                 ? "[[$2|$3".($4 ? "#$4" : "")."]]" 
586                                 : htmllink($lpage, $page, linkpage($3),
587                                         anchor => $4, linktext => pagetitle($2)))
588                         : ( $1 
589                                 ? "[[$3".($4 ? "#$4" : "")."]]"
590                                 : htmllink($lpage, $page, linkpage($3),
591                                         anchor => $4))
592         }eg;
593         
594         return $content;
595 } #}}}
596
597 my %preprocessing;
598 our $preprocess_preview=0;
599 sub preprocess ($$$;$$) { #{{{
600         my $page=shift; # the page the data comes from
601         my $destpage=shift; # the page the data will appear in (different for inline)
602         my $content=shift;
603         my $scan=shift;
604         my $preview=shift;
605
606         # Using local because it needs to be set within any nested calls
607         # of this function.
608         local $preprocess_preview=$preview if defined $preview;
609
610         my $handle=sub {
611                 my $escape=shift;
612                 my $command=shift;
613                 my $params=shift;
614                 if (length $escape) {
615                         return "\\[[$command $params]]";
616                 }
617                 elsif (exists $hooks{preprocess}{$command}) {
618                         return "" if $scan && ! $hooks{preprocess}{$command}{scan};
619                         # Note: preserve order of params, some plugins may
620                         # consider it significant.
621                         my @params;
622                         while ($params =~ m{
623                                 (?:(\w+)=)?             # 1: named parameter key?
624                                 (?:
625                                         """(.*?)"""     # 2: triple-quoted value
626                                 |
627                                         "([^"]+)"       # 3: single-quoted value
628                                 |
629                                         (\S+)           # 4: unquoted value
630                                 )
631                                 (?:\s+|$)               # delimiter to next param
632                         }sgx) {
633                                 my $key=$1;
634                                 my $val;
635                                 if (defined $2) {
636                                         $val=$2;
637                                         $val=~s/\r\n/\n/mg;
638                                         $val=~s/^\n+//g;
639                                         $val=~s/\n+$//g;
640                                 }
641                                 elsif (defined $3) {
642                                         $val=$3;
643                                 }
644                                 elsif (defined $4) {
645                                         $val=$4;
646                                 }
647
648                                 if (defined $key) {
649                                         push @params, $key, $val;
650                                 }
651                                 else {
652                                         push @params, $val, '';
653                                 }
654                         }
655                         if ($preprocessing{$page}++ > 3) {
656                                 # Avoid loops of preprocessed pages preprocessing
657                                 # other pages that preprocess them, etc.
658                                 #translators: The first parameter is a
659                                 #translators: preprocessor directive name,
660                                 #translators: the second a page name, the
661                                 #translators: third a number.
662                                 return "[[".sprintf(gettext("%s preprocessing loop detected on %s at depth %i"),
663                                         $command, $page, $preprocessing{$page}).
664                                 "]]";
665                         }
666                         my $ret=$hooks{preprocess}{$command}{call}->(
667                                 @params,
668                                 page => $page,
669                                 destpage => $destpage,
670                                 preview => $preprocess_preview,
671                         );
672                         $preprocessing{$page}--;
673                         return $ret;
674                 }
675                 else {
676                         return "\\[[$command $params]]";
677                 }
678         };
679         
680         $content =~ s{
681                 (\\?)           # 1: escape?
682                 \[\[            # directive open
683                 (\w+)           # 2: command
684                 \s+
685                 (               # 3: the parameters..
686                         (?:
687                                 (?:\w+=)?               # named parameter key?
688                                 (?:
689                                         """.*?"""       # triple-quoted value
690                                         |
691                                         "[^"]+"         # single-quoted value
692                                         |
693                                         [^\s\]]+        # unquoted value
694                                 )
695                                 \s*                     # whitespace or end
696                                                         # of directive
697                         )
698                 *)              # 0 or more parameters
699                 \]\]            # directive closed
700         }{$handle->($1, $2, $3)}sexg;
701         return $content;
702 } #}}}
703
704 sub filter ($$$) { #{{{
705         my $page=shift;
706         my $destpage=shift;
707         my $content=shift;
708
709         run_hooks(filter => sub {
710                 $content=shift->(page => $page, destpage => $destpage, 
711                         content => $content);
712         });
713
714         return $content;
715 } #}}}
716
717 sub indexlink () { #{{{
718         return "<a href=\"$config{url}\">$config{wikiname}</a>";
719 } #}}}
720
721 sub lockwiki (;$) { #{{{
722         my $wait=@_ ? shift : 1;
723         # Take an exclusive lock on the wiki to prevent multiple concurrent
724         # run issues. The lock will be dropped on program exit.
725         if (! -d $config{wikistatedir}) {
726                 mkdir($config{wikistatedir});
727         }
728         open(WIKILOCK, ">$config{wikistatedir}/lockfile") ||
729                 error ("cannot write to $config{wikistatedir}/lockfile: $!");
730         if (! flock(WIKILOCK, 2 | 4)) { # LOCK_EX | LOCK_NB
731                 if ($wait) {
732                         debug("wiki seems to be locked, waiting for lock");
733                         my $wait=600; # arbitrary, but don't hang forever to 
734                                       # prevent process pileup
735                         for (1..$wait) {
736                                 return if flock(WIKILOCK, 2 | 4);
737                                 sleep 1;
738                         }
739                         error("wiki is locked; waited $wait seconds without lock being freed (possible stuck process or stale lock?)");
740                 }
741                 else {
742                         return 0;
743                 }
744         }
745         return 1;
746 } #}}}
747
748 sub unlockwiki () { #{{{
749         close WIKILOCK;
750 } #}}}
751
752 sub commit_hook_enabled () { #{{{
753         open(COMMITLOCK, "+>$config{wikistatedir}/commitlock") ||
754                 error ("cannot write to $config{wikistatedir}/commitlock: $!");
755         if (! flock(COMMITLOCK, 1 | 4)) { # LOCK_SH | LOCK_NB to test
756                 close COMMITLOCK;
757                 return 0;
758         }
759         close COMMITLOCK;
760         return 1;
761 } #}}}
762
763 sub disable_commit_hook () { #{{{
764         open(COMMITLOCK, ">$config{wikistatedir}/commitlock") ||
765                 error ("cannot write to $config{wikistatedir}/commitlock: $!");
766         if (! flock(COMMITLOCK, 2)) { # LOCK_EX
767                 error("failed to get commit lock");
768         }
769 } #}}}
770
771 sub enable_commit_hook () { #{{{
772         close COMMITLOCK;
773 } #}}}
774
775 sub loadindex () { #{{{
776         open (IN, "$config{wikistatedir}/index") || return;
777         while (<IN>) {
778                 $_=possibly_foolish_untaint($_);
779                 chomp;
780                 my %items;
781                 $items{link}=[];
782                 $items{dest}=[];
783                 foreach my $i (split(/ /, $_)) {
784                         my ($item, $val)=split(/=/, $i, 2);
785                         push @{$items{$item}}, decode_entities($val);
786                 }
787
788                 next unless exists $items{src}; # skip bad lines for now
789
790                 my $page=pagename($items{src}[0]);
791                 if (! $config{rebuild}) {
792                         $pagesources{$page}=$items{src}[0];
793                         $pagemtime{$page}=$items{mtime}[0];
794                         $oldlinks{$page}=[@{$items{link}}];
795                         $links{$page}=[@{$items{link}}];
796                         $depends{$page}=$items{depends}[0] if exists $items{depends};
797                         $destsources{$_}=$page foreach @{$items{dest}};
798                         $renderedfiles{$page}=[@{$items{dest}}];
799                         $pagecase{lc $page}=$page;
800                 }
801                 $oldrenderedfiles{$page}=[@{$items{dest}}];
802                 $pagectime{$page}=$items{ctime}[0];
803         }
804         close IN;
805 } #}}}
806
807 sub saveindex () { #{{{
808         run_hooks(savestate => sub { shift->() });
809
810         if (! -d $config{wikistatedir}) {
811                 mkdir($config{wikistatedir});
812         }
813         my $newfile="$config{wikistatedir}/index.new";
814         my $cleanup = sub { unlink($newfile) };
815         open (OUT, ">$newfile") || error("cannot write to $newfile: $!", $cleanup);
816         foreach my $page (keys %pagemtime) {
817                 next unless $pagemtime{$page};
818                 my $line="mtime=$pagemtime{$page} ".
819                         "ctime=$pagectime{$page} ".
820                         "src=$pagesources{$page}";
821                 $line.=" dest=$_" foreach @{$renderedfiles{$page}};
822                 my %count;
823                 $line.=" link=$_" foreach grep { ++$count{$_} == 1 } @{$links{$page}};
824                 if (exists $depends{$page}) {
825                         $line.=" depends=".encode_entities($depends{$page}, " \t\n");
826                 }
827                 print OUT $line."\n" || error("failed writing to $newfile: $!", $cleanup);
828         }
829         close OUT || error("failed saving to $newfile: $!", $cleanup);
830         rename($newfile, "$config{wikistatedir}/index") ||
831                 error("failed renaming $newfile to $config{wikistatedir}/index", $cleanup);
832 } #}}}
833
834 sub template_file ($) { #{{{
835         my $template=shift;
836
837         foreach my $dir ($config{templatedir}, "$installdir/share/ikiwiki/templates") {
838                 return "$dir/$template" if -e "$dir/$template";
839         }
840         return undef;
841 } #}}}
842
843 sub template_params (@) { #{{{
844         my $filename=template_file(shift);
845
846         if (! defined $filename) {
847                 return if wantarray;
848                 return "";
849         }
850
851         my @ret=(
852                 filter => sub {
853                         my $text_ref = shift;
854                         $$text_ref=&Encode::decode_utf8($$text_ref);
855                 },
856                 filename => $filename,
857                 loop_context_vars => 1,
858                 die_on_bad_params => 0,
859                 @_
860         );
861         return wantarray ? @ret : {@ret};
862 } #}}}
863
864 sub template ($;@) { #{{{
865         require HTML::Template;
866         HTML::Template->new(template_params(@_));
867 } #}}}
868
869 sub misctemplate ($$;@) { #{{{
870         my $title=shift;
871         my $pagebody=shift;
872         
873         my $template=template("misc.tmpl");
874         $template->param(
875                 title => $title,
876                 indexlink => indexlink(),
877                 wikiname => $config{wikiname},
878                 pagebody => $pagebody,
879                 baseurl => baseurl(),
880                 @_,
881         );
882         run_hooks(pagetemplate => sub {
883                 shift->(page => "", destpage => "", template => $template);
884         });
885         return $template->output;
886 }#}}}
887
888 sub hook (@) { # {{{
889         my %param=@_;
890         
891         if (! exists $param{type} || ! ref $param{call} || ! exists $param{id}) {
892                 error "hook requires type, call, and id parameters";
893         }
894
895         return if $param{no_override} && exists $hooks{$param{type}}{$param{id}};
896         
897         $hooks{$param{type}}{$param{id}}=\%param;
898 } # }}}
899
900 sub run_hooks ($$) { # {{{
901         # Calls the given sub for each hook of the given type,
902         # passing it the hook function to call.
903         my $type=shift;
904         my $sub=shift;
905
906         if (exists $hooks{$type}) {
907                 my @deferred;
908                 foreach my $id (keys %{$hooks{$type}}) {
909                         if ($hooks{$type}{$id}{last}) {
910                                 push @deferred, $id;
911                                 next;
912                         }
913                         $sub->($hooks{$type}{$id}{call});
914                 }
915                 foreach my $id (@deferred) {
916                         $sub->($hooks{$type}{$id}{call});
917                 }
918         }
919 } #}}}
920
921 sub globlist_to_pagespec ($) { #{{{
922         my @globlist=split(' ', shift);
923
924         my (@spec, @skip);
925         foreach my $glob (@globlist) {
926                 if ($glob=~/^!(.*)/) {
927                         push @skip, $glob;
928                 }
929                 else {
930                         push @spec, $glob;
931                 }
932         }
933
934         my $spec=join(" or ", @spec);
935         if (@skip) {
936                 my $skip=join(" and ", @skip);
937                 if (length $spec) {
938                         $spec="$skip and ($spec)";
939                 }
940                 else {
941                         $spec=$skip;
942                 }
943         }
944         return $spec;
945 } #}}}
946
947 sub is_globlist ($) { #{{{
948         my $s=shift;
949         $s=~/[^\s]+\s+([^\s]+)/ && $1 ne "and" && $1 ne "or";
950 } #}}}
951
952 sub safequote ($) { #{{{
953         my $s=shift;
954         $s=~s/[{}]//g;
955         return "q{$s}";
956 } #}}}
957
958 sub add_depends ($$) { #{{{
959         my $page=shift;
960         my $pagespec=shift;
961         
962         if (! exists $depends{$page}) {
963                 $depends{$page}=$pagespec;
964         }
965         else {
966                 $depends{$page}=pagespec_merge($depends{$page}, $pagespec);
967         }
968 } # }}}
969
970 sub file_pruned ($$) { #{{{
971         require File::Spec;
972         my $file=File::Spec->canonpath(shift);
973         my $base=File::Spec->canonpath(shift);
974         $file=~s#^\Q$base\E/*##;
975
976         my $regexp='('.join('|', @{$config{wiki_file_prune_regexps}}).')';
977         $file =~ m/$regexp/;
978 } #}}}
979
980 sub gettext { #{{{
981         # Only use gettext in the rare cases it's needed.
982         if (exists $ENV{LANG} || exists $ENV{LC_ALL} || exists $ENV{LC_MESSAGES}) {
983                 if (! $gettext_obj) {
984                         $gettext_obj=eval q{
985                                 use Locale::gettext q{textdomain};
986                                 Locale::gettext->domain('ikiwiki')
987                         };
988                         if ($@) {
989                                 print STDERR "$@";
990                                 $gettext_obj=undef;
991                                 return shift;
992                         }
993                 }
994                 return $gettext_obj->get(shift);
995         }
996         else {
997                 return shift;
998         }
999 } #}}}
1000
1001 sub pagespec_merge ($$) { #{{{
1002         my $a=shift;
1003         my $b=shift;
1004
1005         return $a if $a eq $b;
1006
1007         # Support for old-style GlobLists.
1008         if (is_globlist($a)) {
1009                 $a=globlist_to_pagespec($a);
1010         }
1011         if (is_globlist($b)) {
1012                 $b=globlist_to_pagespec($b);
1013         }
1014
1015         return "($a) or ($b)";
1016 } #}}}
1017
1018 sub pagespec_translate ($) { #{{{
1019         # This assumes that $page is in scope in the function
1020         # that evalulates the translated pagespec code.
1021         my $spec=shift;
1022
1023         # Support for old-style GlobLists.
1024         if (is_globlist($spec)) {
1025                 $spec=globlist_to_pagespec($spec);
1026         }
1027
1028         # Convert spec to perl code.
1029         my $code="";
1030         while ($spec=~m{
1031                 \s*             # ignore whitespace
1032                 (               # 1: match a single word
1033                         \!              # !
1034                 |
1035                         \(              # (
1036                 |
1037                         \)              # )
1038                 |
1039                         \w+\([^\)]+\)   # command(params)
1040                 |
1041                         [^\s()]+        # any other text
1042                 )
1043                 \s*             # ignore whitespace
1044         }igx) {
1045                 my $word=$1;
1046                 if (lc $word eq "and") {
1047                         $code.=" &&";
1048                 }
1049                 elsif (lc $word eq "or") {
1050                         $code.=" ||";
1051                 }
1052                 elsif ($word eq "(" || $word eq ")" || $word eq "!") {
1053                         $code.=" ".$word;
1054                 }
1055                 elsif ($word =~ /^(\w+)\((.*)\)$/) {
1056                         if (exists $IkiWiki::PageSpec::{"match_$1"}) {
1057                                 $code.="IkiWiki::PageSpec::match_$1(\$page, ".safequote($2).", \@params)";
1058                         }
1059                         else {
1060                                 $code.=" 0";
1061                         }
1062                 }
1063                 else {
1064                         $code.=" IkiWiki::PageSpec::match_glob(\$page, ".safequote($word).", \@params)";
1065                 }
1066         }
1067
1068         return $code;
1069 } #}}}
1070
1071 sub pagespec_match ($$;@) { #{{{
1072         my $page=shift;
1073         my $spec=shift;
1074         my @params=@_;
1075
1076         # Backwards compatability with old calling convention.
1077         if (@params == 1) {
1078                 unshift @params, "location";
1079         }
1080
1081         my $ret=eval pagespec_translate($spec);
1082         return IkiWiki::FailReason->new("syntax error") if $@;
1083         return $ret;
1084 } #}}}
1085
1086 package IkiWiki::FailReason;
1087
1088 use overload ( #{{{
1089         '""'    => sub { ${$_[0]} },
1090         '0+'    => sub { 0 },
1091         '!'     => sub { bless $_[0], 'IkiWiki::SuccessReason'},
1092         fallback => 1,
1093 ); #}}}
1094
1095 sub new { #{{{
1096         bless \$_[1], $_[0];
1097 } #}}}
1098
1099 package IkiWiki::SuccessReason;
1100
1101 use overload ( #{{{
1102         '""'    => sub { ${$_[0]} },
1103         '0+'    => sub { 1 },
1104         '!'     => sub { bless $_[0], 'IkiWiki::FailReason'},
1105         fallback => 1,
1106 ); #}}}
1107
1108 sub new { #{{{
1109         bless \$_[1], $_[0];
1110 }; #}}}
1111
1112 package IkiWiki::PageSpec;
1113
1114 sub match_glob ($$;@) { #{{{
1115         my $page=shift;
1116         my $glob=shift;
1117         my %params=@_;
1118         
1119         my $from=exists $params{location} ? $params{location} : "";
1120         
1121         # relative matching
1122         if ($glob =~ m!^\./!) {
1123                 $from=~s#/?[^/]+$##;
1124                 $glob=~s#^\./##;
1125                 $glob="$from/$glob" if length $from;
1126         }
1127
1128         # turn glob into safe regexp
1129         $glob=quotemeta($glob);
1130         $glob=~s/\\\*/.*/g;
1131         $glob=~s/\\\?/./g;
1132
1133         if ($page=~/^$glob$/i) {
1134                 return IkiWiki::SuccessReason->new("$glob matches $page");
1135         }
1136         else {
1137                 return IkiWiki::FailReason->new("$glob does not match $page");
1138         }
1139 } #}}}
1140
1141 sub match_link ($$;@) { #{{{
1142         my $page=shift;
1143         my $link=lc(shift);
1144         my %params=@_;
1145
1146         my $from=exists $params{location} ? $params{location} : "";
1147
1148         # relative matching
1149         if ($link =~ m!^\.! && defined $from) {
1150                 $from=~s#/?[^/]+$##;
1151                 $link=~s#^\./##;
1152                 $link="$from/$link" if length $from;
1153         }
1154
1155         my $links = $IkiWiki::links{$page} or return undef;
1156         return IkiWiki::FailReason->new("$page has no links") unless @$links;
1157         my $bestlink = IkiWiki::bestlink($from, $link);
1158         foreach my $p (@$links) {
1159                 if (length $bestlink) {
1160                         return IkiWiki::SuccessReason->new("$page links to $link")
1161                                 if $bestlink eq IkiWiki::bestlink($page, $p);
1162                 }
1163                 else {
1164                         return IkiWiki::SuccessReason->new("$page links to page matching $link")
1165                                 if match_glob($p, $link, %params);
1166                 }
1167         }
1168         return IkiWiki::FailReason->new("$page does not link to $link");
1169 } #}}}
1170
1171 sub match_backlink ($$;@) { #{{{
1172         match_link($_[1], $_[0], @_);
1173 } #}}}
1174
1175 sub match_created_before ($$;@) { #{{{
1176         my $page=shift;
1177         my $testpage=shift;
1178
1179         if (exists $IkiWiki::pagectime{$testpage}) {
1180                 if ($IkiWiki::pagectime{$page} < $IkiWiki::pagectime{$testpage}) {
1181                         IkiWiki::SuccessReason->new("$page created before $testpage");
1182                 }
1183                 else {
1184                         IkiWiki::FailReason->new("$page not created before $testpage");
1185                 }
1186         }
1187         else {
1188                 return IkiWiki::FailReason->new("$testpage has no ctime");
1189         }
1190 } #}}}
1191
1192 sub match_created_after ($$;@) { #{{{
1193         my $page=shift;
1194         my $testpage=shift;
1195
1196         if (exists $IkiWiki::pagectime{$testpage}) {
1197                 if ($IkiWiki::pagectime{$page} > $IkiWiki::pagectime{$testpage}) {
1198                         IkiWiki::SuccessReason->new("$page created after $testpage");
1199                 }
1200                 else {
1201                         IkiWiki::FailReason->new("$page not created after $testpage");
1202                 }
1203         }
1204         else {
1205                 return IkiWiki::FailReason->new("$testpage has no ctime");
1206         }
1207 } #}}}
1208
1209 sub match_creation_day ($$;@) { #{{{
1210         if ((gmtime($IkiWiki::pagectime{shift()}))[3] == shift) {
1211                 return IkiWiki::SuccessReason->new("creation_day matched");
1212         }
1213         else {
1214                 return IkiWiki::FailReason->new("creation_day did not match");
1215         }
1216 } #}}}
1217
1218 sub match_creation_month ($$;@) { #{{{
1219         if ((gmtime($IkiWiki::pagectime{shift()}))[4] + 1 == shift) {
1220                 return IkiWiki::SuccessReason->new("creation_month matched");
1221         }
1222         else {
1223                 return IkiWiki::FailReason->new("creation_month did not match");
1224         }
1225 } #}}}
1226
1227 sub match_creation_year ($$;@) { #{{{
1228         if ((gmtime($IkiWiki::pagectime{shift()}))[5] + 1900 == shift) {
1229                 return IkiWiki::SuccessReason->new("creation_year matched");
1230         }
1231         else {
1232                 return IkiWiki::FailReason->new("creation_year did not match");
1233         }
1234 } #}}}
1235
1236 sub match_user ($$;@) { #{{{
1237         shift;
1238         my $user=shift;
1239         my %params=@_;
1240
1241         return IkiWiki::FailReason->new("cannot match user") unless exists $params{user};
1242         if ($user eq $params{user}) {
1243                 return IkiWiki::SuccessReason->new("user is $user")
1244         }
1245         else {
1246                 return IkiWiki::FailReason->new("user is not $user");
1247         }
1248 } #}}}
1249
1250 1