IkiWiki.pm

   1 #!/usr/bin/perl
   2
   3 package IkiWiki;
   4
   5 use warnings;
   6 use strict;
   7 use Encode;
   8 use HTML::Entities;
   9 use URI::Escape q{uri_escape_utf8};
  10 use POSIX;
  11 use Storable;
  12 use open qw{:utf8 :std};
  13
  14 use vars qw{%config %links %oldlinks %pagemtime %pagectime %pagecase
  15             %pagestate %renderedfiles %oldrenderedfiles %pagesources
  16             %destsources %depends %hooks %forcerebuild $gettext_obj};
  17
  18 use Exporter q{import};
  19 our @EXPORT = qw(hook debug error template htmlpage add_depends pagespec_match
  20                  bestlink htmllink readfile writefile pagetype srcfile pagename
  21                  displaytime will_render gettext urlto targetpage
  22                  add_underlay
  23                  %config %links %pagestate %renderedfiles
  24                  %pagesources %destsources);
  25 our $VERSION = 2.00; # plugin interface version, next is ikiwiki version
  26 our $version='unknown'; # VERSION_AUTOREPLACE done by Makefile, DNE
  27 my $installdir=''; # INSTALLDIR_AUTOREPLACE done by Makefile, DNE
  28
  29 # Optimisation.
  30 use Memoize;
  31 memoize("abs2rel");
  32 memoize("pagespec_translate");
  33 memoize("file_pruned");
  34
  35 sub getsetup () { #{{{
  36         wikiname => {
  37                 type => "string",
  38                 default => "wiki",
  39                 description => "name of the wiki",
  40                 safe => 1,
  41                 rebuild => 1,
  42         },
  43         srcdir => {
  44                 type => "string",
  45                 default => undef,
  46                 example => "$ENV{HOME}/wiki",
  47                 description => "where the source of the wiki is located",
  48                 safe => 0, # path
  49                 rebuild => 1,
  50         },
  51         destdir => {
  52                 type => "string",
  53                 default => undef,
  54                 example => "/var/www/wiki",
  55                 description => "where to build the wiki",
  56                 safe => 0, # path
  57                 rebuild => 1,
  58         },
  59         adminuser => {
  60                 type => "string",
  61                 default => [],
  62                 description => "user names of wiki admins",
  63                 safe => 1,
  64                 rebuild => 0,
  65         },
  66         adminemail => {
  67                 type => "string",
  68                 default => undef,
  69                 example => 'me@example.com',
  70                 description => "contact email for wiki",
  71                 safe => 1,
  72                 rebuild => 0,
  73         },
  74         url => {
  75                 type => "string",
  76                 default => '',
  77                 example => "http://example.com/wiki",
  78                 description => "base url to the wiki",
  79                 safe => 1,
  80                 rebuild => 1,
  81         },
  82         cgiurl => {
  83                 type => "string",
  84                 default => '',
  85                 examples => "http://example.com/wiki/ikiwiki.cgi",
  86                 description => "url to the ikiwiki.cgi",
  87                 safe => 1,
  88                 rebuild => 1,
  89         },
  90         rcs => {
  91                 type => "string",
  92                 default => '',
  93                 description => "rcs backend to use",
  94                 safe => 0, # don't allow overriding
  95                 rebuild => 0,
  96         },
  97         default_plugins => {
  98                 type => "internal",
  99                 default => [qw{mdwn link inline htmlscrubber passwordauth
 100                                 openid signinedit lockedit conditional
 101                                 recentchanges parentlinks}],
 102                 description => "plugins to enable by default",
 103                 safe => 1,
 104                 rebuild => 1,
 105         },
 106         add_plugins => {
 107                 type => "string",
 108                 default => [],
 109                 description => "plugins to add to the default configuration",
 110                 safe => 1,
 111                 rebuild => 1,
 112         },
 113         disable_plugins => {
 114                 type => "string",
 115                 default => [],
 116                 description => "plugins to disable",
 117                 safe => 1,
 118                 rebuild => 1,
 119         },
 120         wrappers => {
 121                 type => "string",
 122                 default => undef,
 123                 description => "definitions of wrappers to generate",
 124                 safe => 0,
 125                 rebuild => 0,
 126         },
 127         wrapper => {
 128                 type => "internal",
 129                 default => undef,
 130                 description => "wrapper filename",
 131                 safe => 0,
 132                 rebuild => 0,
 133         },
 134         wrappermode => {
 135                 type => "internal",
 136                 default => undef,
 137                 description => "mode of wrapper file",
 138                 safe => 0,
 139                 rebuild => 0,
 140         },
 141         templatedir => {
 142                 type => "string",
 143                 default => "$installdir/share/ikiwiki/templates",
 144                 description => "location of template files",
 145                 safe => 0, # path
 146                 rebuild => 1,
 147         },
 148         underlaydir => {
 149                 type => "string",
 150                 default => "$installdir/share/ikiwiki/basewiki",
 151                 description => "base wiki source location",
 152                 safe => 0, # path
 153                 rebuild => 0,
 154         },
 155         underlaydirs => {
 156                 type => "internal",
 157                 default => [],
 158                 description => "additional underlays to use",
 159                 safe => 0,
 160                 rebuild => 0,
 161         },
 162         verbose => {
 163                 type => "boolean",
 164                 default => 0,
 165                 description => "display verbose messages when building?",
 166                 safe => 1,
 167                 rebuild => 0,
 168         },
 169         syslog => {
 170                 type => "boolean",
 171                 default => 0,
 172                 description => "log to syslog?",
 173                 safe => 1,
 174                 rebuild => 0,
 175         },
 176         usedirs => {
 177                 type => "boolean",
 178                 default => 1,
 179                 description => "create output files named page/index.html?",
 180                 safe => 0, # changing requires manual transition
 181                 rebuild => 1,
 182         },
 183         prefix_directives => {
 184                 type => "boolean",
 185                 default => 0,
 186                 description => "use '!'-prefixed preprocessor directives?",
 187                 safe => 0, # changing requires manual transition
 188                 rebuild => 1,
 189         },
 190         discussion => {
 191                 type => "boolean",
 192                 default => 1,
 193                 description => "enable Discussion pages?",
 194                 safe => 1,
 195                 rebuild => 1,
 196         },
 197         default_pageext => {
 198                 type => "string",
 199                 default => "mdwn",
 200                 description => "extension to use for new pages",
 201                 safe => 0, # not sanitized
 202                 rebuild => 0,
 203         },
 204         htmlext => {
 205                 type => "string",
 206                 default => "html",
 207                 description => "extension to use for html files",
 208                 safe => 0, # not sanitized
 209                 rebuild => 1,
 210         },
 211         timeformat => {
 212                 type => "string",
 213                 default => '%c',
 214                 description => "strftime format string to display date",
 215                 safe => 1,
 216                 rebuild => 1,
 217         },
 218         locale => {
 219                 type => "string",
 220                 default => undef,
 221                 example => "en_US.UTF-8",
 222                 description => "UTF-8 locale to use",
 223                 safe => 0,
 224                 rebuild => 1,
 225         },
 226         sslcookie => {
 227                 type => "boolean",
 228                 default => 0,
 229                 description => "only send cookies over SSL connections?",
 230                 safe => 1,
 231                 rebuild => 0,
 232         },
 233         userdir => {
 234                 type => "string",
 235                 default => "",
 236                 example => "users",
 237                 description => "put user pages below specified page",
 238                 safe => 1,
 239                 rebuild => 1,
 240         },
 241         numbacklinks => {
 242                 type => "integer",
 243                 default => 10,
 244                 description => "how many backlinks to show before hiding excess (0 to show all)",
 245                 safe => 1,
 246                 rebuild => 1,
 247         },
 248         hardlink => {
 249                 type => "boolean",
 250                 default => 0,
 251                 description => "attempt to hardlink source files? (optimisation for large files)",
 252                 safe => 0, # paranoia
 253                 rebuild => 0,
 254         },
 255
 256         exclude => {
 257                 type => "string",
 258                 default => undef,
 259                 example => '\.wav$',
 260                 description => "regexp of source files to ignore",
 261                 safe => 0, # regexp
 262                 rebuild => 1,
 263         },
 264         wiki_file_prune_regexps => {
 265                 type => "internal",
 266                 default => [qr/(^|\/)\.\.(\/|$)/, qr/^\./, qr/\/\./,
 267                         qr/\.x?html?$/, qr/\.ikiwiki-new$/,
 268                         qr/(^|\/).svn\//, qr/.arch-ids\//, qr/{arch}\//,
 269                         qr/(^|\/)_MTN\//,
 270                         qr/\.dpkg-tmp$/],
 271                 description => "regexps of source files to ignore",
 272                 safe => 0,
 273                 rebuild => 1,
 274         },
 275         wiki_file_regexp => {
 276                 type => "internal",
 277                 default => qr/(^[-[:alnum:]_.:\/+]+$)/,
 278                 description => "regexp of legal source files",
 279                 safe => 0,
 280                 rebuild => 1,
 281         },
 282         web_commit_regexp => {
 283                 type => "internal",
 284                 default => qr/^web commit (by (.*?(?=: |$))|from (\d+\.\d+\.\d+\.\d+)):?(.*)/,
 285                 description => "regexp to parse web commits from logs",
 286                 safe => 0,
 287                 rebuild => 0,
 288         },
 289         cgi => {
 290                 type => "internal",
 291                 default => 0,
 292                 description => "run as a cgi",
 293                 safe => 0,
 294                 rebuild => 0,
 295         },
 296         cgi_disable_uploads => {
 297                 type => "internal",
 298                 default => 1,
 299                 description => "whether CGI should accept file uploads",
 300                 safe => 0,
 301                 rebuild => 0,
 302         },
 303         post_commit => {
 304                 type => "internal",
 305                 default => 0,
 306                 description => "run as a post-commit hook",
 307                 safe => 0,
 308                 rebuild => 0,
 309         },
 310         rebuild => {
 311                 type => "internal",
 312                 default => 0,
 313                 description => "running in rebuild mode",
 314                 safe => 0,
 315                 rebuild => 0,
 316         },
 317         refresh => {
 318                 type => "internal",
 319                 default => 0,
 320                 description => "running in refresh mode",
 321                 safe => 0,
 322                 rebuild => 0,
 323         },
 324         getctime => {
 325                 type => "internal",
 326                 default => 0,
 327                 description => "running in getctime mode",
 328                 safe => 0,
 329                 rebuild => 0,
 330         },
 331         w3mmode => {
 332                 type => "internal",
 333                 default => 0,
 334                 description => "running in w3mmode",
 335                 safe => 0,
 336                 rebuild => 0,
 337         },
 338         setup => {
 339                 type => "internal",
 340                 default => undef,
 341                 description => "setup file to read",
 342                 safe => 0,
 343                 rebuild => 0,
 344         },
 345         libdir => {
 346                 type => "internal",
 347                 default => undef,
 348                 example => "$ENV{HOME}/.ikiwiki/",
 349                 description => "extra library and plugin directory",
 350                 safe => 0,
 351                 rebuild => 0,
 352         },
 353 } #}}}
 354
 355 sub defaultconfig () { #{{{
 356         my %s=getsetup();
 357         my @ret;
 358         foreach my $key (keys %s) {
 359                 push @ret, $key, $s{$key}->{default};
 360         }
 361         use Data::Dumper;
 362         return @ret;
 363 } #}}}
 364
 365 sub checkconfig () { #{{{
 366         # locale stuff; avoid LC_ALL since it overrides everything
 367         if (defined $ENV{LC_ALL}) {
 368                 $ENV{LANG} = $ENV{LC_ALL};
 369                 delete $ENV{LC_ALL};
 370         }
 371         if (defined $config{locale}) {
 372                 if (POSIX::setlocale(&POSIX::LC_ALL, $config{locale})) {
 373                         $ENV{LANG}=$config{locale};
 374                         $gettext_obj=undef;
 375                 }
 376         }
 377
 378         if (ref $config{ENV} eq 'HASH') {
 379                 foreach my $val (keys %{$config{ENV}}) {
 380                         $ENV{$val}=$config{ENV}{$val};
 381                 }
 382         }
 383
 384         if ($config{w3mmode}) {
 385                 eval q{use Cwd q{abs_path}};
 386                 error($@) if $@;
 387                 $config{srcdir}=possibly_foolish_untaint(abs_path($config{srcdir}));
 388                 $config{destdir}=possibly_foolish_untaint(abs_path($config{destdir}));
 389                 $config{cgiurl}="file:///\$LIB/ikiwiki-w3m.cgi/".$config{cgiurl}
 390                         unless $config{cgiurl} =~ m!file:///!;
 391                 $config{url}="file://".$config{destdir};
 392         }
 393
 394         if ($config{cgi} && ! length $config{url}) {
 395                 error(gettext("Must specify url to wiki with --url when using --cgi"));
 396         }
 397
 398         $config{wikistatedir}="$config{srcdir}/.ikiwiki"
 399                 unless exists $config{wikistatedir};
 400
 401         if ($config{rcs}) {
 402                 eval qq{use IkiWiki::Rcs::$config{rcs}};
 403                 if ($@) {
 404                         error("Failed to load RCS module IkiWiki::Rcs::$config{rcs}: $@");
 405                 }
 406         }
 407         else {
 408                 require IkiWiki::Rcs::Stub;
 409         }
 410
 411         if (exists $config{umask}) {
 412                 umask(possibly_foolish_untaint($config{umask}));
 413         }
 414
 415         run_hooks(checkconfig => sub { shift->() });
 416
 417         return 1;
 418 } #}}}
 419
 420 sub loadplugins () { #{{{
 421         if (defined $config{libdir}) {
 422                 unshift @INC, possibly_foolish_untaint($config{libdir});
 423         }
 424
 425         loadplugin($_) foreach @{$config{default_plugins}}, @{$config{add_plugins}};
 426
 427         run_hooks(getopt => sub { shift->() });
 428         if (grep /^-/, @ARGV) {
 429                 print STDERR "Unknown option: $_\n"
 430                         foreach grep /^-/, @ARGV;
 431                 usage();
 432         }
 433
 434         return 1;
 435 } #}}}
 436
 437 sub loadplugin ($) { #{{{
 438         my $plugin=shift;
 439
 440         return if grep { $_ eq $plugin} @{$config{disable_plugins}};
 441
 442         foreach my $dir (defined $config{libdir} ? possibly_foolish_untaint($config{libdir}) : undef,
 443                          "$installdir/lib/ikiwiki") {
 444                 if (defined $dir && -x "$dir/plugins/$plugin") {
 445                         require IkiWiki::Plugin::external;
 446                         import IkiWiki::Plugin::external "$dir/plugins/$plugin";
 447                         return 1;
 448                 }
 449         }
 450
 451         my $mod="IkiWiki::Plugin::".possibly_foolish_untaint($plugin);
 452         eval qq{use $mod};
 453         if ($@) {
 454                 error("Failed to load plugin $mod: $@");
 455         }
 456         return 1;
 457 } #}}}
 458
 459 sub error ($;$) { #{{{
 460         my $message=shift;
 461         my $cleaner=shift;
 462         log_message('err' => $message) if $config{syslog};
 463         if (defined $cleaner) {
 464                 $cleaner->();
 465         }
 466         die $message."\n";
 467 } #}}}
 468
 469 sub debug ($) { #{{{
 470         return unless $config{verbose};
 471         return log_message(debug => @_);
 472 } #}}}
 473
 474 my $log_open=0;
 475 sub log_message ($$) { #{{{
 476         my $type=shift;
 477
 478         if ($config{syslog}) {
 479                 require Sys::Syslog;
 480                 if (! $log_open) {
 481                         Sys::Syslog::setlogsock('unix');
 482                         Sys::Syslog::openlog('ikiwiki', '', 'user');
 483                         $log_open=1;
 484                 }
 485                 return eval {
 486                         Sys::Syslog::syslog($type, "[$config{wikiname}] %s", join(" ", @_));
 487                 };
 488         }
 489         elsif (! $config{cgi}) {
 490                 return print "@_\n";
 491         }
 492         else {
 493                 return print STDERR "@_\n";
 494         }
 495 } #}}}
 496
 497 sub possibly_foolish_untaint ($) { #{{{
 498         my $tainted=shift;
 499         my ($untainted)=$tainted=~/(.*)/s;
 500         return $untainted;
 501 } #}}}
 502
 503 sub basename ($) { #{{{
 504         my $file=shift;
 505
 506         $file=~s!.*/+!!;
 507         return $file;
 508 } #}}}
 509
 510 sub dirname ($) { #{{{
 511         my $file=shift;
 512
 513         $file=~s!/*[^/]+$!!;
 514         return $file;
 515 } #}}}
 516
 517 sub pagetype ($) { #{{{
 518         my $page=shift;
 519
 520         if ($page =~ /\.([^.]+)$/) {
 521                 return $1 if exists $hooks{htmlize}{$1};
 522         }
 523         return;
 524 } #}}}
 525
 526 sub isinternal ($) { #{{{
 527         my $page=shift;
 528         return exists $pagesources{$page} &&
 529                 $pagesources{$page} =~ /\._([^.]+)$/;
 530 } #}}}
 531
 532 sub pagename ($) { #{{{
 533         my $file=shift;
 534
 535         my $type=pagetype($file);
 536         my $page=$file;
 537         $page=~s/\Q.$type\E*$// if defined $type;
 538         return $page;
 539 } #}}}
 540
 541 sub targetpage ($$) { #{{{
 542         my $page=shift;
 543         my $ext=shift;
 544
 545         if (! $config{usedirs} || $page =~ /^index$/ ) {
 546                 return $page.".".$ext;
 547         } else {
 548                 return $page."/index.".$ext;
 549         }
 550 } #}}}
 551
 552 sub htmlpage ($) { #{{{
 553         my $page=shift;
 554
 555         return targetpage($page, $config{htmlext});
 556 } #}}}
 557
 558 sub srcfile_stat { #{{{
 559         my $file=shift;
 560         my $nothrow=shift;
 561
 562         return "$config{srcdir}/$file", stat(_) if -e "$config{srcdir}/$file";
 563         foreach my $dir (@{$config{underlaydirs}}, $config{underlaydir}) {
 564                 return "$dir/$file", stat(_) if -e "$dir/$file";
 565         }
 566         error("internal error: $file cannot be found in $config{srcdir} or underlay") unless $nothrow;
 567         return;
 568 } #}}}
 569
 570 sub srcfile ($;$) { #{{{
 571         return (srcfile_stat(@_))[0];
 572 } #}}}
 573
 574 sub add_underlay ($) { #{{{
 575         my $dir=shift;
 576
 577         if ($dir=~/^\//) {
 578                 unshift @{$config{underlaydirs}}, $dir;
 579         }
 580         else {
 581                 unshift @{$config{underlaydirs}}, "$config{underlaydir}/../$dir";
 582         }
 583
 584         return 1;
 585 } #}}}
 586
 587 sub readfile ($;$$) { #{{{
 588         my $file=shift;
 589         my $binary=shift;
 590         my $wantfd=shift;
 591
 592         if (-l $file) {
 593                 error("cannot read a symlink ($file)");
 594         }
 595
 596         local $/=undef;
 597         open (my $in, "<", $file) || error("failed to read $file: $!");
 598         binmode($in) if ($binary);
 599         return \*$in if $wantfd;
 600         my $ret=<$in>;
 601         close $in || error("failed to read $file: $!");
 602         return $ret;
 603 } #}}}
 604
 605 sub prep_writefile ($$) { #{{{
 606         my $file=shift;
 607         my $destdir=shift;
 608
 609         my $test=$file;
 610         while (length $test) {
 611                 if (-l "$destdir/$test") {
 612                         error("cannot write to a symlink ($test)");
 613                 }
 614                 $test=dirname($test);
 615         }
 616
 617         my $dir=dirname("$destdir/$file");
 618         if (! -d $dir) {
 619                 my $d="";
 620                 foreach my $s (split(m!/+!, $dir)) {
 621                         $d.="$s/";
 622                         if (! -d $d) {
 623                                 mkdir($d) || error("failed to create directory $d: $!");
 624                         }
 625                 }
 626         }
 627
 628         return 1;
 629 } #}}}
 630
 631 sub writefile ($$$;$$) { #{{{
 632         my $file=shift; # can include subdirs
 633         my $destdir=shift; # directory to put file in
 634         my $content=shift;
 635         my $binary=shift;
 636         my $writer=shift;
 637
 638         prep_writefile($file, $destdir);
 639
 640         my $newfile="$destdir/$file.ikiwiki-new";
 641         if (-l $newfile) {
 642                 error("cannot write to a symlink ($newfile)");
 643         }
 644
 645         my $cleanup = sub { unlink($newfile) };
 646         open (my $out, '>', $newfile) || error("failed to write $newfile: $!", $cleanup);
 647         binmode($out) if ($binary);
 648         if ($writer) {
 649                 $writer->(\*$out, $cleanup);
 650         }
 651         else {
 652                 print $out $content or error("failed writing to $newfile: $!", $cleanup);
 653         }
 654         close $out || error("failed saving $newfile: $!", $cleanup);
 655         rename($newfile, "$destdir/$file") ||
 656                 error("failed renaming $newfile to $destdir/$file: $!", $cleanup);
 657
 658         return 1;
 659 } #}}}
 660
 661 my %cleared;
 662 sub will_render ($$;$) { #{{{
 663         my $page=shift;
 664         my $dest=shift;
 665         my $clear=shift;
 666
 667         # Important security check.
 668         if (-e "$config{destdir}/$dest" && ! $config{rebuild} &&
 669             ! grep { $_ eq $dest } (@{$renderedfiles{$page}}, @{$oldrenderedfiles{$page}})) {
 670                 error("$config{destdir}/$dest independently created, not overwriting with version from $page");
 671         }
 672
 673         if (! $clear || $cleared{$page}) {
 674                 $renderedfiles{$page}=[$dest, grep { $_ ne $dest } @{$renderedfiles{$page}}];
 675         }
 676         else {
 677                 foreach my $old (@{$renderedfiles{$page}}) {
 678                         delete $destsources{$old};
 679                 }
 680                 $renderedfiles{$page}=[$dest];
 681                 $cleared{$page}=1;
 682         }
 683         $destsources{$dest}=$page;
 684
 685         return 1;
 686 } #}}}
 687
 688 sub bestlink ($$) { #{{{
 689         my $page=shift;
 690         my $link=shift;
 691
 692         my $cwd=$page;
 693         if ($link=~s/^\/+//) {
 694                 # absolute links
 695                 $cwd="";
 696         }
 697         $link=~s/\/$//;
 698
 699         do {
 700                 my $l=$cwd;
 701                 $l.="/" if length $l;
 702                 $l.=$link;
 703
 704                 if (exists $links{$l}) {
 705                         return $l;
 706                 }
 707                 elsif (exists $pagecase{lc $l}) {
 708                         return $pagecase{lc $l};
 709                 }
 710         } while $cwd=~s!/?[^/]+$!!;
 711
 712         if (length $config{userdir}) {
 713                 my $l = "$config{userdir}/".lc($link);
 714                 if (exists $links{$l}) {
 715                         return $l;
 716                 }
 717                 elsif (exists $pagecase{lc $l}) {
 718                         return $pagecase{lc $l};
 719                 }
 720         }
 721
 722         #print STDERR "warning: page $page, broken link: $link\n";
 723         return "";
 724 } #}}}
 725
 726 sub isinlinableimage ($) { #{{{
 727         my $file=shift;
 728
 729         return $file =~ /\.(png|gif|jpg|jpeg)$/i;
 730 } #}}}
 731
 732 sub pagetitle ($;$) { #{{{
 733         my $page=shift;
 734         my $unescaped=shift;
 735
 736         if ($unescaped) {
 737                 $page=~s/(__(\d+)__|_)/$1 eq '_' ? ' ' : chr($2)/eg;
 738         }
 739         else {
 740                 $page=~s/(__(\d+)__|_)/$1 eq '_' ? ' ' : "&#$2;"/eg;
 741         }
 742
 743         return $page;
 744 } #}}}
 745
 746 sub titlepage ($) { #{{{
 747         my $title=shift;
 748         $title=~s/([^-[:alnum:]:+\/.])/$1 eq ' ' ? '_' : "__".ord($1)."__"/eg;
 749         return $title;
 750 } #}}}
 751
 752 sub linkpage ($) { #{{{
 753         my $link=shift;
 754         $link=~s/([^-[:alnum:]:+\/._])/$1 eq ' ' ? '_' : "__".ord($1)."__"/eg;
 755         return $link;
 756 } #}}}
 757
 758 sub cgiurl (@) { #{{{
 759         my %params=@_;
 760
 761         return $config{cgiurl}."?".
 762                 join("&amp;", map $_."=".uri_escape_utf8($params{$_}), keys %params);
 763 } #}}}
 764
 765 sub baseurl (;$) { #{{{
 766         my $page=shift;
 767
 768         return "$config{url}/" if ! defined $page;
 769
 770         $page=htmlpage($page);
 771         $page=~s/[^\/]+$//;
 772         $page=~s/[^\/]+\//..\//g;
 773         return $page;
 774 } #}}}
 775
 776 sub abs2rel ($$) { #{{{
 777         # Work around very innefficient behavior in File::Spec if abs2rel
 778         # is passed two relative paths. It's much faster if paths are
 779         # absolute! (Debian bug #376658; fixed in debian unstable now)
 780         my $path="/".shift;
 781         my $base="/".shift;
 782
 783         require File::Spec;
 784         my $ret=File::Spec->abs2rel($path, $base);
 785         $ret=~s/^// if defined $ret;
 786         return $ret;
 787 } #}}}
 788
 789 sub displaytime ($;$) { #{{{
 790         my $time=shift;
 791         my $format=shift;
 792         if (! defined $format) {
 793                 $format=$config{timeformat};
 794         }
 795
 796         # strftime doesn't know about encodings, so make sure
 797         # its output is properly treated as utf8
 798         return decode_utf8(POSIX::strftime($format, localtime($time)));
 799 } #}}}
 800
 801 sub beautify_urlpath ($) { #{{{
 802         my $url=shift;
 803
 804         if ($config{usedirs}) {
 805                 $url =~ s!/index.$config{htmlext}$!/!;
 806         }
 807
 808         # Ensure url is not an empty link, and
 809         # if it's relative, make that explicit to avoid colon confusion.
 810         if ($url !~ /^\//) {
 811                 $url="./$url";
 812         }
 813
 814         return $url;
 815 } #}}}
 816
 817 sub urlto ($$;$) { #{{{
 818         my $to=shift;
 819         my $from=shift;
 820         my $absolute=shift;
 821
 822         if (! length $to) {
 823                 return beautify_urlpath(baseurl($from)."index.$config{htmlext}");
 824         }
 825
 826         if (! $destsources{$to}) {
 827                 $to=htmlpage($to);
 828         }
 829
 830         if ($absolute) {
 831                 return $config{url}.beautify_urlpath("/".$to);
 832         }
 833
 834         my $link = abs2rel($to, dirname(htmlpage($from)));
 835
 836         return beautify_urlpath($link);
 837 } #}}}
 838
 839 sub htmllink ($$$;@) { #{{{
 840         my $lpage=shift; # the page doing the linking
 841         my $page=shift; # the page that will contain the link (different for inline)
 842         my $link=shift;
 843         my %opts=@_;
 844
 845         $link=~s/\/$//;
 846
 847         my $bestlink;
 848         if (! $opts{forcesubpage}) {
 849                 $bestlink=bestlink($lpage, $link);
 850         }
 851         else {
 852                 $bestlink="$lpage/".lc($link);
 853         }
 854
 855         my $linktext;
 856         if (defined $opts{linktext}) {
 857                 $linktext=$opts{linktext};
 858         }
 859         else {
 860                 $linktext=pagetitle(basename($link));
 861         }
 862
 863         return "<span class=\"selflink\">$linktext</span>"
 864                 if length $bestlink && $page eq $bestlink &&
 865                    ! defined $opts{anchor};
 866
 867         if (! $destsources{$bestlink}) {
 868                 $bestlink=htmlpage($bestlink);
 869
 870                 if (! $destsources{$bestlink}) {
 871                         return $linktext unless length $config{cgiurl};
 872                         return "<span class=\"createlink\"><a href=\"".
 873                                 cgiurl(
 874                                         do => "create",
 875                                         page => lc($link),
 876                                         from => $lpage
 877                                 ).
 878                                 "\" rel=\"nofollow\">?</a>$linktext</span>"
 879                 }
 880         }
 881
 882         $bestlink=abs2rel($bestlink, dirname(htmlpage($page)));
 883         $bestlink=beautify_urlpath($bestlink);
 884
 885         if (! $opts{noimageinline} && isinlinableimage($bestlink)) {
 886                 return "<img src=\"$bestlink\" alt=\"$linktext\" />";
 887         }
 888
 889         if (defined $opts{anchor}) {
 890                 $bestlink.="#".$opts{anchor};
 891         }
 892
 893         my @attrs;
 894         if (defined $opts{rel}) {
 895                 push @attrs, ' rel="'.$opts{rel}.'"';
 896         }
 897         if (defined $opts{class}) {
 898                 push @attrs, ' class="'.$opts{class}.'"';
 899         }
 900
 901         return "<a href=\"$bestlink\"@attrs>$linktext</a>";
 902 } #}}}
 903
 904 sub userlink ($) { #{{{
 905         my $user=shift;
 906
 907         my $oiduser=eval { openiduser($user) };
 908         if (defined $oiduser) {
 909                 return "<a href=\"$user\">$oiduser</a>";
 910         }
 911         else {
 912                 eval q{use CGI 'escapeHTML'};
 913                 error($@) if $@;
 914
 915                 return htmllink("", "", escapeHTML(
 916                         length $config{userdir} ? $config{userdir}."/".$user : $user
 917                 ), noimageinline => 1);
 918         }
 919 } #}}}
 920
 921 sub htmlize ($$$$) { #{{{
 922         my $page=shift;
 923         my $destpage=shift;
 924         my $type=shift;
 925         my $content=shift;
 926
 927         my $oneline = $content !~ /\n/;
 928
 929         if (exists $hooks{htmlize}{$type}) {
 930                 $content=$hooks{htmlize}{$type}{call}->(
 931                         page => $page,
 932                         content => $content,
 933                 );
 934         }
 935         else {
 936                 error("htmlization of $type not supported");
 937         }
 938
 939         run_hooks(sanitize => sub {
 940                 $content=shift->(
 941                         page => $page,
 942                         destpage => $destpage,
 943                         content => $content,
 944                 );
 945         });
 946
 947         if ($oneline) {
 948                 # hack to get rid of enclosing junk added by markdown
 949                 # and other htmlizers
 950                 $content=~s/^<p>//i;
 951                 $content=~s/<\/p>$//i;
 952                 chomp $content;
 953         }
 954
 955         return $content;
 956 } #}}}
 957
 958 sub linkify ($$$) { #{{{
 959         my $page=shift;
 960         my $destpage=shift;
 961         my $content=shift;
 962
 963         run_hooks(linkify => sub {
 964                 $content=shift->(
 965                         page => $page,
 966                         destpage => $destpage,
 967                         content => $content,
 968                 );
 969         });
 970
 971         return $content;
 972 } #}}}
 973
 974 our %preprocessing;
 975 our $preprocess_preview=0;
 976 sub preprocess ($$$;$$) { #{{{
 977         my $page=shift; # the page the data comes from
 978         my $destpage=shift; # the page the data will appear in (different for inline)
 979         my $content=shift;
 980         my $scan=shift;
 981         my $preview=shift;
 982
 983         # Using local because it needs to be set within any nested calls
 984         # of this function.
 985         local $preprocess_preview=$preview if defined $preview;
 986
 987         my $handle=sub {
 988                 my $escape=shift;
 989                 my $prefix=shift;
 990                 my $command=shift;
 991                 my $params=shift;
 992                 if (length $escape) {
 993                         return "[[$prefix$command $params]]";
 994                 }
 995                 elsif (exists $hooks{preprocess}{$command}) {
 996                         return "" if $scan && ! $hooks{preprocess}{$command}{scan};
 997                         # Note: preserve order of params, some plugins may
 998                         # consider it significant.
 999                         my @params;
1000                         while ($params =~ m{
1001                                 (?:([-\w]+)=)?          # 1: named parameter key?
1002                                 (?:
1003                                         """(.*?)"""     # 2: triple-quoted value
1004                                 |
1005                                         "([^"]+)"       # 3: single-quoted value
1006                                 |
1007                                         (\S+)           # 4: unquoted value
1008                                 )
1009                                 (?:\s+|$)               # delimiter to next param
1010                         }sgx) {
1011                                 my $key=$1;
1012                                 my $val;
1013                                 if (defined $2) {
1014                                         $val=$2;
1015                                         $val=~s/\r\n/\n/mg;
1016                                         $val=~s/^\n+//g;
1017                                         $val=~s/\n+$//g;
1018                                 }
1019                                 elsif (defined $3) {
1020                                         $val=$3;
1021                                 }
1022                                 elsif (defined $4) {
1023                                         $val=$4;
1024                                 }
1025
1026                                 if (defined $key) {
1027                                         push @params, $key, $val;
1028                                 }
1029                                 else {
1030                                         push @params, $val, '';
1031                                 }
1032                         }
1033                         if ($preprocessing{$page}++ > 3) {
1034                                 # Avoid loops of preprocessed pages preprocessing
1035                                 # other pages that preprocess them, etc.
1036                                 #translators: The first parameter is a
1037                                 #translators: preprocessor directive name,
1038                                 #translators: the second a page name, the
1039                                 #translators: third a number.
1040                                 return "[[".sprintf(gettext("%s preprocessing loop detected on %s at depth %i"),
1041                                         $command, $page, $preprocessing{$page}).
1042                                 "]]";
1043                         }
1044                         my $ret;
1045                         if (! $scan) {
1046                                 $ret=eval {
1047                                         $hooks{preprocess}{$command}{call}->(
1048                                                 @params,
1049                                                 page => $page,
1050                                                 destpage => $destpage,
1051                                                 preview => $preprocess_preview,
1052                                         );
1053                                 };
1054                                 if ($@) {
1055                                         chomp $@;
1056                                         $ret="[[!$command <span class=\"error\">".
1057                                                 gettext("Error").": $@"."</span>]]";
1058                                 }
1059                         }
1060                         else {
1061                                 # use void context during scan pass
1062                                 eval {
1063                                         $hooks{preprocess}{$command}{call}->(
1064                                                 @params,
1065                                                 page => $page,
1066                                                 destpage => $destpage,
1067                                                 preview => $preprocess_preview,
1068                                         );
1069                                 };
1070                                 $ret="";
1071                         }
1072                         $preprocessing{$page}--;
1073                         return $ret;
1074                 }
1075                 else {
1076                         return "[[$prefix$command $params]]";
1077                 }
1078         };
1079
1080         my $regex;
1081         if ($config{prefix_directives}) {
1082                 $regex = qr{
1083                         (\\?)           # 1: escape?
1084                         \[\[(!)         # directive open; 2: prefix
1085                         ([-\w]+)        # 3: command
1086                         (               # 4: the parameters..
1087                                 \s+     # Must have space if parameters present
1088                                 (?:
1089                                         (?:[-\w]+=)?            # named parameter key?
1090                                         (?:
1091                                                 """.*?"""       # triple-quoted value
1092                                                 |
1093                                                 "[^"]+"         # single-quoted value
1094                                                 |
1095                                                 [^\s\]]+        # unquoted value
1096                                         )
1097                                         \s*                     # whitespace or end
1098                                                                 # of directive
1099                                 )
1100                         *)?             # 0 or more parameters
1101                         \]\]            # directive closed
1102                 }sx;
1103         }
1104         else {
1105                 $regex = qr{
1106                         (\\?)           # 1: escape?
1107                         \[\[(!?)        # directive open; 2: optional prefix
1108                         ([-\w]+)        # 3: command
1109                         \s+
1110                         (               # 4: the parameters..
1111                                 (?:
1112                                         (?:[-\w]+=)?            # named parameter key?
1113                                         (?:
1114                                                 """.*?"""       # triple-quoted value
1115                                                 |
1116                                                 "[^"]+"         # single-quoted value
1117                                                 |
1118                                                 [^\s\]]+        # unquoted value
1119                                         )
1120                                         \s*                     # whitespace or end
1121                                                                 # of directive
1122                                 )
1123                         *)              # 0 or more parameters
1124                         \]\]            # directive closed
1125                 }sx;
1126         }
1127
1128         $content =~ s{$regex}{$handle->($1, $2, $3, $4)}eg;
1129         return $content;
1130 } #}}}
1131
1132 sub filter ($$$) { #{{{
1133         my $page=shift;
1134         my $destpage=shift;
1135         my $content=shift;
1136
1137         run_hooks(filter => sub {
1138                 $content=shift->(page => $page, destpage => $destpage,
1139                         content => $content);
1140         });
1141
1142         return $content;
1143 } #}}}
1144
1145 sub indexlink () { #{{{
1146         return "<a href=\"$config{url}\">$config{wikiname}</a>";
1147 } #}}}
1148
1149 my $wikilock;
1150
1151 sub lockwiki (;$) { #{{{
1152         my $wait=@_ ? shift : 1;
1153         # Take an exclusive lock on the wiki to prevent multiple concurrent
1154         # run issues. The lock will be dropped on program exit.
1155         if (! -d $config{wikistatedir}) {
1156                 mkdir($config{wikistatedir});
1157         }
1158         open($wikilock, '>', "$config{wikistatedir}/lockfile") ||
1159                 error ("cannot write to $config{wikistatedir}/lockfile: $!");
1160         if (! flock($wikilock, 2 | 4)) { # LOCK_EX | LOCK_NB
1161                 if ($wait) {
1162                         debug("wiki seems to be locked, waiting for lock");
1163                         my $wait=600; # arbitrary, but don't hang forever to
1164                                       # prevent process pileup
1165                         for (1..$wait) {
1166                                 return if flock($wikilock, 2 | 4);
1167                                 sleep 1;
1168                         }
1169                         error("wiki is locked; waited $wait seconds without lock being freed (possible stuck process or stale lock?)");
1170                 }
1171                 else {
1172                         return 0;
1173                 }
1174         }
1175         return 1;
1176 } #}}}
1177
1178 sub unlockwiki () { #{{{
1179         return close($wikilock) if $wikilock;
1180         return;
1181 } #}}}
1182
1183 my $commitlock;
1184
1185 sub commit_hook_enabled () { #{{{
1186         open($commitlock, '+>', "$config{wikistatedir}/commitlock") ||
1187                 error("cannot write to $config{wikistatedir}/commitlock: $!");
1188         if (! flock($commitlock, 1 | 4)) { # LOCK_SH | LOCK_NB to test
1189                 close($commitlock) || error("failed closing commitlock: $!");
1190                 return 0;
1191         }
1192         close($commitlock) || error("failed closing commitlock: $!");
1193         return 1;
1194 } #}}}
1195
1196 sub disable_commit_hook () { #{{{
1197         open($commitlock, '>', "$config{wikistatedir}/commitlock") ||
1198                 error("cannot write to $config{wikistatedir}/commitlock: $!");
1199         if (! flock($commitlock, 2)) { # LOCK_EX
1200                 error("failed to get commit lock");
1201         }
1202         return 1;
1203 } #}}}
1204
1205 sub enable_commit_hook () { #{{{
1206         return close($commitlock) if $commitlock;
1207         return;
1208 } #}}}
1209
1210 sub loadindex () { #{{{
1211         %oldrenderedfiles=%pagectime=();
1212         if (! $config{rebuild}) {
1213                 %pagesources=%pagemtime=%oldlinks=%links=%depends=
1214                 %destsources=%renderedfiles=%pagecase=%pagestate=();
1215         }
1216         my $in;
1217         if (! open ($in, "<", "$config{wikistatedir}/indexdb")) {
1218                 if (-e "$config{wikistatedir}/index") {
1219                         system("ikiwiki-transition", "indexdb", $config{srcdir});
1220                         open ($in, "<", "$config{wikistatedir}/indexdb") || return;
1221                 }
1222                 else {
1223                         return;
1224                 }
1225         }
1226         my $ret=Storable::fd_retrieve($in);
1227         if (! defined $ret) {
1228                 return 0;
1229         }
1230         my %index=%$ret;
1231         foreach my $src (keys %index) {
1232                 my %d=%{$index{$src}};
1233                 my $page=pagename($src);
1234                 $pagectime{$page}=$d{ctime};
1235                 if (! $config{rebuild}) {
1236                         $pagesources{$page}=$src;
1237                         $pagemtime{$page}=$d{mtime};
1238                         $renderedfiles{$page}=$d{dest};
1239                         if (exists $d{links} && ref $d{links}) {
1240                                 $links{$page}=$d{links};
1241                                 $oldlinks{$page}=[@{$d{links}}];
1242                         }
1243                         if (exists $d{depends}) {
1244                                 $depends{$page}=$d{depends};
1245                         }
1246                         if (exists $d{state}) {
1247                                 $pagestate{$page}=$d{state};
1248                         }
1249                 }
1250                 $oldrenderedfiles{$page}=[@{$d{dest}}];
1251         }
1252         foreach my $page (keys %pagesources) {
1253                 $pagecase{lc $page}=$page;
1254         }
1255         foreach my $page (keys %renderedfiles) {
1256                 $destsources{$_}=$page foreach @{$renderedfiles{$page}};
1257         }
1258         return close($in);
1259 } #}}}
1260
1261 sub saveindex () { #{{{
1262         run_hooks(savestate => sub { shift->() });
1263
1264         my %hookids;
1265         foreach my $type (keys %hooks) {
1266                 $hookids{$_}=1 foreach keys %{$hooks{$type}};
1267         }
1268         my @hookids=keys %hookids;
1269
1270         if (! -d $config{wikistatedir}) {
1271                 mkdir($config{wikistatedir});
1272         }
1273         my $newfile="$config{wikistatedir}/indexdb.new";
1274         my $cleanup = sub { unlink($newfile) };
1275         open (my $out, '>', $newfile) || error("cannot write to $newfile: $!", $cleanup);
1276         my %index;
1277         foreach my $page (keys %pagemtime) {
1278                 next unless $pagemtime{$page};
1279                 my $src=$pagesources{$page};
1280
1281                 $index{$src}={
1282                         ctime => $pagectime{$page},
1283                         mtime => $pagemtime{$page},
1284                         dest => $renderedfiles{$page},
1285                         links => $links{$page},
1286                 };
1287
1288                 if (exists $depends{$page}) {
1289                         $index{$src}{depends} = $depends{$page};
1290                 }
1291
1292                 if (exists $pagestate{$page}) {
1293                         foreach my $id (@hookids) {
1294                                 foreach my $key (keys %{$pagestate{$page}{$id}}) {
1295                                         $index{$src}{state}{$id}{$key}=$pagestate{$page}{$id}{$key};
1296                                 }
1297                         }
1298                 }
1299         }
1300         my $ret=Storable::nstore_fd(\%index, $out);
1301         return if ! defined $ret || ! $ret;
1302         close $out || error("failed saving to $newfile: $!", $cleanup);
1303         rename($newfile, "$config{wikistatedir}/indexdb") ||
1304                 error("failed renaming $newfile to $config{wikistatedir}/indexdb", $cleanup);
1305
1306         return 1;
1307 } #}}}
1308
1309 sub template_file ($) { #{{{
1310         my $template=shift;
1311
1312         foreach my $dir ($config{templatedir}, "$installdir/share/ikiwiki/templates") {
1313                 return "$dir/$template" if -e "$dir/$template";
1314         }
1315         return;
1316 } #}}}
1317
1318 sub template_params (@) { #{{{
1319         my $filename=template_file(shift);
1320
1321         if (! defined $filename) {
1322                 return if wantarray;
1323                 return "";
1324         }
1325
1326         my @ret=(
1327                 filter => sub {
1328                         my $text_ref = shift;
1329                         ${$text_ref} = decode_utf8(${$text_ref});
1330                 },
1331                 filename => $filename,
1332                 loop_context_vars => 1,
1333                 die_on_bad_params => 0,
1334                 @_
1335         );
1336         return wantarray ? @ret : {@ret};
1337 } #}}}
1338
1339 sub template ($;@) { #{{{
1340         require HTML::Template;
1341         return HTML::Template->new(template_params(@_));
1342 } #}}}
1343
1344 sub misctemplate ($$;@) { #{{{
1345         my $title=shift;
1346         my $pagebody=shift;
1347
1348         my $template=template("misc.tmpl");
1349         $template->param(
1350                 title => $title,
1351                 indexlink => indexlink(),
1352                 wikiname => $config{wikiname},
1353                 pagebody => $pagebody,
1354                 baseurl => baseurl(),
1355                 @_,
1356         );
1357         run_hooks(pagetemplate => sub {
1358                 shift->(page => "", destpage => "", template => $template);
1359         });
1360         return $template->output;
1361 }#}}}
1362
1363 sub hook (@) { # {{{
1364         my %param=@_;
1365
1366         if (! exists $param{type} || ! ref $param{call} || ! exists $param{id}) {
1367                 error 'hook requires type, call, and id parameters';
1368         }
1369
1370         return if $param{no_override} && exists $hooks{$param{type}}{$param{id}};
1371
1372         $hooks{$param{type}}{$param{id}}=\%param;
1373         return 1;
1374 } # }}}
1375
1376 sub run_hooks ($$) { # {{{
1377         # Calls the given sub for each hook of the given type,
1378         # passing it the hook function to call.
1379         my $type=shift;
1380         my $sub=shift;
1381
1382         if (exists $hooks{$type}) {
1383                 my @deferred;
1384                 foreach my $id (keys %{$hooks{$type}}) {
1385                         if ($hooks{$type}{$id}{last}) {
1386                                 push @deferred, $id;
1387                                 next;
1388                         }
1389                         $sub->($hooks{$type}{$id}{call});
1390                 }
1391                 foreach my $id (@deferred) {
1392                         $sub->($hooks{$type}{$id}{call});
1393                 }
1394         }
1395
1396         return 1;
1397 } #}}}
1398
1399 sub globlist_to_pagespec ($) { #{{{
1400         my @globlist=split(' ', shift);
1401
1402         my (@spec, @skip);
1403         foreach my $glob (@globlist) {
1404                 if ($glob=~/^!(.*)/) {
1405                         push @skip, $glob;
1406                 }
1407                 else {
1408                         push @spec, $glob;
1409                 }
1410         }
1411
1412         my $spec=join(' or ', @spec);
1413         if (@skip) {
1414                 my $skip=join(' and ', @skip);
1415                 if (length $spec) {
1416                         $spec="$skip and ($spec)";
1417                 }
1418                 else {
1419                         $spec=$skip;
1420                 }
1421         }
1422         return $spec;
1423 } #}}}
1424
1425 sub is_globlist ($) { #{{{
1426         my $s=shift;
1427         return ( $s =~ /[^\s]+\s+([^\s]+)/ && $1 ne "and" && $1 ne "or" );
1428 } #}}}
1429
1430 sub safequote ($) { #{{{
1431         my $s=shift;
1432         $s=~s/[{}]//g;
1433         return "q{$s}";
1434 } #}}}
1435
1436 sub add_depends ($$) { #{{{
1437         my $page=shift;
1438         my $pagespec=shift;
1439
1440         return unless pagespec_valid($pagespec);
1441
1442         if (! exists $depends{$page}) {
1443                 $depends{$page}=$pagespec;
1444         }
1445         else {
1446                 $depends{$page}=pagespec_merge($depends{$page}, $pagespec);
1447         }
1448
1449         return 1;
1450 } # }}}
1451
1452 sub file_pruned ($$) { #{{{
1453         require File::Spec;
1454         my $file=File::Spec->canonpath(shift);
1455         my $base=File::Spec->canonpath(shift);
1456         $file =~ s#^\Q$base\E/+##;
1457
1458         my $regexp='('.join('|', @{$config{wiki_file_prune_regexps}}).')';
1459         return $file =~ m/$regexp/ && $file ne $base;
1460 } #}}}
1461
1462 sub gettext { #{{{
1463         # Only use gettext in the rare cases it's needed.
1464         if ((exists $ENV{LANG} && length $ENV{LANG}) ||
1465             (exists $ENV{LC_ALL} && length $ENV{LC_ALL}) ||
1466             (exists $ENV{LC_MESSAGES} && length $ENV{LC_MESSAGES})) {
1467                 if (! $gettext_obj) {
1468                         $gettext_obj=eval q{
1469                                 use Locale::gettext q{textdomain};
1470                                 Locale::gettext->domain('ikiwiki')
1471                         };
1472                         if ($@) {
1473                                 print STDERR "$@";
1474                                 $gettext_obj=undef;
1475                                 return shift;
1476                         }
1477                 }
1478                 return $gettext_obj->get(shift);
1479         }
1480         else {
1481                 return shift;
1482         }
1483 } #}}}
1484
1485 sub yesno ($) { #{{{
1486         my $val=shift;
1487
1488         return (defined $val && lc($val) eq gettext("yes"));
1489 } #}}}
1490
1491 sub pagespec_merge ($$) { #{{{
1492         my $a=shift;
1493         my $b=shift;
1494
1495         return $a if $a eq $b;
1496
1497         # Support for old-style GlobLists.
1498         if (is_globlist($a)) {
1499                 $a=globlist_to_pagespec($a);
1500         }
1501         if (is_globlist($b)) {
1502                 $b=globlist_to_pagespec($b);
1503         }
1504
1505         return "($a) or ($b)";
1506 } #}}}
1507
1508 sub pagespec_translate ($) { #{{{
1509         my $spec=shift;
1510
1511         # Support for old-style GlobLists.
1512         if (is_globlist($spec)) {
1513                 $spec=globlist_to_pagespec($spec);
1514         }
1515
1516         # Convert spec to perl code.
1517         my $code="";
1518         while ($spec=~m{
1519                 \s*             # ignore whitespace
1520                 (               # 1: match a single word
1521                         \!              # !
1522                 |
1523                         \(              # (
1524                 |
1525                         \)              # )
1526                 |
1527                         \w+\([^\)]*\)   # command(params)
1528                 |
1529                         [^\s()]+        # any other text
1530                 )
1531                 \s*             # ignore whitespace
1532         }igx) {
1533                 my $word=$1;
1534                 if (lc $word eq 'and') {
1535                         $code.=' &&';
1536                 }
1537                 elsif (lc $word eq 'or') {
1538                         $code.=' ||';
1539                 }
1540                 elsif ($word eq "(" || $word eq ")" || $word eq "!") {
1541                         $code.=' '.$word;
1542                 }
1543                 elsif ($word =~ /^(\w+)\((.*)\)$/) {
1544                         if (exists $IkiWiki::PageSpec::{"match_$1"}) {
1545                                 $code.="IkiWiki::PageSpec::match_$1(\$page, ".safequote($2).", \@_)";
1546                         }
1547                         else {
1548                                 $code.=' 0';
1549                         }
1550                 }
1551                 else {
1552                         $code.=" IkiWiki::PageSpec::match_glob(\$page, ".safequote($word).", \@_)";
1553                 }
1554         }
1555
1556         if (! length $code) {
1557                 $code=0;
1558         }
1559
1560         no warnings;
1561         return eval 'sub { my $page=shift; '.$code.' }';
1562 } #}}}
1563
1564 sub pagespec_match ($$;@) { #{{{
1565         my $page=shift;
1566         my $spec=shift;
1567         my @params=@_;
1568
1569         # Backwards compatability with old calling convention.
1570         if (@params == 1) {
1571                 unshift @params, 'location';
1572         }
1573
1574         my $sub=pagespec_translate($spec);
1575         return IkiWiki::FailReason->new("syntax error in pagespec \"$spec\"") if $@;
1576         return $sub->($page, @params);
1577 } #}}}
1578
1579 sub pagespec_valid ($) { #{{{
1580         my $spec=shift;
1581
1582         my $sub=pagespec_translate($spec);
1583         return ! $@;
1584 } #}}}
1585
1586 sub glob2re ($) { #{{{
1587         my $re=quotemeta(shift);
1588         $re=~s/\\\*/.*/g;
1589         $re=~s/\\\?/./g;
1590         return $re;
1591 } #}}}
1592
1593 package IkiWiki::FailReason;
1594
1595 use overload ( #{{{
1596         '""'    => sub { ${$_[0]} },
1597         '0+'    => sub { 0 },
1598         '!'     => sub { bless $_[0], 'IkiWiki::SuccessReason'},
1599         fallback => 1,
1600 ); #}}}
1601
1602 sub new { #{{{
1603         my $class = shift;
1604         my $value = shift;
1605         return bless \$value, $class;
1606 } #}}}
1607
1608 package IkiWiki::SuccessReason;
1609
1610 use overload ( #{{{
1611         '""'    => sub { ${$_[0]} },
1612         '0+'    => sub { 1 },
1613         '!'     => sub { bless $_[0], 'IkiWiki::FailReason'},
1614         fallback => 1,
1615 ); #}}}
1616
1617 sub new { #{{{
1618         my $class = shift;
1619         my $value = shift;
1620         return bless \$value, $class;
1621 }; #}}}
1622
1623 package IkiWiki::PageSpec;
1624
1625 sub match_glob ($$;@) { #{{{
1626         my $page=shift;
1627         my $glob=shift;
1628         my %params=@_;
1629
1630         my $from=exists $params{location} ? $params{location} : '';
1631
1632         # relative matching
1633         if ($glob =~ m!^\./!) {
1634                 $from=~s#/?[^/]+$##;
1635                 $glob=~s#^\./##;
1636                 $glob="$from/$glob" if length $from;
1637         }
1638
1639         my $regexp=IkiWiki::glob2re($glob);
1640         if ($page=~/^$regexp$/i) {
1641                 if (! IkiWiki::isinternal($page) || $params{internal}) {
1642                         return IkiWiki::SuccessReason->new("$glob matches $page");
1643                 }
1644                 else {
1645                         return IkiWiki::FailReason->new("$glob matches $page, but the page is an internal page");
1646                 }
1647         }
1648         else {
1649                 return IkiWiki::FailReason->new("$glob does not match $page");
1650         }
1651 } #}}}
1652
1653 sub match_internal ($$;@) { #{{{
1654         return match_glob($_[0], $_[1], @_, internal => 1)
1655 } #}}}
1656
1657 sub match_link ($$;@) { #{{{
1658         my $page=shift;
1659         my $link=lc(shift);
1660         my %params=@_;
1661
1662         my $from=exists $params{location} ? $params{location} : '';
1663
1664         # relative matching
1665         if ($link =~ m!^\.! && defined $from) {
1666                 $from=~s#/?[^/]+$##;
1667                 $link=~s#^\./##;
1668                 $link="$from/$link" if length $from;
1669         }
1670
1671         my $links = $IkiWiki::links{$page};
1672         return IkiWiki::FailReason->new("$page has no links") unless $links && @{$links};
1673         my $bestlink = IkiWiki::bestlink($from, $link);
1674         foreach my $p (@{$links}) {
1675                 if (length $bestlink) {
1676                         return IkiWiki::SuccessReason->new("$page links to $link")
1677                                 if $bestlink eq IkiWiki::bestlink($page, $p);
1678                 }
1679                 else {
1680                         return IkiWiki::SuccessReason->new("$page links to page $p matching $link")
1681                                 if match_glob($p, $link, %params);
1682                 }
1683         }
1684         return IkiWiki::FailReason->new("$page does not link to $link");
1685 } #}}}
1686
1687 sub match_backlink ($$;@) { #{{{
1688         return match_link($_[1], $_[0], @_);
1689 } #}}}
1690
1691 sub match_created_before ($$;@) { #{{{
1692         my $page=shift;
1693         my $testpage=shift;
1694
1695         if (exists $IkiWiki::pagectime{$testpage}) {
1696                 if ($IkiWiki::pagectime{$page} < $IkiWiki::pagectime{$testpage}) {
1697                         return IkiWiki::SuccessReason->new("$page created before $testpage");
1698                 }
1699                 else {
1700                         return IkiWiki::FailReason->new("$page not created before $testpage");
1701                 }
1702         }
1703         else {
1704                 return IkiWiki::FailReason->new("$testpage has no ctime");
1705         }
1706 } #}}}
1707
1708 sub match_created_after ($$;@) { #{{{
1709         my $page=shift;
1710         my $testpage=shift;
1711
1712         if (exists $IkiWiki::pagectime{$testpage}) {
1713                 if ($IkiWiki::pagectime{$page} > $IkiWiki::pagectime{$testpage}) {
1714                         return IkiWiki::SuccessReason->new("$page created after $testpage");
1715                 }
1716                 else {
1717                         return IkiWiki::FailReason->new("$page not created after $testpage");
1718                 }
1719         }
1720         else {
1721                 return IkiWiki::FailReason->new("$testpage has no ctime");
1722         }
1723 } #}}}
1724
1725 sub match_creation_day ($$;@) { #{{{
1726         if ((gmtime($IkiWiki::pagectime{shift()}))[3] == shift) {
1727                 return IkiWiki::SuccessReason->new('creation_day matched');
1728         }
1729         else {
1730                 return IkiWiki::FailReason->new('creation_day did not match');
1731         }
1732 } #}}}
1733
1734 sub match_creation_month ($$;@) { #{{{
1735         if ((gmtime($IkiWiki::pagectime{shift()}))[4] + 1 == shift) {
1736                 return IkiWiki::SuccessReason->new('creation_month matched');
1737         }
1738         else {
1739                 return IkiWiki::FailReason->new('creation_month did not match');
1740         }
1741 } #}}}
1742
1743 sub match_creation_year ($$;@) { #{{{
1744         if ((gmtime($IkiWiki::pagectime{shift()}))[5] + 1900 == shift) {
1745                 return IkiWiki::SuccessReason->new('creation_year matched');
1746         }
1747         else {
1748                 return IkiWiki::FailReason->new('creation_year did not match');
1749         }
1750 } #}}}
1751
1752 1