fixed
[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         my @attrs;
550         if (defined $opts{rel}) {
551                 push @attrs, ' rel="'.$opts{rel}.'"';
552         }
553
554         return "<a href=\"$bestlink\"@attrs>$linktext</a>";
555 } #}}}
556
557 sub htmlize ($$$) { #{{{
558         my $page=shift;
559         my $type=shift;
560         my $content=shift;
561
562         if (exists $hooks{htmlize}{$type}) {
563                 $content=$hooks{htmlize}{$type}{call}->(
564                         page => $page,
565                         content => $content,
566                 );
567         }
568         else {
569                 error("htmlization of $type not supported");
570         }
571
572         run_hooks(sanitize => sub {
573                 $content=shift->(
574                         page => $page,
575                         content => $content,
576                 );
577         });
578
579         return $content;
580 } #}}}
581
582 sub linkify ($$$) { #{{{
583         my $lpage=shift; # the page containing the links
584         my $page=shift; # the page the link will end up on (different for inline)
585         my $content=shift;
586
587         $content =~ s{(\\?)$config{wiki_link_regexp}}{
588                 defined $2
589                         ? ( $1 
590                                 ? "[[$2|$3".($4 ? "#$4" : "")."]]" 
591                                 : htmllink($lpage, $page, linkpage($3),
592                                         anchor => $4, linktext => pagetitle($2)))
593                         : ( $1 
594                                 ? "[[$3".($4 ? "#$4" : "")."]]"
595                                 : htmllink($lpage, $page, linkpage($3),
596                                         anchor => $4))
597         }eg;
598         
599         return $content;
600 } #}}}
601
602 my %preprocessing;
603 our $preprocess_preview=0;
604 sub preprocess ($$$;$$) { #{{{
605         my $page=shift; # the page the data comes from
606         my $destpage=shift; # the page the data will appear in (different for inline)
607         my $content=shift;
608         my $scan=shift;
609         my $preview=shift;
610
611         # Using local because it needs to be set within any nested calls
612         # of this function.
613         local $preprocess_preview=$preview if defined $preview;
614
615         my $handle=sub {
616                 my $escape=shift;
617                 my $command=shift;
618                 my $params=shift;
619                 if (length $escape) {
620                         return "\\[[$command $params]]";
621                 }
622                 elsif (exists $hooks{preprocess}{$command}) {
623                         return "" if $scan && ! $hooks{preprocess}{$command}{scan};
624                         # Note: preserve order of params, some plugins may
625                         # consider it significant.
626                         my @params;
627                         while ($params =~ m{
628                                 (?:(\w+)=)?             # 1: named parameter key?
629                                 (?:
630                                         """(.*?)"""     # 2: triple-quoted value
631                                 |
632                                         "([^"]+)"       # 3: single-quoted value
633                                 |
634                                         (\S+)           # 4: unquoted value
635                                 )
636                                 (?:\s+|$)               # delimiter to next param
637                         }sgx) {
638                                 my $key=$1;
639                                 my $val;
640                                 if (defined $2) {
641                                         $val=$2;
642                                         $val=~s/\r\n/\n/mg;
643                                         $val=~s/^\n+//g;
644                                         $val=~s/\n+$//g;
645                                 }
646                                 elsif (defined $3) {
647                                         $val=$3;
648                                 }
649                                 elsif (defined $4) {
650                                         $val=$4;
651                                 }
652
653                                 if (defined $key) {
654                                         push @params, $key, $val;
655                                 }
656                                 else {
657                                         push @params, $val, '';
658                                 }
659                         }
660                         if ($preprocessing{$page}++ > 3) {
661                                 # Avoid loops of preprocessed pages preprocessing
662                                 # other pages that preprocess them, etc.
663                                 #translators: The first parameter is a
664                                 #translators: preprocessor directive name,
665                                 #translators: the second a page name, the
666                                 #translators: third a number.
667                                 return "[[".sprintf(gettext("%s preprocessing loop detected on %s at depth %i"),
668                                         $command, $page, $preprocessing{$page}).
669                                 "]]";
670                         }
671                         my $ret=$hooks{preprocess}{$command}{call}->(
672                                 @params,
673                                 page => $page,
674                                 destpage => $destpage,
675                                 preview => $preprocess_preview,
676                         );
677                         $preprocessing{$page}--;
678                         return $ret;
679                 }
680                 else {
681                         return "\\[[$command $params]]";
682                 }
683         };
684         
685         $content =~ s{
686                 (\\?)           # 1: escape?
687                 \[\[            # directive open
688                 (\w+)           # 2: command
689                 \s+
690                 (               # 3: the parameters..
691                         (?:
692                                 (?:\w+=)?               # named parameter key?
693                                 (?:
694                                         """.*?"""       # triple-quoted value
695                                         |
696                                         "[^"]+"         # single-quoted value
697                                         |
698                                         [^\s\]]+        # unquoted value
699                                 )
700                                 \s*                     # whitespace or end
701                                                         # of directive
702                         )
703                 *)              # 0 or more parameters
704                 \]\]            # directive closed
705         }{$handle->($1, $2, $3)}sexg;
706         return $content;
707 } #}}}
708
709 sub filter ($$$) { #{{{
710         my $page=shift;
711         my $destpage=shift;
712         my $content=shift;
713
714         run_hooks(filter => sub {
715                 $content=shift->(page => $page, destpage => $destpage, 
716                         content => $content);
717         });
718
719         return $content;
720 } #}}}
721
722 sub indexlink () { #{{{
723         return "<a href=\"$config{url}\">$config{wikiname}</a>";
724 } #}}}
725
726 sub lockwiki (;$) { #{{{
727         my $wait=@_ ? shift : 1;
728         # Take an exclusive lock on the wiki to prevent multiple concurrent
729         # run issues. The lock will be dropped on program exit.
730         if (! -d $config{wikistatedir}) {
731                 mkdir($config{wikistatedir});
732         }
733         open(WIKILOCK, ">$config{wikistatedir}/lockfile") ||
734                 error ("cannot write to $config{wikistatedir}/lockfile: $!");
735         if (! flock(WIKILOCK, 2 | 4)) { # LOCK_EX | LOCK_NB
736                 if ($wait) {
737                         debug("wiki seems to be locked, waiting for lock");
738                         my $wait=600; # arbitrary, but don't hang forever to 
739                                       # prevent process pileup
740                         for (1..$wait) {
741                                 return if flock(WIKILOCK, 2 | 4);
742                                 sleep 1;
743                         }
744                         error("wiki is locked; waited $wait seconds without lock being freed (possible stuck process or stale lock?)");
745                 }
746                 else {
747                         return 0;
748                 }
749         }
750         return 1;
751 } #}}}
752
753 sub unlockwiki () { #{{{
754         close WIKILOCK;
755 } #}}}
756
757 sub commit_hook_enabled () { #{{{
758         open(COMMITLOCK, "+>$config{wikistatedir}/commitlock") ||
759                 error ("cannot write to $config{wikistatedir}/commitlock: $!");
760         if (! flock(COMMITLOCK, 1 | 4)) { # LOCK_SH | LOCK_NB to test
761                 close COMMITLOCK;
762                 return 0;
763         }
764         close COMMITLOCK;
765         return 1;
766 } #}}}
767
768 sub disable_commit_hook () { #{{{
769         open(COMMITLOCK, ">$config{wikistatedir}/commitlock") ||
770                 error ("cannot write to $config{wikistatedir}/commitlock: $!");
771         if (! flock(COMMITLOCK, 2)) { # LOCK_EX
772                 error("failed to get commit lock");
773         }
774 } #}}}
775
776 sub enable_commit_hook () { #{{{
777         close COMMITLOCK;
778 } #}}}
779
780 sub loadindex () { #{{{
781         open (IN, "$config{wikistatedir}/index") || return;
782         while (<IN>) {
783                 $_=possibly_foolish_untaint($_);
784                 chomp;
785                 my %items;
786                 $items{link}=[];
787                 $items{dest}=[];
788                 foreach my $i (split(/ /, $_)) {
789                         my ($item, $val)=split(/=/, $i, 2);
790                         push @{$items{$item}}, decode_entities($val);
791                 }
792
793                 next unless exists $items{src}; # skip bad lines for now
794
795                 my $page=pagename($items{src}[0]);
796                 if (! $config{rebuild}) {
797                         $pagesources{$page}=$items{src}[0];
798                         $pagemtime{$page}=$items{mtime}[0];
799                         $oldlinks{$page}=[@{$items{link}}];
800                         $links{$page}=[@{$items{link}}];
801                         $depends{$page}=$items{depends}[0] if exists $items{depends};
802                         $destsources{$_}=$page foreach @{$items{dest}};
803                         $renderedfiles{$page}=[@{$items{dest}}];
804                         $pagecase{lc $page}=$page;
805                 }
806                 $oldrenderedfiles{$page}=[@{$items{dest}}];
807                 $pagectime{$page}=$items{ctime}[0];
808         }
809         close IN;
810 } #}}}
811
812 sub saveindex () { #{{{
813         run_hooks(savestate => sub { shift->() });
814
815         if (! -d $config{wikistatedir}) {
816                 mkdir($config{wikistatedir});
817         }
818         my $newfile="$config{wikistatedir}/index.new";
819         my $cleanup = sub { unlink($newfile) };
820         open (OUT, ">$newfile") || error("cannot write to $newfile: $!", $cleanup);
821         foreach my $page (keys %pagemtime) {
822                 next unless $pagemtime{$page};
823                 my $line="mtime=$pagemtime{$page} ".
824                         "ctime=$pagectime{$page} ".
825                         "src=$pagesources{$page}";
826                 $line.=" dest=$_" foreach @{$renderedfiles{$page}};
827                 my %count;
828                 $line.=" link=$_" foreach grep { ++$count{$_} == 1 } @{$links{$page}};
829                 if (exists $depends{$page}) {
830                         $line.=" depends=".encode_entities($depends{$page}, " \t\n");
831                 }
832                 print OUT $line."\n" || error("failed writing to $newfile: $!", $cleanup);
833         }
834         close OUT || error("failed saving to $newfile: $!", $cleanup);
835         rename($newfile, "$config{wikistatedir}/index") ||
836                 error("failed renaming $newfile to $config{wikistatedir}/index", $cleanup);
837 } #}}}
838
839 sub template_file ($) { #{{{
840         my $template=shift;
841
842         foreach my $dir ($config{templatedir}, "$installdir/share/ikiwiki/templates") {
843                 return "$dir/$template" if -e "$dir/$template";
844         }
845         return undef;
846 } #}}}
847
848 sub template_params (@) { #{{{
849         my $filename=template_file(shift);
850
851         if (! defined $filename) {
852                 return if wantarray;
853                 return "";
854         }
855
856         my @ret=(
857                 filter => sub {
858                         my $text_ref = shift;
859                         $$text_ref=&Encode::decode_utf8($$text_ref);
860                 },
861                 filename => $filename,
862                 loop_context_vars => 1,
863                 die_on_bad_params => 0,
864                 @_
865         );
866         return wantarray ? @ret : {@ret};
867 } #}}}
868
869 sub template ($;@) { #{{{
870         require HTML::Template;
871         HTML::Template->new(template_params(@_));
872 } #}}}
873
874 sub misctemplate ($$;@) { #{{{
875         my $title=shift;
876         my $pagebody=shift;
877         
878         my $template=template("misc.tmpl");
879         $template->param(
880                 title => $title,
881                 indexlink => indexlink(),
882                 wikiname => $config{wikiname},
883                 pagebody => $pagebody,
884                 baseurl => baseurl(),
885                 @_,
886         );
887         run_hooks(pagetemplate => sub {
888                 shift->(page => "", destpage => "", template => $template);
889         });
890         return $template->output;
891 }#}}}
892
893 sub hook (@) { # {{{
894         my %param=@_;
895         
896         if (! exists $param{type} || ! ref $param{call} || ! exists $param{id}) {
897                 error "hook requires type, call, and id parameters";
898         }
899
900         return if $param{no_override} && exists $hooks{$param{type}}{$param{id}};
901         
902         $hooks{$param{type}}{$param{id}}=\%param;
903 } # }}}
904
905 sub run_hooks ($$) { # {{{
906         # Calls the given sub for each hook of the given type,
907         # passing it the hook function to call.
908         my $type=shift;
909         my $sub=shift;
910
911         if (exists $hooks{$type}) {
912                 my @deferred;
913                 foreach my $id (keys %{$hooks{$type}}) {
914                         if ($hooks{$type}{$id}{last}) {
915                                 push @deferred, $id;
916                                 next;
917                         }
918                         $sub->($hooks{$type}{$id}{call});
919                 }
920                 foreach my $id (@deferred) {
921                         $sub->($hooks{$type}{$id}{call});
922                 }
923         }
924 } #}}}
925
926 sub globlist_to_pagespec ($) { #{{{
927         my @globlist=split(' ', shift);
928
929         my (@spec, @skip);
930         foreach my $glob (@globlist) {
931                 if ($glob=~/^!(.*)/) {
932                         push @skip, $glob;
933                 }
934                 else {
935                         push @spec, $glob;
936                 }
937         }
938
939         my $spec=join(" or ", @spec);
940         if (@skip) {
941                 my $skip=join(" and ", @skip);
942                 if (length $spec) {
943                         $spec="$skip and ($spec)";
944                 }
945                 else {
946                         $spec=$skip;
947                 }
948         }
949         return $spec;
950 } #}}}
951
952 sub is_globlist ($) { #{{{
953         my $s=shift;
954         $s=~/[^\s]+\s+([^\s]+)/ && $1 ne "and" && $1 ne "or";
955 } #}}}
956
957 sub safequote ($) { #{{{
958         my $s=shift;
959         $s=~s/[{}]//g;
960         return "q{$s}";
961 } #}}}
962
963 sub add_depends ($$) { #{{{
964         my $page=shift;
965         my $pagespec=shift;
966         
967         if (! exists $depends{$page}) {
968                 $depends{$page}=$pagespec;
969         }
970         else {
971                 $depends{$page}=pagespec_merge($depends{$page}, $pagespec);
972         }
973 } # }}}
974
975 sub file_pruned ($$) { #{{{
976         require File::Spec;
977         my $file=File::Spec->canonpath(shift);
978         my $base=File::Spec->canonpath(shift);
979         $file=~s#^\Q$base\E/*##;
980
981         my $regexp='('.join('|', @{$config{wiki_file_prune_regexps}}).')';
982         $file =~ m/$regexp/;
983 } #}}}
984
985 sub gettext { #{{{
986         # Only use gettext in the rare cases it's needed.
987         if (exists $ENV{LANG} || exists $ENV{LC_ALL} || exists $ENV{LC_MESSAGES}) {
988                 if (! $gettext_obj) {
989                         $gettext_obj=eval q{
990                                 use Locale::gettext q{textdomain};
991                                 Locale::gettext->domain('ikiwiki')
992                         };
993                         if ($@) {
994                                 print STDERR "$@";
995                                 $gettext_obj=undef;
996                                 return shift;
997                         }
998                 }
999                 return $gettext_obj->get(shift);
1000         }
1001         else {
1002                 return shift;
1003         }
1004 } #}}}
1005
1006 sub pagespec_merge ($$) { #{{{
1007         my $a=shift;
1008         my $b=shift;
1009
1010         return $a if $a eq $b;
1011
1012         # Support for old-style GlobLists.
1013         if (is_globlist($a)) {
1014                 $a=globlist_to_pagespec($a);
1015         }
1016         if (is_globlist($b)) {
1017                 $b=globlist_to_pagespec($b);
1018         }
1019
1020         return "($a) or ($b)";
1021 } #}}}
1022
1023 sub pagespec_translate ($) { #{{{
1024         # This assumes that $page is in scope in the function
1025         # that evalulates the translated pagespec code.
1026         my $spec=shift;
1027
1028         # Support for old-style GlobLists.
1029         if (is_globlist($spec)) {
1030                 $spec=globlist_to_pagespec($spec);
1031         }
1032
1033         # Convert spec to perl code.
1034         my $code="";
1035         while ($spec=~m{
1036                 \s*             # ignore whitespace
1037                 (               # 1: match a single word
1038                         \!              # !
1039                 |
1040                         \(              # (
1041                 |
1042                         \)              # )
1043                 |
1044                         \w+\([^\)]+\)   # command(params)
1045                 |
1046                         [^\s()]+        # any other text
1047                 )
1048                 \s*             # ignore whitespace
1049         }igx) {
1050                 my $word=$1;
1051                 if (lc $word eq "and") {
1052                         $code.=" &&";
1053                 }
1054                 elsif (lc $word eq "or") {
1055                         $code.=" ||";
1056                 }
1057                 elsif ($word eq "(" || $word eq ")" || $word eq "!") {
1058                         $code.=" ".$word;
1059                 }
1060                 elsif ($word =~ /^(\w+)\((.*)\)$/) {
1061                         if (exists $IkiWiki::PageSpec::{"match_$1"}) {
1062                                 $code.="IkiWiki::PageSpec::match_$1(\$page, ".safequote($2).", \@params)";
1063                         }
1064                         else {
1065                                 $code.=" 0";
1066                         }
1067                 }
1068                 else {
1069                         $code.=" IkiWiki::PageSpec::match_glob(\$page, ".safequote($word).", \@params)";
1070                 }
1071         }
1072
1073         return $code;
1074 } #}}}
1075
1076 sub pagespec_match ($$;@) { #{{{
1077         my $page=shift;
1078         my $spec=shift;
1079         my @params=@_;
1080
1081         # Backwards compatability with old calling convention.
1082         if (@params == 1) {
1083                 unshift @params, "location";
1084         }
1085
1086         my $ret=eval pagespec_translate($spec);
1087         return IkiWiki::FailReason->new("syntax error") if $@;
1088         return $ret;
1089 } #}}}
1090
1091 package IkiWiki::FailReason;
1092
1093 use overload ( #{{{
1094         '""'    => sub { ${$_[0]} },
1095         '0+'    => sub { 0 },
1096         '!'     => sub { bless $_[0], 'IkiWiki::SuccessReason'},
1097         fallback => 1,
1098 ); #}}}
1099
1100 sub new { #{{{
1101         bless \$_[1], $_[0];
1102 } #}}}
1103
1104 package IkiWiki::SuccessReason;
1105
1106 use overload ( #{{{
1107         '""'    => sub { ${$_[0]} },
1108         '0+'    => sub { 1 },
1109         '!'     => sub { bless $_[0], 'IkiWiki::FailReason'},
1110         fallback => 1,
1111 ); #}}}
1112
1113 sub new { #{{{
1114         bless \$_[1], $_[0];
1115 }; #}}}
1116
1117 package IkiWiki::PageSpec;
1118
1119 sub match_glob ($$;@) { #{{{
1120         my $page=shift;
1121         my $glob=shift;
1122         my %params=@_;
1123         
1124         my $from=exists $params{location} ? $params{location} : "";
1125         
1126         # relative matching
1127         if ($glob =~ m!^\./!) {
1128                 $from=~s#/?[^/]+$##;
1129                 $glob=~s#^\./##;
1130                 $glob="$from/$glob" if length $from;
1131         }
1132
1133         # turn glob into safe regexp
1134         $glob=quotemeta($glob);
1135         $glob=~s/\\\*/.*/g;
1136         $glob=~s/\\\?/./g;
1137
1138         if ($page=~/^$glob$/i) {
1139                 return IkiWiki::SuccessReason->new("$glob matches $page");
1140         }
1141         else {
1142                 return IkiWiki::FailReason->new("$glob does not match $page");
1143         }
1144 } #}}}
1145
1146 sub match_link ($$;@) { #{{{
1147         my $page=shift;
1148         my $link=lc(shift);
1149         my %params=@_;
1150
1151         my $from=exists $params{location} ? $params{location} : "";
1152
1153         # relative matching
1154         if ($link =~ m!^\.! && defined $from) {
1155                 $from=~s#/?[^/]+$##;
1156                 $link=~s#^\./##;
1157                 $link="$from/$link" if length $from;
1158         }
1159
1160         my $links = $IkiWiki::links{$page} or return undef;
1161         return IkiWiki::FailReason->new("$page has no links") unless @$links;
1162         my $bestlink = IkiWiki::bestlink($from, $link);
1163         foreach my $p (@$links) {
1164                 if (length $bestlink) {
1165                         return IkiWiki::SuccessReason->new("$page links to $link")
1166                                 if $bestlink eq IkiWiki::bestlink($page, $p);
1167                 }
1168                 else {
1169                         return IkiWiki::SuccessReason->new("$page links to page matching $link")
1170                                 if match_glob($p, $link, %params);
1171                 }
1172         }
1173         return IkiWiki::FailReason->new("$page does not link to $link");
1174 } #}}}
1175
1176 sub match_backlink ($$;@) { #{{{
1177         match_link($_[1], $_[0], @_);
1178 } #}}}
1179
1180 sub match_created_before ($$;@) { #{{{
1181         my $page=shift;
1182         my $testpage=shift;
1183
1184         if (exists $IkiWiki::pagectime{$testpage}) {
1185                 if ($IkiWiki::pagectime{$page} < $IkiWiki::pagectime{$testpage}) {
1186                         IkiWiki::SuccessReason->new("$page created before $testpage");
1187                 }
1188                 else {
1189                         IkiWiki::FailReason->new("$page not created before $testpage");
1190                 }
1191         }
1192         else {
1193                 return IkiWiki::FailReason->new("$testpage has no ctime");
1194         }
1195 } #}}}
1196
1197 sub match_created_after ($$;@) { #{{{
1198         my $page=shift;
1199         my $testpage=shift;
1200
1201         if (exists $IkiWiki::pagectime{$testpage}) {
1202                 if ($IkiWiki::pagectime{$page} > $IkiWiki::pagectime{$testpage}) {
1203                         IkiWiki::SuccessReason->new("$page created after $testpage");
1204                 }
1205                 else {
1206                         IkiWiki::FailReason->new("$page not created after $testpage");
1207                 }
1208         }
1209         else {
1210                 return IkiWiki::FailReason->new("$testpage has no ctime");
1211         }
1212 } #}}}
1213
1214 sub match_creation_day ($$;@) { #{{{
1215         if ((gmtime($IkiWiki::pagectime{shift()}))[3] == shift) {
1216                 return IkiWiki::SuccessReason->new("creation_day matched");
1217         }
1218         else {
1219                 return IkiWiki::FailReason->new("creation_day did not match");
1220         }
1221 } #}}}
1222
1223 sub match_creation_month ($$;@) { #{{{
1224         if ((gmtime($IkiWiki::pagectime{shift()}))[4] + 1 == shift) {
1225                 return IkiWiki::SuccessReason->new("creation_month matched");
1226         }
1227         else {
1228                 return IkiWiki::FailReason->new("creation_month did not match");
1229         }
1230 } #}}}
1231
1232 sub match_creation_year ($$;@) { #{{{
1233         if ((gmtime($IkiWiki::pagectime{shift()}))[5] + 1900 == shift) {
1234                 return IkiWiki::SuccessReason->new("creation_year matched");
1235         }
1236         else {
1237                 return IkiWiki::FailReason->new("creation_year did not match");
1238         }
1239 } #}}}
1240
1241 sub match_user ($$;@) { #{{{
1242         shift;
1243         my $user=shift;
1244         my %params=@_;
1245
1246         return IkiWiki::FailReason->new("cannot match user") unless exists $params{user};
1247         if ($user eq $params{user}) {
1248                 return IkiWiki::SuccessReason->new("user is $user")
1249         }
1250         else {
1251                 return IkiWiki::FailReason->new("user is not $user");
1252         }
1253 } #}}}
1254
1255 1