some stylesheet improvements for the table, also add a bit more border
[ikiwiki.git] / IkiWiki.pm
1 #!/usr/bin/perl
2
3 package IkiWiki;
4 use warnings;
5 use strict;
6 use Encode;
7 use open qw{:utf8 :std};
8
9 # Optimisation.
10 use Memoize;
11 memoize("abs2rel");
12
13 use vars qw{%config %links %oldlinks %oldpagemtime %pagectime
14             %renderedfiles %pagesources %depends %hooks};
15
16 sub defaultconfig () { #{{{
17         wiki_file_prune_regexp => qr{((^|/).svn/|\.\.|^\.|\/\.|\.html?$|\.rss$)},
18         wiki_link_regexp => qr/\[\[(?:([^\]\|]+)\|)?([^\s\]]+)\]\]/,
19         wiki_processor_regexp => qr/\[\[(\w+)\s+([^\]]*)\]\]/,
20         wiki_file_regexp => qr/(^[-[:alnum:]_.:\/+]+$)/,
21         verbose => 0,
22         wikiname => "wiki",
23         default_pageext => "mdwn",
24         cgi => 0,
25         rcs => 'svn',
26         notify => 0,
27         url => '',
28         cgiurl => '',
29         historyurl => '',
30         diffurl => '',
31         anonok => 0,
32         rss => 0,
33         discussion => 1,
34         rebuild => 0,
35         refresh => 0,
36         getctime => 0,
37         wrapper => undef,
38         wrappermode => undef,
39         svnrepo => undef,
40         svnpath => "trunk",
41         srcdir => undef,
42         destdir => undef,
43         pingurl => [],
44         templatedir => "/usr/share/ikiwiki/templates",
45         underlaydir => "/usr/share/ikiwiki/basewiki",
46         setup => undef,
47         adminuser => undef,
48         adminemail => undef,
49         plugin => [qw{mdwn inline htmlscrubber}],
50         timeformat => '%c',
51 } #}}}
52             
53 sub checkconfig () { #{{{
54         if ($config{cgi} && ! length $config{url}) {
55                 error("Must specify url to wiki with --url when using --cgi\n");
56         }
57         if ($config{rss} && ! length $config{url}) {
58                 error("Must specify url to wiki with --url when using --rss\n");
59         }
60         
61         $config{wikistatedir}="$config{srcdir}/.ikiwiki"
62                 unless exists $config{wikistatedir};
63         
64         if ($config{rcs}) {
65                 eval qq{require IkiWiki::Rcs::$config{rcs}};
66                 if ($@) {
67                         error("Failed to load RCS module IkiWiki::Rcs::$config{rcs}: $@");
68                 }
69         }
70         else {
71                 require IkiWiki::Rcs::Stub;
72         }
73
74         foreach my $plugin (@{$config{plugin}}) {
75                 my $mod="IkiWiki::Plugin::".possibly_foolish_untaint($plugin);
76                 eval qq{use $mod};
77                 if ($@) {
78                         error("Failed to load plugin $mod: $@");
79                 }
80         }
81
82         if (exists $hooks{checkconfig}) {
83                 foreach my $id (keys %{$hooks{checkconfig}}) {
84                         $hooks{checkconfig}{$id}{call}->();
85                 }
86         }
87 } #}}}
88
89 sub error ($) { #{{{
90         if ($config{cgi}) {
91                 print "Content-type: text/html\n\n";
92                 print misctemplate("Error", "<p>Error: @_</p>");
93         }
94         die @_;
95 } #}}}
96
97 sub debug ($) { #{{{
98         return unless $config{verbose};
99         if (! $config{cgi}) {
100                 print "@_\n";
101         }
102         else {
103                 print STDERR "@_\n";
104         }
105 } #}}}
106
107 sub possibly_foolish_untaint ($) { #{{{
108         my $tainted=shift;
109         my ($untainted)=$tainted=~/(.*)/;
110         return $untainted;
111 } #}}}
112
113 sub basename ($) { #{{{
114         my $file=shift;
115
116         $file=~s!.*/+!!;
117         return $file;
118 } #}}}
119
120 sub dirname ($) { #{{{
121         my $file=shift;
122
123         $file=~s!/*[^/]+$!!;
124         return $file;
125 } #}}}
126
127 sub pagetype ($) { #{{{
128         my $page=shift;
129         
130         if ($page =~ /\.([^.]+)$/) {
131                 return $1 if exists $hooks{htmlize}{$1};
132         }
133         return undef;
134 } #}}}
135
136 sub pagename ($) { #{{{
137         my $file=shift;
138
139         my $type=pagetype($file);
140         my $page=$file;
141         $page=~s/\Q.$type\E*$// if defined $type;
142         return $page;
143 } #}}}
144
145 sub htmlpage ($) { #{{{
146         my $page=shift;
147
148         return $page.".html";
149 } #}}}
150
151 sub srcfile ($) { #{{{
152         my $file=shift;
153
154         return "$config{srcdir}/$file" if -e "$config{srcdir}/$file";
155         return "$config{underlaydir}/$file" if -e "$config{underlaydir}/$file";
156         error("internal error: $file cannot be found");
157 } #}}}
158
159 sub readfile ($;$) { #{{{
160         my $file=shift;
161         my $binary=shift;
162
163         if (-l $file) {
164                 error("cannot read a symlink ($file)");
165         }
166         
167         local $/=undef;
168         open (IN, $file) || error("failed to read $file: $!");
169         binmode(IN) if ($binary);
170         my $ret=<IN>;
171         close IN;
172         return $ret;
173 } #}}}
174
175 sub writefile ($$$;$) { #{{{
176         my $file=shift; # can include subdirs
177         my $destdir=shift; # directory to put file in
178         my $content=shift;
179         my $binary=shift;
180         
181         my $test=$file;
182         while (length $test) {
183                 if (-l "$destdir/$test") {
184                         error("cannot write to a symlink ($test)");
185                 }
186                 $test=dirname($test);
187         }
188
189         my $dir=dirname("$destdir/$file");
190         if (! -d $dir) {
191                 my $d="";
192                 foreach my $s (split(m!/+!, $dir)) {
193                         $d.="$s/";
194                         if (! -d $d) {
195                                 mkdir($d) || error("failed to create directory $d: $!");
196                         }
197                 }
198         }
199         
200         open (OUT, ">$destdir/$file") || error("failed to write $destdir/$file: $!");
201         binmode(OUT) if ($binary);
202         print OUT $content;
203         close OUT;
204 } #}}}
205
206 sub bestlink ($$) { #{{{
207         # Given a page and the text of a link on the page, determine which
208         # existing page that link best points to. Prefers pages under a
209         # subdirectory with the same name as the source page, failing that
210         # goes down the directory tree to the base looking for matching
211         # pages.
212         my $page=shift;
213         my $link=lc(shift);
214         
215         my $cwd=$page;
216         do {
217                 my $l=$cwd;
218                 $l.="/" if length $l;
219                 $l.=$link;
220
221                 if (exists $links{$l}) {
222                         #debug("for $page, \"$link\", use $l");
223                         return $l;
224                 }
225         } while $cwd=~s!/?[^/]+$!!;
226
227         #print STDERR "warning: page $page, broken link: $link\n";
228         return "";
229 } #}}}
230
231 sub isinlinableimage ($) { #{{{
232         my $file=shift;
233         
234         $file=~/\.(png|gif|jpg|jpeg)$/i;
235 } #}}}
236
237 sub pagetitle ($) { #{{{
238         my $page=shift;
239         $page=~s/__(\d+)__/&#$1;/g;
240         $page=~y/_/ /;
241         return $page;
242 } #}}}
243
244 sub titlepage ($) { #{{{
245         my $title=shift;
246         $title=~y/ /_/;
247         $title=~s/([^-[:alnum:]_:+\/.])/"__".ord($1)."__"/eg;
248         return $title;
249 } #}}}
250
251 sub cgiurl (@) { #{{{
252         my %params=@_;
253
254         return $config{cgiurl}."?".join("&amp;", map "$_=$params{$_}", keys %params);
255 } #}}}
256
257 sub styleurl (;$) { #{{{
258         my $page=shift;
259
260         return "$config{url}/style.css" if ! defined $page;
261         
262         $page=~s/[^\/]+$//;
263         $page=~s/[^\/]+\//..\//g;
264         return $page."style.css";
265 } #}}}
266
267 sub abs2rel ($$) {
268         # Work around very innefficient behavior in File::Spec if abs2rel
269         # is passed two relative paths. It's much faster if paths are
270         # absolute!
271         my $path="/".shift;
272         my $base="/".shift;
273
274         require File::Spec;
275         my $ret=File::Spec->abs2rel($path, $base);
276         $ret=~s/^// if defined $ret;
277         return $ret;
278 }
279
280 sub htmllink ($$$;$$$) { #{{{
281         my $lpage=shift; # the page doing the linking
282         my $page=shift; # the page that will contain the link (different for inline)
283         my $link=shift;
284         my $noimageinline=shift; # don't turn links into inline html images
285         my $forcesubpage=shift; # force a link to a subpage
286         my $linktext=shift; # set to force the link text to something
287
288         my $bestlink;
289         if (! $forcesubpage) {
290                 $bestlink=bestlink($lpage, $link);
291         }
292         else {
293                 $bestlink="$lpage/".lc($link);
294         }
295
296         $linktext=pagetitle(basename($link)) unless defined $linktext;
297         
298         return $linktext if length $bestlink && $page eq $bestlink;
299         
300         # TODO BUG: %renderedfiles may not have it, if the linked to page
301         # was also added and isn't yet rendered! Note that this bug is
302         # masked by the bug that makes all new files be rendered twice.
303         if (! grep { $_ eq $bestlink } values %renderedfiles) {
304                 $bestlink=htmlpage($bestlink);
305         }
306         if (! grep { $_ eq $bestlink } values %renderedfiles) {
307                 return "<span><a href=\"".
308                         cgiurl(do => "create", page => $link, from => $page).
309                         "\">?</a>$linktext</span>"
310         }
311         
312         $bestlink=abs2rel($bestlink, dirname($page));
313         
314         if (! $noimageinline && isinlinableimage($bestlink)) {
315                 return "<img src=\"$bestlink\" alt=\"$linktext\" />";
316         }
317         return "<a href=\"$bestlink\">$linktext</a>";
318 } #}}}
319
320 sub indexlink () { #{{{
321         return "<a href=\"$config{url}\">$config{wikiname}</a>";
322 } #}}}
323
324 sub lockwiki () { #{{{
325         # Take an exclusive lock on the wiki to prevent multiple concurrent
326         # run issues. The lock will be dropped on program exit.
327         if (! -d $config{wikistatedir}) {
328                 mkdir($config{wikistatedir});
329         }
330         open(WIKILOCK, ">$config{wikistatedir}/lockfile") ||
331                 error ("cannot write to $config{wikistatedir}/lockfile: $!");
332         if (! flock(WIKILOCK, 2 | 4)) {
333                 debug("wiki seems to be locked, waiting for lock");
334                 my $wait=600; # arbitrary, but don't hang forever to 
335                               # prevent process pileup
336                 for (1..600) {
337                         return if flock(WIKILOCK, 2 | 4);
338                         sleep 1;
339                 }
340                 error("wiki is locked; waited $wait seconds without lock being freed (possible stuck process or stale lock?)");
341         }
342 } #}}}
343
344 sub unlockwiki () { #{{{
345         close WIKILOCK;
346 } #}}}
347
348 sub loadindex () { #{{{
349         open (IN, "$config{wikistatedir}/index") || return;
350         while (<IN>) {
351                 $_=possibly_foolish_untaint($_);
352                 chomp;
353                 my %items;
354                 $items{link}=[];
355                 foreach my $i (split(/ /, $_)) {
356                         my ($item, $val)=split(/=/, $i, 2);
357                         push @{$items{$item}}, $val;
358                 }
359
360                 next unless exists $items{src}; # skip bad lines for now
361
362                 my $page=pagename($items{src}[0]);
363                 if (! $config{rebuild}) {
364                         $pagesources{$page}=$items{src}[0];
365                         $oldpagemtime{$page}=$items{mtime}[0];
366                         $oldlinks{$page}=[@{$items{link}}];
367                         $links{$page}=[@{$items{link}}];
368                         $depends{$page}=join(" ", @{$items{depends}})
369                                 if exists $items{depends};
370                         $renderedfiles{$page}=$items{dest}[0];
371                 }
372                 $pagectime{$page}=$items{ctime}[0];
373         }
374         close IN;
375 } #}}}
376
377 sub saveindex () { #{{{
378         if (! -d $config{wikistatedir}) {
379                 mkdir($config{wikistatedir});
380         }
381         open (OUT, ">$config{wikistatedir}/index") || 
382                 error("cannot write to $config{wikistatedir}/index: $!");
383         foreach my $page (keys %oldpagemtime) {
384                 next unless $oldpagemtime{$page};
385                 my $line="mtime=$oldpagemtime{$page} ".
386                         "ctime=$pagectime{$page} ".
387                         "src=$pagesources{$page} ".
388                         "dest=$renderedfiles{$page}";
389                 $line.=" link=$_" foreach @{$links{$page}};
390                 if (exists $depends{$page}) {
391                         $line.=" depends=$_" foreach split " ", $depends{$page};
392                 }
393                 print OUT $line."\n";
394         }
395         close OUT;
396 } #}}}
397
398 sub template_params (@) { #{{{
399         my $filename=shift;
400         
401         require HTML::Template;
402         return filter => sub {
403                         my $text_ref = shift;
404                         $$text_ref=&Encode::decode_utf8($$text_ref);
405                 },
406                 filename => "$config{templatedir}/$filename", @_;
407 } #}}}
408
409 sub template ($;@) { #{{{
410         HTML::Template->new(template_params(@_));
411 } #}}}
412
413 sub misctemplate ($$) { #{{{
414         my $title=shift;
415         my $pagebody=shift;
416         
417         my $template=template("misc.tmpl");
418         $template->param(
419                 title => $title,
420                 indexlink => indexlink(),
421                 wikiname => $config{wikiname},
422                 pagebody => $pagebody,
423                 styleurl => styleurl(),
424                 baseurl => "$config{url}/",
425         );
426         return $template->output;
427 }#}}}
428
429 sub glob_match ($$) { #{{{
430         my $page=shift;
431         my $glob=shift;
432
433         if ($glob =~ /^link\((.+)\)$/) {
434                 my $rev = $links{$page} or return undef;
435                 foreach my $p (@$rev) {
436                         return 1 if lc $p eq $1;
437                 }
438                 return 0;
439         } elsif ($glob =~ /^backlink\((.+)\)$/) {
440                 my $rev = $links{$1} or return undef;
441                 foreach my $p (@$rev) {
442                         return 1 if lc $p eq $page;
443                 }
444                 return 0;
445         } else {
446                 # turn glob into safe regexp
447                 $glob=quotemeta($glob);
448                 $glob=~s/\\\*/.*/g;
449                 $glob=~s/\\\?/./g;
450                 $glob=~s!\\/!/!g;
451                 
452                 return $page=~/^$glob$/i;
453         }
454 } #}}}
455
456 sub globlist_match ($$) { #{{{
457         my $page=shift;
458         my @globlist=split(" ", shift);
459
460         # check any negated globs first
461         foreach my $glob (@globlist) {
462                 return 0 if $glob=~/^!(.*)/ && glob_match($page, $1);
463         }
464
465         foreach my $glob (@globlist) {
466                 return 1 if glob_match($page, $glob);
467         }
468         
469         return 0;
470 } #}}}
471
472 sub hook (@) { # {{{
473         my %param=@_;
474         
475         if (! exists $param{type} || ! ref $param{call} || ! exists $param{id}) {
476                 error "hook requires type, call, and id parameters";
477         }
478         
479         $hooks{$param{type}}{$param{id}}=\%param;
480 } # }}}
481
482 1