X-Git-Url: http://git.vanrenterghem.biz/git.ikiwiki.info.git/blobdiff_plain/12422e98901cef2774b15ec0e6468e88d4d0a6c6..df512e55dfbbb912cdf4aee5db48622301bb29ac:/IkiWiki/Rcs/svn.pm diff --git a/IkiWiki/Rcs/svn.pm b/IkiWiki/Rcs/svn.pm index b45b69197..f7d2242f0 100644 --- a/IkiWiki/Rcs/svn.pm +++ b/IkiWiki/Rcs/svn.pm @@ -1,14 +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_log_infoline=qr/^r(\d+)\s+\|\s+([^\s]+)\s+\|\s+(\d+-\d+-\d+\s+\d+:\d+:\d+\s+[-+]?\d+).*/; -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; @@ -42,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 @@ -58,16 +97,16 @@ 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"); } } - if (system("svn", "commit", "--quiet", "-m", + 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"); @@ -99,160 +138,113 @@ sub rcs_recentchanges ($) { #{{{ my $num=shift; my @ret; - eval q{use CGI 'escapeHTML'}; - eval q{use Date::Parse}; - eval q{use Time::Duration}; - - if (-d "$config{srcdir}/.svn") { - my $svn_url=svn_info("URL", $config{srcdir}); - - my $div=qr/^--------------------+$/; - my $state='start'; - my ($rev, $user, $when, @pages, @message); - foreach (`LANG=C svn log -v '$svn_url'`) { - chomp; - if ($state eq 'start' && /$div/) { - $state='header'; - } - elsif ($state eq 'header' && /$svn_log_infoline/) { - $rev=$1; - $user=$2; - $when=concise(ago(time - str2time($3))); - } - elsif ($state eq 'header' && /^\s+[A-Z]+\s+\/\Q$config{svnpath}\E\/([^ ]+)(?:$|\s)/) { - my $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), - diffurl => $diffurl, - } if length $file; - } - elsif ($state eq 'header' && /^$/) { - $state='body'; - } - elsif ($state eq 'body' && /$div/) { - my $committype="web"; - if (defined $message[0] && - $message[0]->{line}=~/$svn_webcommit/) { - $user="$1"; - $message[0]->{line}=$2; - } - else { - $committype="svn"; - } - - push @ret, { rev => $rev, - user => htmllink("", $user, 1), - committype => $committype, - when => $when, message => [@message], - pages => [@pages], - } if @pages; - return @ret if @ret >= $num; - - $state='header'; - $rev=$user=$when=undef; - @pages=@message=(); - } - elsif ($state eq 'body') { - push @message, {line => escapeHTML($_)}, + return unless -d "$config{srcdir}/.svn"; + + 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 $svn_limit --xml -v log '$svn_url'`, + ForceArray => [ 'logentry', 'path' ], + GroupTags => { paths => 'path' }, + KeyAttr => { path => 'content' }, + ); + foreach my $logentry (@{$xml->{logentry}}) { + my (@pages, @message); + + my $rev = $logentry->{revision}; + my $user = $logentry->{author}; + + my $when=str2time($logentry->{date}, 'UTC'); + + foreach my $msgline (split(/\n/, $logentry->{msg})) { + push @message, { line => $msgline }; + } + + my $committype="web"; + if (defined $message[0] && + $message[0]->{line}=~/$config{web_commit_regexp}/) { + $user=defined $2 ? "$2" : "$3"; + $message[0]->{line}=$4; + } + else { + $committype="svn"; + } + + 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, { + page => pagename($file), + diffurl => $diffurl, + } if length $file; } + push @ret, { + rev => $rev, + user => $user, + committype => $committype, + when => $when, + message => [@message], + pages => [@pages], + } if @pages; + return @ret if @ret >= $num; } 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; - } +sub rcs_getctime ($) { #{{{ + my $file=shift; - 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=HTML::Template->new( - filename => "$config{templatedir}/notifymail.tmpl" - ); - $template->param( - wikiname => $config{wikiname}, - diff => $diff, - user => $user, - message => $message, - ); + my $svn_log_infoline=qr/^r\d+\s+\|\s+[^\s]+\s+\|\s+(\d+-\d+-\d+\s+\d+:\d+:\d+\s+[-+]?\d+).*/; - 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"); - } + my $child = open(SVNLOG, "-|"); + if (! $child) { + exec("svn", "log", $file) || error("svn log $file failed to run"); } -} #}}} - -sub rcs_getctime () { #{{{ - eval q{use Date::Parse}; - foreach my $page (keys %pagectime) { - my $file="$config{srcdir}/$pagesources{$page}"; - next unless -e $file; - my $child = open(SVNLOG, "-|"); - if (! $child) { - exec("svn", "log", $file) || error("svn log $file failed to run"); - } - my $date; - while () { - if (/$svn_log_infoline/) { - $date=$3; - } - } - close SVNLOG || warn "svn log $file exited $?"; + my $date; + while () { + if (/$svn_log_infoline/) { + $date=$1; + } + } + close SVNLOG || warn "svn log $file exited $?"; - if (! defined $date) { - warn "failed to parse svn log for $file\n"; - next; - } - - $pagectime{$page}=$date=str2time($date); - debug("found ctime ".localtime($date)." for $page"); + if (! defined $date) { + warn "failed to parse svn log for $file\n"; + return 0; } + + eval q{use Date::Parse}; + error($@) if $@; + $date=str2time($date); + debug("found ctime ".localtime($date)." for $file"); + return $date; } #}}} 1