X-Git-Url: http://git.vanrenterghem.biz/git.ikiwiki.info.git/blobdiff_plain/d1d212203c72072d9a42f66c171dc6be83225894..76b963deb57219362fb15f6a2f4246e080490c05:/IkiWiki/Rcs/svn.pm diff --git a/IkiWiki/Rcs/svn.pm b/IkiWiki/Rcs/svn.pm index be4106a02..ea193e08f 100644 --- a/IkiWiki/Rcs/svn.pm +++ b/IkiWiki/Rcs/svn.pm @@ -1,13 +1,44 @@ #!/usr/bin/perl -# For subversion support. use warnings; use strict; use IkiWiki; +use POSIX qw(setlocale LC_CTYPE); + +package IkiWiki::Rcs::svn; + +sub import { #{{{ + if (exists $IkiWiki::config{svnpath}) { + # code depends on the path not having extraneous slashes + $IkiWiki::config{svnpath}=~tr#/#/#s; + $IkiWiki::config{svnpath}=~s/\/$//; + $IkiWiki::config{svnpath}=~s/^\///; + } +} #}}} + package IkiWiki; - -my $svn_webcommit=qr/^web commit by (\w+):?(.*)/; + +# svn needs LC_CTYPE set to a UTF-8 locale, so try to find one. Any will do. +sub find_lc_ctype() { + my $current = setlocale(LC_CTYPE()); + return $current if $current =~ m/UTF-?8$/i; + + # Make some obvious attempts to avoid calling `locale -a` + foreach my $locale ("$current.UTF-8", "en_US.UTF-8", "en_GB.UTF-8") { + return $locale if setlocale(LC_CTYPE(), $locale); + } + + # Try to get all available locales and pick the first UTF-8 one found. + if (my @locale = grep(/UTF-?8$/i, `locale -a`)) { + chomp @locale; + return $locale[0] if setlocale(LC_CTYPE(), $locale[0]); + } + + # fallback to the current locale + return $current; +} # }}} +$ENV{LC_CTYPE} = $ENV{LC_CTYPE} || find_lc_ctype(); sub svn_info ($$) { #{{{ my $field=shift; @@ -41,13 +72,22 @@ sub rcs_prepedit ($) { #{{{ } } #}}} -sub rcs_commit ($$$) { #{{{ +sub rcs_commit ($$$;$$) { #{{{ # Tries to commit the page; returns undef on _success_ and # a version of the page with the rcs's conflict markers on failure. # The file is relative to the srcdir. my $file=shift; my $message=shift; my $rcstoken=shift; + my $user=shift; + my $ipaddr=shift; + + if (defined $user) { + $message="web commit by $user".(length $message ? ": $message" : ""); + } + elsif (defined $ipaddr) { + $message="web commit from $ipaddr".(length $message ? ": $message" : ""); + } if (-d "$config{srcdir}/.svn") { # Check to see if the page has been changed by someone @@ -57,9 +97,8 @@ sub rcs_commit ($$$) { #{{{ if (defined $rev && defined $oldrev && $rev != $oldrev) { # Merge their changes into the file that we've # changed. - chdir($config{srcdir}); # svn merge wants to be here if (system("svn", "merge", "--quiet", "-r$oldrev:$rev", - "$config{srcdir}/$file") != 0) { + "$config{srcdir}/$file", "$config{srcdir}/$file") != 0) { warn("svn merge -r$oldrev:$rev failed\n"); } } @@ -67,7 +106,7 @@ sub rcs_commit ($$$) { #{{{ if (system("svn", "commit", "--quiet", "--encoding", "UTF-8", "-m", possibly_foolish_untaint($message), - "$config{srcdir}") != 0) { + $config{srcdir}) != 0) { my $conflict=readfile("$config{srcdir}/$file"); if (system("svn", "revert", "--quiet", "$config{srcdir}/$file") != 0) { warn("svn revert failed\n"); @@ -101,13 +140,27 @@ sub rcs_recentchanges ($) { #{{{ return unless -d "$config{srcdir}/.svn"; - eval q{use CGI 'escapeHTML'}; - eval q{use Date::Parse}; - eval q{use Time::Duration}; - eval q{use XML::Simple}; - + eval q{ + use Date::Parse; + use XML::SAX; + use XML::Simple; + }; + error($@) if $@; + + # avoid using XML::SAX::PurePerl, it's buggy with UTF-8 data + my @parsers = map { ${$_}{Name} } @{XML::SAX->parsers()}; + do { + $XML::Simple::PREFERRED_PARSER = pop @parsers; + } until $XML::Simple::PREFERRED_PARSER ne 'XML::SAX::PurePerl'; + + # --limit is only supported on Subversion 1.2.0+ + my $svn_version=`svn --version -q`; + my $svn_limit=''; + $svn_limit="--limit $num" + if $svn_version =~ /\d\.(\d)\.\d/ && $1 >= 2; + my $svn_url=svn_info("URL", $config{srcdir}); - my $xml = XMLin(scalar `svn --xml -v log '$svn_url'`, + my $xml = XMLin(scalar `svn $svn_limit --xml -v log '$svn_url'`, ForceArray => [ 'logentry', 'path' ], GroupTags => { paths => 'path' }, KeyAttr => { path => 'content' }, @@ -118,39 +171,41 @@ sub rcs_recentchanges ($) { #{{{ my $rev = $logentry->{revision}; my $user = $logentry->{author}; - my $date = $logentry->{date}; - $date =~ s/T/ /; - $date =~ s/\.\d+Z$//; - my $when=concise(ago(time - str2time($date, 'UTC'))); + my $when=str2time($logentry->{date}, 'UTC'); foreach my $msgline (split(/\n/, $logentry->{msg})) { - push @message, { line => escapeHTML($msgline) }; + push @message, { line => $msgline }; } my $committype="web"; if (defined $message[0] && - $message[0]->{line}=~/$svn_webcommit/) { - $user="$1"; - $message[0]->{line}=$2; + $message[0]->{line}=~/$config{web_commit_regexp}/) { + $user=defined $2 ? "$2" : "$3"; + $message[0]->{line}=$4; } else { $committype="svn"; } - foreach (keys %{$logentry->{paths}}) { - next unless /^\/\Q$config{svnpath}\E\/([^ ]+)(?:$|\s)/; - my $file=$1; + foreach my $file (keys %{$logentry->{paths}}) { + if (length $config{svnpath}) { + next unless $file=~/^\/\Q$config{svnpath}\E\/([^ ]+)(?:$|\s)/; + $file=$1; + } + my $diffurl=$config{diffurl}; $diffurl=~s/\[\[file\]\]/$file/g; $diffurl=~s/\[\[r1\]\]/$rev - 1/eg; $diffurl=~s/\[\[r2\]\]/$rev/g; + push @pages, { - link => htmllink("", "", pagename($file), 1), + page => pagename($file), diffurl => $diffurl, } if length $file; } - push @ret, { rev => $rev, - user => htmllink("", "", $user, 1), + push @ret, { + rev => $rev, + user => $user, committype => $committype, when => $when, message => [@message], @@ -162,69 +217,13 @@ sub rcs_recentchanges ($) { #{{{ return @ret; } #}}} -sub rcs_notify () { #{{{ - if (! exists $ENV{REV}) { - error("REV is not set, not running from svn post-commit hook, cannot send notifications"); - } - my $rev=int(possibly_foolish_untaint($ENV{REV})); - - my $user=`svnlook author $config{svnrepo} -r $rev`; - chomp $user; - my $message=`svnlook log $config{svnrepo} -r $rev`; - if ($message=~/$svn_webcommit/) { - $user="$1"; - $message=$2; - } - - my @changed_pages; - foreach my $change (`svnlook changed $config{svnrepo} -r $rev`) { - chomp $change; - if ($change =~ /^[A-Z]+\s+\Q$config{svnpath}\E\/(.*)/) { - push @changed_pages, $1; - } - } - - require IkiWiki::UserInfo; - my @email_recipients=commit_notify_list($user, @changed_pages); - if (@email_recipients) { - # TODO: if a commit spans multiple pages, this will send - # subscribers a diff that might contain pages they did not - # sign up for. Should separate the diff per page and - # reassemble into one mail with just the pages subscribed to. - my $diff=`svnlook diff $config{svnrepo} -r $rev --no-diff-deleted`; - - my $subject="$config{wikiname} update of "; - if (@changed_pages > 2) { - $subject.="$changed_pages[0] $changed_pages[1] etc"; - } - else { - $subject.=join(" ", @changed_pages); - } - $subject.=" by $user"; - - my $template=template("notifymail.tmpl"); - $template->param( - wikiname => $config{wikiname}, - diff => $diff, - user => $user, - message => $message, - ); - - eval q{use Mail::Sendmail}; - foreach my $email (@email_recipients) { - sendmail( - To => $email, - From => "$config{wikiname} <$config{adminemail}>", - Subject => $subject, - Message => $template->output, - ) or error("Failed to send update notification mail"); - } - } +sub rcs_diff ($) { #{{{ + my $rev=possibly_foolish_untaint(int(shift)); + return `svnlook diff $config{svnrepo} -r$rev --no-diff-deleted`; } #}}} sub rcs_getctime ($) { #{{{ my $file=shift; - eval q{use Date::Parse}; my $svn_log_infoline=qr/^r\d+\s+\|\s+[^\s]+\s+\|\s+(\d+-\d+-\d+\s+\d+:\d+:\d+\s+[-+]?\d+).*/; @@ -246,6 +245,8 @@ sub rcs_getctime ($) { #{{{ return 0; } + eval q{use Date::Parse}; + error($@) if $@; $date=str2time($date); debug("found ctime ".localtime($date)." for $file"); return $date;