git.oblomov.eu Git - ikiwiki/blob - ikiwiki

   1 #!/usr/bin/perl -T
   2
   3 use warnings;
   4 use strict;
   5 use File::Find;
   6 use Memoize;
   7 use File::Spec;
   8
   9 BEGIN {
  10         $blosxom::version="is a proper perl module too much to ask?";
  11         do "/usr/bin/markdown";
  12 }
  13
  14 memoize('pagename');
  15 memoize('bestlink');
  16
  17 sub usage {
  18         die "usage: ikiwiki [options] source dest\n";
  19 }
  20
  21 my $link=qr/\[\[([^\s]+)\]\]/;
  22 my $verbose=0;
  23 my $rebuild=0;
  24 my $wikiname="wiki";
  25 if (grep /^-/, @ARGV) {
  26         eval {use Getopt::Long};
  27         GetOptions(
  28                 "wikiname=s" => \$wikiname,
  29                 "verbose|v" => \$verbose,
  30                 "rebuild" => \$rebuild,
  31         ) || usage();
  32 }
  33 usage() unless @ARGV == 2;
  34 my ($srcdir) = shift =~ /(.*)/; # untaint
  35 my ($destdir) = shift =~ /(.*)/; # untaint
  36
  37 my %links;
  38 my %oldpagemtime;
  39 my %renderedfiles;
  40
  41 sub error ($) {
  42         die @_;
  43 }
  44
  45 sub debug ($) {
  46         print "@_\n" if $verbose;
  47 }
  48
  49 sub mtime ($) {
  50         my $page=shift;
  51
  52         return (stat($page))[9];
  53 }
  54
  55 sub basename {
  56         my $file=shift;
  57
  58         $file=~s!.*/!!;
  59         return $file;
  60 }
  61
  62 sub dirname {
  63         my $file=shift;
  64
  65         $file=~s!/?[^/]+$!!;
  66         return $file;
  67 }
  68
  69 sub pagetype ($) {
  70         my $page=shift;
  71
  72         if ($page =~ /\.mdwn$/) {
  73                 return ".mdwn";
  74         }
  75         else {
  76                 return "unknown";
  77         }
  78 }
  79
  80 sub pagename ($) {
  81         my $file=shift;
  82
  83         my $type=pagetype($file);
  84         my $page=$file;
  85         $page=~s/\Q$type\E*$// unless $type eq 'unknown';
  86         return $page;
  87 }
  88
  89 sub htmlpage ($) {
  90         my $page=shift;
  91
  92         return $page.".html";
  93 }
  94
  95 sub readpage ($) {
  96         my $page=shift;
  97
  98         local $/=undef;
  99         open (PAGE, "$srcdir/$page") || error("failed to read $page: $!");
 100         my $ret=<PAGE>;
 101         close PAGE;
 102         return $ret;
 103 }
 104
 105 sub writepage ($$) {
 106         my $page=shift;
 107         my $content=shift;
 108
 109         my $dir=dirname("$destdir/$page");
 110         if (! -d $dir) {
 111                 my $d="";
 112                 foreach my $s (split(m!/+!, $dir)) {
 113                         $d.="$s/";
 114                         if (! -d $d) {
 115                                 mkdir($d) || error("failed to create directory $d: $!");
 116                         }
 117                 }
 118         }
 119
 120         open (PAGE, ">$destdir/$page") || error("failed to write $page: $!");
 121         print PAGE $content;
 122         close PAGE;
 123 }
 124
 125 sub findlinks {
 126         my $content=shift;
 127
 128         my @links;
 129         while ($content =~ /$link/g) {
 130                 push @links, lc($1);
 131         }
 132         return @links;
 133 }
 134
 135 # Given a page and the text of a link on the page, determine which existing
 136 # page that link best points to. Prefers pages under a subdirectory with
 137 # the same name as the source page, failing that goes down the directory tree
 138 # to the base looking for matching pages.
 139 sub bestlink ($$) {
 140         my $page=shift;
 141         my $link=lc(shift);
 142
 143         my $cwd=$page;
 144         do {
 145                 my $l=$cwd;
 146                 $l.="/" if length $l;
 147                 $l.=$link;
 148
 149                 if (exists $links{$l}) {
 150                         #debug("for $page, \"$link\", use $l");
 151                         return $l;
 152                 }
 153         } while $cwd=~s!/?[^/]+$!!;
 154
 155         print STDERR "warning: page $page, broken link: $link\n";
 156         return "";
 157 }
 158
 159 sub isinlinableimage ($) {
 160         my $file=shift;
 161
 162         $file=~/\.(png|gif|jpg|jpeg)$/;
 163 }
 164
 165 sub htmllink ($$) {
 166         my $page=shift;
 167         my $link=shift;
 168
 169         my $bestlink=bestlink($page, $link);
 170
 171         return $link if $page eq $bestlink;
 172
 173         if (! grep { $_ eq $bestlink } values %renderedfiles) {
 174                 $bestlink=htmlpage($bestlink);
 175         }
 176         if (! grep { $_ eq $bestlink } values %renderedfiles) {
 177                 return "<a href=\"?\">?</a>$link"
 178         }
 179
 180         $bestlink=File::Spec->abs2rel($bestlink, dirname($page));
 181
 182         if (isinlinableimage($bestlink)) {
 183                 return "<img src=\"$bestlink\">";
 184         }
 185         return "<a href=\"$bestlink\">$link</a>";
 186 }
 187
 188 sub linkify ($$) {
 189         my $content=shift;
 190         my $file=shift;
 191
 192         $content =~ s/$link/htmllink(pagename($file), $1)/eg;
 193
 194         return $content;
 195 }
 196
 197 sub htmlize ($$) {
 198         my $type=shift;
 199         my $content=shift;
 200
 201         if ($type eq '.mdwn') {
 202                 return Markdown::Markdown($content);
 203         }
 204         else {
 205                 error("htmlization of $type not supported");
 206         }
 207 }
 208
 209 sub finalize ($$) {
 210         my $content=shift;
 211         my $page=shift;
 212
 213         my $title=basename($page);
 214         $title=~s/_/ /g;
 215
 216         my $pagelink="";
 217         my $path="";
 218         foreach my $dir (reverse split("/", $page)) {
 219                 if (length($pagelink)) {
 220                         $pagelink="<a href=\"$path$dir.html\">$dir/</a> $pagelink";
 221                 }
 222                 else {
 223                         $pagelink=$dir;
 224                 }
 225                 $path.="../";
 226         }
 227         $path=~s/\.\.\/$/index.html/;
 228         $pagelink="<a href=\"$path\">$wikiname/</a> $pagelink";
 229
 230         $content="<html>\n<head><title>$title</title></head>\n<body>\n".
 231                   "<h1>$pagelink</h1>\n".
 232                   $content.
 233                   "</body>\n</html>\n";
 234
 235         return $content;
 236 }
 237
 238 sub render ($) {
 239         my $file=shift;
 240
 241         my $type=pagetype($file);
 242         my $content=readpage($file);
 243         if ($type ne 'unknown') {
 244                 my $page=pagename($file);
 245                 $links{$page}=[findlinks($content)];
 246
 247                 $content=linkify($content, $file);
 248                 $content=htmlize($type, $content);
 249                 $content=finalize($content, $page);
 250
 251                 writepage(htmlpage($page), $content);
 252                 $oldpagemtime{$page}=time;
 253                 $renderedfiles{$page}=htmlpage($page);
 254         }
 255         else {
 256                 $links{$file}=[];
 257                 writepage($file, $content);
 258                 $oldpagemtime{$file}=time;
 259                 $renderedfiles{$file}=$file;
 260         }
 261 }
 262
 263 sub loadindex () {
 264         open (IN, "$srcdir/.index") || return;
 265         while (<IN>) {
 266                 chomp;
 267                 my ($mtime, $page, $rendered, @links)=split(' ', $_);
 268                 $oldpagemtime{$page}=$mtime;
 269                 $links{$page}=\@links;
 270                 ($renderedfiles{$page})=$rendered=~m/(.*)/; # untaint
 271         }
 272         close IN;
 273 }
 274
 275 sub saveindex () {
 276         open (OUT, ">$srcdir/.index") || error("cannot write to .index: $!");
 277         foreach my $page (keys %oldpagemtime) {
 278         print OUT "$oldpagemtime{$page} $page $renderedfiles{$page} ".
 279                   join(" ", @{$links{$page}})."\n"
 280                         if $oldpagemtime{$page};
 281         }
 282         close OUT;
 283 }
 284
 285 sub prune ($) {
 286         my $file=shift;
 287
 288         unlink($file);
 289         my $dir=dirname($file);
 290         while (rmdir($dir)) {
 291                 $dir=dirname($dir);
 292         }
 293 }
 294
 295 sub refresh () {
 296         # Find existing pages.
 297         my %exists;
 298         my @files;
 299         find({
 300                 no_chdir => 1,
 301                 wanted => sub {
 302                         if (/\/\.svn\//) {
 303                                 $File::Find::prune=1;
 304                         }
 305                         elsif (! -d $_ && ! /\.html$/ && ! /\/\./) {
 306                                 my ($f)=/(^[-A-Za-z0-9_.:\/+]+$)/; # untaint
 307                                 if (! defined $f) {
 308                                         warn("skipping bad filename $_\n");
 309                                 }
 310                                 else {
 311                                         $f=~s/^\Q$srcdir\E\/?//;
 312                                         push @files, $f;
 313                                         $exists{pagename($f)}=1;
 314                                 }
 315                         }
 316                 },
 317         }, $srcdir);
 318
 319         # check for added or removed pages
 320         my @adddel;
 321         foreach my $file (@files) {
 322                 my $page=pagename($file);
 323                 if (! $oldpagemtime{$page}) {
 324                         debug("new page $page");
 325                         push @adddel, $page;
 326                         $links{$page}=[];
 327                 }
 328         }
 329         foreach my $page (keys %oldpagemtime) {
 330                 if (! $exists{$page}) {
 331                         debug("removing old page $page");
 332                         prune($destdir."/".$renderedfiles{$page});
 333                         delete $renderedfiles{$page};
 334                         $oldpagemtime{$page}=0;
 335                         push @adddel, $page;
 336                 }
 337         }
 338
 339         # render any updated files
 340         foreach my $file (@files) {
 341                 my $page=pagename($file);
 342
 343                 if (! exists $oldpagemtime{$page} ||
 344                     mtime("$srcdir/$file") > $oldpagemtime{$page}) {
 345                         debug("rendering changed file $file");
 346                         render($file);
 347                 }
 348                 elsif ($rebuild) {
 349                         debug("rebuilding unchanged file $file");
 350                         render($file);
 351                 }
 352         }
 353
 354         # if any files were added or removed, check to see if each page
 355         # needs an update due to linking to them
 356         if (@adddel) {
 357 FILE:           foreach my $file (@files) {
 358                         my $page=pagename($file);
 359                         foreach my $p (@adddel) {
 360                                 foreach my $link (@{$links{$page}}) {
 361                                         if (bestlink($page, $link) eq $p) {
 362                                                 debug("rendering $file, which links to $p");
 363                                                 render($file);
 364                                                 next FILE;
 365                                         }
 366                                 }
 367                         }
 368                 }
 369         }
 370 }
 371
 372 loadindex();
 373 refresh();
 374 saveindex();