X-Git-Url: http://git.vanrenterghem.biz/git.ikiwiki.info.git/blobdiff_plain/ecf37caff985ebb12603630564984a78deee182e..811dce7aad96dd7c36efa19562723fc5507e7554:/IkiWiki.pm

diff --git a/IkiWiki.pm b/IkiWiki.pm
index 2392c787b..5f0055d3e 100644
--- a/IkiWiki.pm
+++ b/IkiWiki.pm
@@ -5,18 +5,20 @@ use warnings;
 use strict;
 use Encode;
 use HTML::Entities;
+use URI::Escape q{uri_escape_utf8};
+use POSIX;
 use open qw{:utf8 :std};
 
-use vars qw{%config %links %oldlinks %oldpagemtime %pagectime %pagecase
-            %renderedfiles %oldrenderedfiles %pagesources %depends %hooks
-	    %forcerebuild $gettext_obj};
+use vars qw{%config %links %oldlinks %pagemtime %pagectime %pagecase
+            %renderedfiles %oldrenderedfiles %pagesources %destsources
+	    %depends %hooks %forcerebuild $gettext_obj};
 
 use Exporter q{import};
 our @EXPORT = qw(hook debug error template htmlpage add_depends pagespec_match
                  bestlink htmllink readfile writefile pagetype srcfile pagename
-                 displaytime will_render gettext
-                 %config %links %renderedfiles %pagesources);
-our $VERSION = 1.01; # plugin interface version, next is ikiwiki version
+                 displaytime will_render gettext urlto targetpage
+                 %config %links %renderedfiles %pagesources %destsources);
+our $VERSION = 1.02; # plugin interface version, next is ikiwiki version
 our $version='unknown'; # VERSION_AUTOREPLACE done by Makefile, DNE
 my $installdir=''; # INSTALLDIR_AUTOREPLACE done by Makefile, DNE
 
@@ -29,8 +31,9 @@ memoize("file_pruned");
 sub defaultconfig () { #{{{
 	wiki_file_prune_regexps => [qr/\.\./, qr/^\./, qr/\/\./,
 		qr/\.x?html?$/, qr/\.ikiwiki-new$/,
-		qr/(^|\/).svn\//, qr/.arch-ids\//, qr/{arch}\//],
-	wiki_link_regexp => qr/\[\[(?:([^\]\|]+)\|)?([^\s\]]+)\]\]/,
+		qr/(^|\/).svn\//, qr/.arch-ids\//, qr/{arch}\//,
+		qr/\.dpkg-tmp$/],
+	wiki_link_regexp => qr/\[\[(?:([^\]\|]+)\|)?([^\s\]#]+)(?:#([^\s\]]+))?\]\]/,
 	wiki_file_regexp => qr/(^[-[:alnum:]_.:\/+]+$)/,
 	web_commit_regexp => qr/^web commit (by (.*?(?=: |$))|from (\d+\.\d+\.\d+\.\d+)):?(.*)/,
 	verbose => 0,
@@ -38,6 +41,7 @@ sub defaultconfig () { #{{{
 	wikiname => "wiki",
 	default_pageext => "mdwn",
 	cgi => 0,
+	post_commit => 0,
 	rcs => '',
 	notify => 0,
 	url => '',
@@ -72,6 +76,8 @@ sub defaultconfig () { #{{{
 	sslcookie => 0,
 	httpauth => 0,
 	userdir => "",
+	usedirs => 0,
+	numbacklinks => 10,
 } #}}}
    
 sub checkconfig () { #{{{
@@ -81,8 +87,6 @@ sub checkconfig () { #{{{
 		delete $ENV{LC_ALL};
 	}
 	if (defined $config{locale}) {
-		eval q{use POSIX};
-		error($@) if $@;
 		if (POSIX::setlocale(&POSIX::LC_ALL, $config{locale})) {
 			$ENV{LANG}=$config{locale};
 			$gettext_obj=undef;
@@ -150,7 +154,7 @@ sub error ($;$) { #{{{
 		print misctemplate(gettext("Error"),
 			"<p>".gettext("Error").": $message</p>");
 	}
-	log_message(debug => $message) if $config{syslog};
+	log_message('err' => $message) if $config{syslog};
 	if (defined $cleaner) {
 		$cleaner->();
 	}
@@ -175,7 +179,7 @@ sub log_message ($$) { #{{{
 		}
 		eval {
 			Sys::Syslog::syslog($type, "%s", join(" ", @_));
-		}
+		};
 	}
 	elsif (! $config{cgi}) {
 		print "@_\n";
@@ -223,10 +227,21 @@ sub pagename ($) { #{{{
 	return $page;
 } #}}}
 
-sub htmlpage ($) { #{{{
+sub targetpage ($$) { #{{{
 	my $page=shift;
+	my $ext=shift;
+	
+	if (! $config{usedirs} || $page =~ /^index$/ ) {
+		return $page.".".$ext;
+	} else {
+		return $page."/index.".$ext;
+	}
+} #}}}
 
-	return $page.".html";
+sub htmlpage ($) { #{{{
+	my $page=shift;
+	
+	return targetpage($page, "html");
 } #}}}
 
 sub srcfile ($) { #{{{
@@ -234,7 +249,7 @@ sub srcfile ($) { #{{{
 
 	return "$config{srcdir}/$file" if -e "$config{srcdir}/$file";
 	return "$config{underlaydir}/$file" if -e "$config{underlaydir}/$file";
-	error("internal error: $file cannot be found");
+	error("internal error: $file cannot be found in $config{srcdir} or $config{underlaydir}");
 } #}}}
 
 sub readfile ($;$$) { #{{{
@@ -292,7 +307,7 @@ sub writefile ($$$;$$) { #{{{
 		$writer->(\*OUT, $cleanup);
 	}
 	else {
-		print OUT $content || error("failed writing to $newfile: $!", $cleanup);
+		print OUT $content or error("failed writing to $newfile: $!", $cleanup);
 	}
 	close OUT || error("failed saving $newfile: $!", $cleanup);
 	rename($newfile, "$destdir/$file") || 
@@ -315,9 +330,13 @@ sub will_render ($$;$) { #{{{
 		$renderedfiles{$page}=[$dest, grep { $_ ne $dest } @{$renderedfiles{$page}}];
 	}
 	else {
+		foreach my $old (@{$renderedfiles{$page}}) {
+			delete $destsources{$old};
+		}
 		$renderedfiles{$page}=[$dest];
 		$cleared{$page}=1;
 	}
+	$destsources{$dest}=$page;
 } #}}}
 
 sub bestlink ($$) { #{{{
@@ -362,27 +381,32 @@ sub pagetitle ($;$) { #{{{
 	my $unescaped=shift;
 
 	if ($unescaped) {
-		$page=~s/__(\d+)__/chr($1)/eg;
+		$page=~s/(__(\d+)__|_)/$1 eq '_' ? ' ' : chr($2)/eg;
 	}
 	else {
-		$page=~s/__(\d+)__/&#$1;/g;
+		$page=~s/(__(\d+)__|_)/$1 eq '_' ? ' ' : "&#$2;"/eg;
 	}
-	$page=~y/_/ /;
 
 	return $page;
 } #}}}
 
 sub titlepage ($) { #{{{
 	my $title=shift;
-	$title=~y/ /_/;
-	$title=~s/([^-[:alnum:]_:+\/.])/"__".ord($1)."__"/eg;
+	$title=~s/([^-[:alnum:]:+\/.])/$1 eq ' ' ? '_' : "__".ord($1)."__"/eg;
 	return $title;
 } #}}}
 
+sub linkpage ($) { #{{{
+	my $link=shift;
+	$link=~s/([^-[:alnum:]:+\/._])/$1 eq ' ' ? '_' : "__".ord($1)."__"/eg;
+	return $link;
+} #}}}
+
 sub cgiurl (@) { #{{{
 	my %params=@_;
 
-	return $config{cgiurl}."?".join("&amp;", map "$_=$params{$_}", keys %params);
+	return $config{cgiurl}."?".
+		join("&amp;", map $_."=".uri_escape_utf8($params{$_}), keys %params);
 } #}}}
 
 sub baseurl (;$) { #{{{
@@ -390,6 +414,7 @@ sub baseurl (;$) { #{{{
 
 	return "$config{url}/" if ! defined $page;
 	
+	$page=htmlpage($page);
 	$page=~s/[^\/]+$//;
 	$page=~s/[^\/]+\//..\//g;
 	return $page;
@@ -411,50 +436,89 @@ sub abs2rel ($$) { #{{{
 sub displaytime ($) { #{{{
 	my $time=shift;
 
-	eval q{use POSIX};
-	error($@) if $@;
 	# strftime doesn't know about encodings, so make sure
 	# its output is properly treated as utf8
 	return decode_utf8(POSIX::strftime(
 			$config{timeformat}, localtime($time)));
 } #}}}
 
-sub htmllink ($$$;$$$) { #{{{
+sub beautify_url ($) { #{{{
+	my $url=shift;
+
+	$url =~ s!/index.html$!/!;
+	$url =~ s!^$!./!; # Browsers don't like empty links...
+
+	return $url;
+} #}}}
+
+sub urlto ($$) { #{{{
+	my $to=shift;
+	my $from=shift;
+
+	if (! length $to) {
+		return beautify_url(baseurl($from));
+	}
+
+	if (! $destsources{$to}) {
+		$to=htmlpage($to);
+	}
+
+	my $link = abs2rel($to, dirname(htmlpage($from)));
+
+	return beautify_url($link);
+} #}}}
+
+sub htmllink ($$$;@) { #{{{
 	my $lpage=shift; # the page doing the linking
 	my $page=shift; # the page that will contain the link (different for inline)
 	my $link=shift;
-	my $noimageinline=shift; # don't turn links into inline html images
-	my $forcesubpage=shift; # force a link to a subpage
-	my $linktext=shift; # set to force the link text to something
+	my %opts=@_;
 
 	my $bestlink;
-	if (! $forcesubpage) {
+	if (! $opts{forcesubpage}) {
 		$bestlink=bestlink($lpage, $link);
 	}
 	else {
 		$bestlink="$lpage/".lc($link);
 	}
 
-	$linktext=pagetitle(basename($link)) unless defined $linktext;
+	my $linktext;
+	if (defined $opts{linktext}) {
+		$linktext=$opts{linktext};
+	}
+	else {
+		$linktext=pagetitle(basename($link));
+	}
 	
 	return "<span class=\"selflink\">$linktext</span>"
 		if length $bestlink && $page eq $bestlink;
 	
-	if (! grep { $_ eq $bestlink } map { @{$_} } values %renderedfiles) {
+	if (! $destsources{$bestlink}) {
 		$bestlink=htmlpage($bestlink);
-	}
-	if (! grep { $_ eq $bestlink } map { @{$_} } values %renderedfiles) {
-		return $linktext unless length $config{cgiurl};
-		return "<span><a href=\"".
-			cgiurl(do => "create", page => lc($link), from => $page).
-			"\">?</a>$linktext</span>"
+
+		if (! $destsources{$bestlink}) {
+			return $linktext unless length $config{cgiurl};
+			return "<span><a href=\"".
+				cgiurl(
+					do => "create",
+					page => pagetitle(lc($link), 1),
+					from => $lpage
+				).
+				"\">?</a>$linktext</span>"
+		}
 	}
 	
-	$bestlink=abs2rel($bestlink, dirname($page));
+	$bestlink=abs2rel($bestlink, dirname(htmlpage($page)));
+	$bestlink=beautify_url($bestlink);
 	
-	if (! $noimageinline && isinlinableimage($bestlink)) {
+	if (! $opts{noimageinline} && isinlinableimage($bestlink)) {
 		return "<img src=\"$bestlink\" alt=\"$linktext\" />";
 	}
+
+	if (defined $opts{anchor}) {
+		$bestlink.="#".$opts{anchor};
+	}
+
 	return "<a href=\"$bestlink\">$linktext</a>";
 } #}}}
 
@@ -489,19 +553,32 @@ sub linkify ($$$) { #{{{
 	my $content=shift;
 
 	$content =~ s{(\\?)$config{wiki_link_regexp}}{
-		$2 ? ( $1 ? "[[$2|$3]]" : htmllink($lpage, $page, titlepage($3), 0, 0, pagetitle($2)))
-		   : ( $1 ? "[[$3]]" :    htmllink($lpage, $page, titlepage($3)))
+		defined $2
+			? ( $1 
+				? "[[$2|$3".($4 ? "#$4" : "")."]]" 
+				: htmllink($lpage, $page, linkpage($3),
+					anchor => $4, linktext => pagetitle($2)))
+			: ( $1 
+				? "[[$3".($4 ? "#$4" : "")."]]"
+				: htmllink($lpage, $page, linkpage($3),
+					anchor => $4))
 	}eg;
 	
 	return $content;
 } #}}}
 
 my %preprocessing;
-sub preprocess ($$$;$) { #{{{
+our $preprocess_preview=0;
+sub preprocess ($$$;$$) { #{{{
 	my $page=shift; # the page the data comes from
 	my $destpage=shift; # the page the data will appear in (different for inline)
 	my $content=shift;
 	my $scan=shift;
+	my $preview=shift;
+
+	# Using local because it needs to be set within any nested calls
+	# of this function.
+	local $preprocess_preview=$preview if defined $preview;
 
 	my $handle=sub {
 		my $escape=shift;
@@ -553,6 +630,7 @@ sub preprocess ($$$;$) { #{{{
 				@params,
 				page => $page,
 				destpage => $destpage,
+				preview => $preprocess_preview,
 			);
 			$preprocessing{$page}--;
 			return $ret;
@@ -589,7 +667,7 @@ sub lockwiki () { #{{{
 	}
 	open(WIKILOCK, ">$config{wikistatedir}/lockfile") ||
 		error ("cannot write to $config{wikistatedir}/lockfile: $!");
-	if (! flock(WIKILOCK, 2 | 4)) {
+	if (! flock(WIKILOCK, 2 | 4)) { # LOCK_EX | LOCK_NB
 		debug("wiki seems to be locked, waiting for lock");
 		my $wait=600; # arbitrary, but don't hang forever to 
 		              # prevent process pileup
@@ -605,6 +683,29 @@ sub unlockwiki () { #{{{
 	close WIKILOCK;
 } #}}}
 
+sub commit_hook_enabled () { #{{{
+	open(COMMITLOCK, "+>$config{wikistatedir}/commitlock") ||
+		error ("cannot write to $config{wikistatedir}/commitlock: $!");
+	if (! flock(COMMITLOCK, 1 | 4)) { # LOCK_SH | LOCK_NB to test
+		close COMMITLOCK;
+		return 0;
+	}
+	close COMMITLOCK;
+	return 1;
+} #}}}
+
+sub disable_commit_hook () { #{{{
+	open(COMMITLOCK, ">$config{wikistatedir}/commitlock") ||
+		error ("cannot write to $config{wikistatedir}/commitlock: $!");
+	if (! flock(COMMITLOCK, 2)) { # LOCK_EX
+		error("failed to get commit lock");
+	}
+} #}}}
+
+sub enable_commit_hook () { #{{{
+	close COMMITLOCK;
+} #}}}
+
 sub loadindex () { #{{{
 	open (IN, "$config{wikistatedir}/index") || return;
 	while (<IN>) {
@@ -623,10 +724,11 @@ sub loadindex () { #{{{
 		my $page=pagename($items{src}[0]);
 		if (! $config{rebuild}) {
 			$pagesources{$page}=$items{src}[0];
-			$oldpagemtime{$page}=$items{mtime}[0];
+			$pagemtime{$page}=$items{mtime}[0];
 			$oldlinks{$page}=[@{$items{link}}];
 			$links{$page}=[@{$items{link}}];
 			$depends{$page}=$items{depends}[0] if exists $items{depends};
+			$destsources{$_}=$page foreach @{$items{dest}};
 			$renderedfiles{$page}=[@{$items{dest}}];
 			$oldrenderedfiles{$page}=[@{$items{dest}}];
 			$pagecase{lc $page}=$page;
@@ -645,9 +747,9 @@ sub saveindex () { #{{{
 	my $newfile="$config{wikistatedir}/index.new";
 	my $cleanup = sub { unlink($newfile) };
 	open (OUT, ">$newfile") || error("cannot write to $newfile: $!", $cleanup);
-	foreach my $page (keys %oldpagemtime) {
-		next unless $oldpagemtime{$page};
-		my $line="mtime=$oldpagemtime{$page} ".
+	foreach my $page (keys %pagemtime) {
+		next unless $pagemtime{$page};
+		my $line="mtime=$pagemtime{$page} ".
 			"ctime=$pagectime{$page} ".
 			"src=$pagesources{$page}";
 		$line.=" dest=$_" foreach @{$renderedfiles{$page}};
@@ -872,7 +974,7 @@ sub pagespec_translate ($) { #{{{
 		}
 		elsif ($word =~ /^(\w+)\((.*)\)$/) {
 			if (exists $IkiWiki::PageSpec::{"match_$1"}) {
-				$code.=" IkiWiki::PageSpec::match_$1(\$page, ".safequote($2).")";
+				$code.="IkiWiki::PageSpec::match_$1(\$page, ".safequote($2).", \$from)";
 			}
 			else {
 				$code.=" 0";
@@ -919,22 +1021,36 @@ sub match_glob ($$$) { #{{{
 	return $page=~/^$glob$/i;
 } #}}}
 
-sub match_link ($$) { #{{{
+sub match_link ($$$) { #{{{
 	my $page=shift;
 	my $link=lc(shift);
+	my $from=shift;
+	if (! defined $from){
+		$from = "";
+	}
+
+	# relative matching
+	if ($link =~ m!^\.! && defined $from) {
+		$from=~s!/?[^/]+$!!;
+		$link=~s!^\./!!;
+		$link="$from/$link" if length $from;
+	}
 
 	my $links = $IkiWiki::links{$page} or return undef;
+	return 0 unless @$links;
+	my $bestlink = IkiWiki::bestlink($from, $link);
+	return 0 unless length $bestlink;
 	foreach my $p (@$links) {
-		return 1 if lc $p eq $link;
+		return 1 if $bestlink eq IkiWiki::bestlink($page, $p);
 	}
 	return 0;
 } #}}}
 
-sub match_backlink ($$) { #{{{
-	match_link(pop, pop);
+sub match_backlink ($$$) { #{{{
+	match_link($_[1], $_[0], $_[3]);
 } #}}}
 
-sub match_created_before ($$) { #{{{
+sub match_created_before ($$$) { #{{{
 	my $page=shift;
 	my $testpage=shift;
 
@@ -946,7 +1062,7 @@ sub match_created_before ($$) { #{{{
 	}
 } #}}}
 
-sub match_created_after ($$) { #{{{
+sub match_created_after ($$$) { #{{{
 	my $page=shift;
 	my $testpage=shift;
 
@@ -958,15 +1074,15 @@ sub match_created_after ($$) { #{{{
 	}
 } #}}}
 
-sub match_creation_day ($$) { #{{{
+sub match_creation_day ($$$) { #{{{
 	return ((gmtime($IkiWiki::pagectime{shift()}))[3] == shift);
 } #}}}
 
-sub match_creation_month ($$) { #{{{
+sub match_creation_month ($$$) { #{{{
 	return ((gmtime($IkiWiki::pagectime{shift()}))[4] + 1 == shift);
 } #}}}
 
-sub match_creation_year ($$) { #{{{
+sub match_creation_year ($$$) { #{{{
 	return ((gmtime($IkiWiki::pagectime{shift()}))[5] + 1900 == shift);
 } #}}}