avoid floating boxes running up against the line at the bottom of the page
[ikiwiki.git] / IkiWiki.pm
1 #!/usr/bin/perl
2
3 package IkiWiki;
4 use warnings;
5 use strict;
6 use Encode;
7 use HTML::Entities;
8 use open qw{:utf8 :std};
9
10 # Optimisation.
11 use Memoize;
12 memoize("abs2rel");
13 memoize("pagespec_translate");
14
15 use vars qw{%config %links %oldlinks %oldpagemtime %pagectime %pagecase
16             %renderedfiles %pagesources %depends %hooks %forcerebuild};
17
18 my $installdir=''; # INSTALLDIR_AUTOREPLACE done by Makefile, DNE
19
20 sub defaultconfig () { #{{{
21         wiki_file_prune_regexp => qr{((^|/).svn/|\.\.|^\.|\/\.|\.x?html?$|\.rss$)},
22         wiki_link_regexp => qr/\[\[(?:([^\]\|]+)\|)?([^\s\]]+)\]\]/,
23         wiki_file_regexp => qr/(^[-[:alnum:]_.:\/+]+$)/,
24         verbose => 0,
25         syslog => 0,
26         wikiname => "wiki",
27         default_pageext => "mdwn",
28         cgi => 0,
29         rcs => 'svn',
30         notify => 0,
31         url => '',
32         cgiurl => '',
33         historyurl => '',
34         diffurl => '',
35         anonok => 0,
36         rss => 0,
37         discussion => 1,
38         rebuild => 0,
39         refresh => 0,
40         getctime => 0,
41         w3mmode => 0,
42         wrapper => undef,
43         wrappermode => undef,
44         svnrepo => undef,
45         svnpath => "trunk",
46         srcdir => undef,
47         destdir => undef,
48         pingurl => [],
49         templatedir => "$installdir/share/ikiwiki/templates",
50         underlaydir => "$installdir/share/ikiwiki/basewiki",
51         setup => undef,
52         adminuser => undef,
53         adminemail => undef,
54         plugin => [qw{mdwn inline htmlscrubber}],
55         timeformat => '%c',
56         locale => undef,
57 } #}}}
58    
59 sub checkconfig () { #{{{
60         # locale stuff; avoid LC_ALL since it overrides everything
61         if (defined $ENV{LC_ALL}) {
62                 $ENV{LANG} = $ENV{LC_ALL};
63                 delete $ENV{LC_ALL};
64         }
65         if (defined $config{locale}) {
66                 eval q{use POSIX};
67                 $ENV{LANG} = $config{locale}
68                         if POSIX::setlocale(&POSIX::LC_TIME, $config{locale});
69         }
70
71         if ($config{w3mmode}) {
72                 eval q{use Cwd q{abs_path}};
73                 $config{srcdir}=possibly_foolish_untaint(abs_path($config{srcdir}));
74                 $config{destdir}=possibly_foolish_untaint(abs_path($config{destdir}));
75                 $config{cgiurl}="file:///\$LIB/ikiwiki-w3m.cgi/".$config{cgiurl}
76                         unless $config{cgiurl} =~ m!file:///!;
77                 $config{url}="file://".$config{destdir};
78         }
79
80         if ($config{cgi} && ! length $config{url}) {
81                 error("Must specify url to wiki with --url when using --cgi\n");
82         }
83         if ($config{rss} && ! length $config{url}) {
84                 error("Must specify url to wiki with --url when using --rss\n");
85         }
86         
87         $config{wikistatedir}="$config{srcdir}/.ikiwiki"
88                 unless exists $config{wikistatedir};
89         
90         if ($config{rcs}) {
91                 eval qq{require IkiWiki::Rcs::$config{rcs}};
92                 if ($@) {
93                         error("Failed to load RCS module IkiWiki::Rcs::$config{rcs}: $@");
94                 }
95         }
96         else {
97                 require IkiWiki::Rcs::Stub;
98         }
99
100         run_hooks(checkconfig => sub { shift->() });
101 } #}}}
102
103 sub loadplugins () { #{{{
104         foreach my $plugin (@{$config{plugin}}) {
105                 my $mod="IkiWiki::Plugin::".possibly_foolish_untaint($plugin);
106                 eval qq{use $mod};
107                 if ($@) {
108                         error("Failed to load plugin $mod: $@");
109                 }
110         }
111         run_hooks(getopt => sub { shift->() });
112         if (grep /^-/, @ARGV) {
113                 print STDERR "Unknown option: $_\n"
114                         foreach grep /^-/, @ARGV;
115                 usage();
116         }
117 } #}}}
118
119 sub error ($) { #{{{
120         if ($config{cgi}) {
121                 print "Content-type: text/html\n\n";
122                 print misctemplate("Error", "<p>Error: @_</p>");
123         }
124         log_message(error => @_);
125         exit(1);
126 } #}}}
127
128 sub debug ($) { #{{{
129         return unless $config{verbose};
130         log_message(debug => @_);
131 } #}}}
132
133 my $log_open=0;
134 sub log_message ($$) { #{{{
135         my $type=shift;
136
137         if ($config{syslog}) {
138                 require Sys::Syslog;
139                 unless ($log_open) {
140                         Sys::Syslog::setlogsock('unix');
141                         Sys::Syslog::openlog('ikiwiki', '', 'user');
142                         $log_open=1;
143                 }
144                 eval {
145                         Sys::Syslog::syslog($type, join(" ", @_));
146                 }
147         }
148         elsif (! $config{cgi}) {
149                 print "@_\n";
150         }
151         else {
152                 print STDERR "@_\n";
153         }
154 } #}}}
155
156 sub possibly_foolish_untaint ($) { #{{{
157         my $tainted=shift;
158         my ($untainted)=$tainted=~/(.*)/;
159         return $untainted;
160 } #}}}
161
162 sub basename ($) { #{{{
163         my $file=shift;
164
165         $file=~s!.*/+!!;
166         return $file;
167 } #}}}
168
169 sub dirname ($) { #{{{
170         my $file=shift;
171
172         $file=~s!/*[^/]+$!!;
173         return $file;
174 } #}}}
175
176 sub pagetype ($) { #{{{
177         my $page=shift;
178         
179         if ($page =~ /\.([^.]+)$/) {
180                 return $1 if exists $hooks{htmlize}{$1};
181         }
182         return undef;
183 } #}}}
184
185 sub pagename ($) { #{{{
186         my $file=shift;
187
188         my $type=pagetype($file);
189         my $page=$file;
190         $page=~s/\Q.$type\E*$// if defined $type;
191         return $page;
192 } #}}}
193
194 sub htmlpage ($) { #{{{
195         my $page=shift;
196
197         return $page.".html";
198 } #}}}
199
200 sub srcfile ($) { #{{{
201         my $file=shift;
202
203         return "$config{srcdir}/$file" if -e "$config{srcdir}/$file";
204         return "$config{underlaydir}/$file" if -e "$config{underlaydir}/$file";
205         error("internal error: $file cannot be found");
206 } #}}}
207
208 sub readfile ($;$) { #{{{
209         my $file=shift;
210         my $binary=shift;
211
212         if (-l $file) {
213                 error("cannot read a symlink ($file)");
214         }
215         
216         local $/=undef;
217         open (IN, $file) || error("failed to read $file: $!");
218         binmode(IN) if ($binary);
219         my $ret=<IN>;
220         close IN;
221         return $ret;
222 } #}}}
223
224 sub writefile ($$$;$) { #{{{
225         my $file=shift; # can include subdirs
226         my $destdir=shift; # directory to put file in
227         my $content=shift;
228         my $binary=shift;
229         
230         my $test=$file;
231         while (length $test) {
232                 if (-l "$destdir/$test") {
233                         error("cannot write to a symlink ($test)");
234                 }
235                 $test=dirname($test);
236         }
237
238         my $dir=dirname("$destdir/$file");
239         if (! -d $dir) {
240                 my $d="";
241                 foreach my $s (split(m!/+!, $dir)) {
242                         $d.="$s/";
243                         if (! -d $d) {
244                                 mkdir($d) || error("failed to create directory $d: $!");
245                         }
246                 }
247         }
248         
249         open (OUT, ">$destdir/$file") || error("failed to write $destdir/$file: $!");
250         binmode(OUT) if ($binary);
251         print OUT $content;
252         close OUT;
253 } #}}}
254
255 sub bestlink ($$) { #{{{
256         # Given a page and the text of a link on the page, determine which
257         # existing page that link best points to. Prefers pages under a
258         # subdirectory with the same name as the source page, failing that
259         # goes down the directory tree to the base looking for matching
260         # pages.
261         my $page=shift;
262         my $link=shift;
263         
264         my $cwd=$page;
265         do {
266                 my $l=$cwd;
267                 $l.="/" if length $l;
268                 $l.=$link;
269
270                 if (exists $links{$l}) {
271                         return $l;
272                 }
273                 elsif (exists $pagecase{lc $l}) {
274                         return $pagecase{lc $l};
275                 }
276         } while $cwd=~s!/?[^/]+$!!;
277
278         #print STDERR "warning: page $page, broken link: $link\n";
279         return "";
280 } #}}}
281
282 sub isinlinableimage ($) { #{{{
283         my $file=shift;
284         
285         $file=~/\.(png|gif|jpg|jpeg)$/i;
286 } #}}}
287
288 sub pagetitle ($) { #{{{
289         my $page=shift;
290         $page=~s/__(\d+)__/&#$1;/g;
291         $page=~y/_/ /;
292         return $page;
293 } #}}}
294
295 sub titlepage ($) { #{{{
296         my $title=shift;
297         $title=~y/ /_/;
298         $title=~s/([^-[:alnum:]_:+\/.])/"__".ord($1)."__"/eg;
299         return $title;
300 } #}}}
301
302 sub cgiurl (@) { #{{{
303         my %params=@_;
304
305         return $config{cgiurl}."?".join("&amp;", map "$_=$params{$_}", keys %params);
306 } #}}}
307
308 sub baseurl (;$) { #{{{
309         my $page=shift;
310
311         return "$config{url}/" if ! defined $page;
312         
313         $page=~s/[^\/]+$//;
314         $page=~s/[^\/]+\//..\//g;
315         return $page;
316 } #}}}
317
318 sub abs2rel ($$) { #{{{
319         # Work around very innefficient behavior in File::Spec if abs2rel
320         # is passed two relative paths. It's much faster if paths are
321         # absolute!
322         my $path="/".shift;
323         my $base="/".shift;
324
325         require File::Spec;
326         my $ret=File::Spec->abs2rel($path, $base);
327         $ret=~s/^// if defined $ret;
328         return $ret;
329 } #}}}
330
331 sub htmllink ($$$;$$$) { #{{{
332         my $lpage=shift; # the page doing the linking
333         my $page=shift; # the page that will contain the link (different for inline)
334         my $link=shift;
335         my $noimageinline=shift; # don't turn links into inline html images
336         my $forcesubpage=shift; # force a link to a subpage
337         my $linktext=shift; # set to force the link text to something
338
339         my $bestlink;
340         if (! $forcesubpage) {
341                 $bestlink=bestlink($lpage, $link);
342         }
343         else {
344                 $bestlink="$lpage/".lc($link);
345         }
346
347         $linktext=pagetitle(basename($link)) unless defined $linktext;
348         
349         return "<span class=\"selflink\">$linktext</span>"
350                 if length $bestlink && $page eq $bestlink;
351         
352         # TODO BUG: %renderedfiles may not have it, if the linked to page
353         # was also added and isn't yet rendered! Note that this bug is
354         # masked by the bug that makes all new files be rendered twice.
355         if (! grep { $_ eq $bestlink } values %renderedfiles) {
356                 $bestlink=htmlpage($bestlink);
357         }
358         if (! grep { $_ eq $bestlink } values %renderedfiles) {
359                 return "<span><a href=\"".
360                         cgiurl(do => "create", page => lc($link), from => $page).
361                         "\">?</a>$linktext</span>"
362         }
363         
364         $bestlink=abs2rel($bestlink, dirname($page));
365         
366         if (! $noimageinline && isinlinableimage($bestlink)) {
367                 return "<img src=\"$bestlink\" alt=\"$linktext\" />";
368         }
369         return "<a href=\"$bestlink\">$linktext</a>";
370 } #}}}
371
372 sub indexlink () { #{{{
373         return "<a href=\"$config{url}\">$config{wikiname}</a>";
374 } #}}}
375
376 sub lockwiki () { #{{{
377         # Take an exclusive lock on the wiki to prevent multiple concurrent
378         # run issues. The lock will be dropped on program exit.
379         if (! -d $config{wikistatedir}) {
380                 mkdir($config{wikistatedir});
381         }
382         open(WIKILOCK, ">$config{wikistatedir}/lockfile") ||
383                 error ("cannot write to $config{wikistatedir}/lockfile: $!");
384         if (! flock(WIKILOCK, 2 | 4)) {
385                 debug("wiki seems to be locked, waiting for lock");
386                 my $wait=600; # arbitrary, but don't hang forever to 
387                               # prevent process pileup
388                 for (1..600) {
389                         return if flock(WIKILOCK, 2 | 4);
390                         sleep 1;
391                 }
392                 error("wiki is locked; waited $wait seconds without lock being freed (possible stuck process or stale lock?)");
393         }
394 } #}}}
395
396 sub unlockwiki () { #{{{
397         close WIKILOCK;
398 } #}}}
399
400 sub loadindex () { #{{{
401         open (IN, "$config{wikistatedir}/index") || return;
402         while (<IN>) {
403                 $_=possibly_foolish_untaint($_);
404                 chomp;
405                 my %items;
406                 $items{link}=[];
407                 foreach my $i (split(/ /, $_)) {
408                         my ($item, $val)=split(/=/, $i, 2);
409                         push @{$items{$item}}, decode_entities($val);
410                 }
411
412                 next unless exists $items{src}; # skip bad lines for now
413
414                 my $page=pagename($items{src}[0]);
415                 if (! $config{rebuild}) {
416                         $pagesources{$page}=$items{src}[0];
417                         $oldpagemtime{$page}=$items{mtime}[0];
418                         $oldlinks{$page}=[@{$items{link}}];
419                         $links{$page}=[@{$items{link}}];
420                         $depends{$page}=$items{depends}[0] if exists $items{depends};
421                         $renderedfiles{$page}=$items{dest}[0];
422                         $pagecase{lc $page}=$page;
423                 }
424                 $pagectime{$page}=$items{ctime}[0];
425         }
426         close IN;
427 } #}}}
428
429 sub saveindex () { #{{{
430         run_hooks(savestate => sub { shift->() });
431
432         if (! -d $config{wikistatedir}) {
433                 mkdir($config{wikistatedir});
434         }
435         open (OUT, ">$config{wikistatedir}/index") || 
436                 error("cannot write to $config{wikistatedir}/index: $!");
437         foreach my $page (keys %oldpagemtime) {
438                 next unless $oldpagemtime{$page};
439                 my $line="mtime=$oldpagemtime{$page} ".
440                         "ctime=$pagectime{$page} ".
441                         "src=$pagesources{$page} ".
442                         "dest=$renderedfiles{$page}";
443                 $line.=" link=$_" foreach @{$links{$page}};
444                 if (exists $depends{$page}) {
445                         $line.=" depends=".encode_entities($depends{$page}, " \t\n");
446                 }
447                 print OUT $line."\n";
448         }
449         close OUT;
450 } #}}}
451
452 sub template_params (@) { #{{{
453         my $filename=shift;
454         
455         require HTML::Template;
456         return filter => sub {
457                         my $text_ref = shift;
458                         $$text_ref=&Encode::decode_utf8($$text_ref);
459                 },
460                 filename => "$config{templatedir}/$filename",
461                 loop_context_vars => 1,
462                 die_on_bad_params => 0,
463                 @_;
464 } #}}}
465
466 sub template ($;@) { #{{{
467         HTML::Template->new(template_params(@_));
468 } #}}}
469
470 sub misctemplate ($$) { #{{{
471         my $title=shift;
472         my $pagebody=shift;
473         
474         my $template=template("misc.tmpl");
475         $template->param(
476                 title => $title,
477                 indexlink => indexlink(),
478                 wikiname => $config{wikiname},
479                 pagebody => $pagebody,
480                 baseurl => baseurl(),
481         );
482         return $template->output;
483 }#}}}
484
485 sub hook (@) { # {{{
486         my %param=@_;
487         
488         if (! exists $param{type} || ! ref $param{call} || ! exists $param{id}) {
489                 error "hook requires type, call, and id parameters";
490         }
491         
492         $hooks{$param{type}}{$param{id}}=\%param;
493 } # }}}
494
495 sub run_hooks ($$) { # {{{
496         # Calls the given sub for each hook of the given type,
497         # passing it the hook function to call.
498         my $type=shift;
499         my $sub=shift;
500
501         if (exists $hooks{$type}) {
502                 foreach my $id (keys %{$hooks{$type}}) {
503                         $sub->($hooks{$type}{$id}{call});
504                 }
505         }
506 } #}}}
507
508 sub globlist_to_pagespec ($) { #{{{
509         my @globlist=split(' ', shift);
510
511         my (@spec, @skip);
512         foreach my $glob (@globlist) {
513                 if ($glob=~/^!(.*)/) {
514                         push @skip, $glob;
515                 }
516                 else {
517                         push @spec, $glob;
518                 }
519         }
520
521         my $spec=join(" or ", @spec);
522         if (@skip) {
523                 my $skip=join(" and ", @skip);
524                 if (length $spec) {
525                         $spec="$skip and ($spec)";
526                 }
527                 else {
528                         $spec=$skip;
529                 }
530         }
531         return $spec;
532 } #}}}
533
534 sub is_globlist ($) { #{{{
535         my $s=shift;
536         $s=~/[^\s]+\s+([^\s]+)/ && $1 ne "and" && $1 ne "or";
537 } #}}}
538
539 sub safequote ($) { #{{{
540         my $s=shift;
541         $s=~s/[{}]//g;
542         return "q{$s}";
543 } #}}}
544
545 sub pagespec_merge ($$) { #{{{
546         my $a=shift;
547         my $b=shift;
548
549         return $a if $a eq $b;
550
551         # Support for old-style GlobLists.
552         if (is_globlist($a)) {
553                 $a=globlist_to_pagespec($a);
554         }
555         if (is_globlist($b)) {
556                 $b=globlist_to_pagespec($b);
557         }
558
559         return "($a) or ($b)";
560 } #}}}
561
562 sub pagespec_translate ($) { #{{{
563         # This assumes that $page is in scope in the function
564         # that evalulates the translated pagespec code.
565         my $spec=shift;
566
567         # Support for old-style GlobLists.
568         if (is_globlist($spec)) {
569                 $spec=globlist_to_pagespec($spec);
570         }
571
572         # Convert spec to perl code.
573         my $code="";
574         while ($spec=~m/\s*(\!|\(|\)|\w+\([^\)]+\)|[^\s()]+)\s*/ig) {
575                 my $word=$1;
576                 if (lc $word eq "and") {
577                         $code.=" &&";
578                 }
579                 elsif (lc $word eq "or") {
580                         $code.=" ||";
581                 }
582                 elsif ($word eq "(" || $word eq ")" || $word eq "!") {
583                         $code.=" ".$word;
584                 }
585                 elsif ($word =~ /^(link|backlink|created_before|created_after|creation_month|creation_year|creation_day)\((.+)\)$/) {
586                         $code.=" match_$1(\$page, ".safequote($2).")";
587                 }
588                 else {
589                         $code.=" match_glob(\$page, ".safequote($word).")";
590                 }
591         }
592
593         return $code;
594 } #}}}
595
596 sub pagespec_match ($$) { #{{{
597         my $page=shift;
598         my $spec=shift;
599
600         return eval pagespec_translate($spec);
601 } #}}}
602
603 sub match_glob ($$) { #{{{
604         my $page=shift;
605         my $glob=shift;
606
607         # turn glob into safe regexp
608         $glob=quotemeta($glob);
609         $glob=~s/\\\*/.*/g;
610         $glob=~s/\\\?/./g;
611
612         return $page=~/^$glob$/i;
613 } #}}}
614
615 sub match_link ($$) { #{{{
616         my $page=shift;
617         my $link=lc(shift);
618
619         my $links = $links{$page} or return undef;
620         foreach my $p (@$links) {
621                 return 1 if lc $p eq $link;
622         }
623         return 0;
624 } #}}}
625
626 sub match_backlink ($$) { #{{{
627         match_link(pop, pop);
628 } #}}}
629
630 sub match_created_before ($$) { #{{{
631         my $page=shift;
632         my $testpage=shift;
633
634         if (exists $pagectime{$testpage}) {
635                 return $pagectime{$page} < $pagectime{$testpage};
636         }
637         else {
638                 return 0;
639         }
640 } #}}}
641
642 sub match_created_after ($$) { #{{{
643         my $page=shift;
644         my $testpage=shift;
645
646         if (exists $pagectime{$testpage}) {
647                 return $pagectime{$page} > $pagectime{$testpage};
648         }
649         else {
650                 return 0;
651         }
652 } #}}}
653
654 sub match_creation_day ($$) { #{{{
655         return ((gmtime($pagectime{shift()}))[3] == shift);
656 } #}}}
657
658 sub match_creation_month ($$) { #{{{
659         return ((gmtime($pagectime{shift()}))[4] + 1 == shift);
660 } #}}}
661
662 sub match_creation_year ($$) { #{{{
663         return ((gmtime($pagectime{shift()}))[5] + 1900 == shift);
664 } #}}}
665
666 1