summaryrefslogtreecommitdiff
path: root/IkiWiki/Rcs/svn.pm
blob: 075f8da5a32daff4ed4794fccb0633115c32f603 (plain)
  1. #!/usr/bin/perl
  2. use warnings;
  3. use strict;
  4. use IkiWiki;
  5. use POSIX qw(setlocale LC_CTYPE);
  6. package IkiWiki::Rcs::svn;
  7. sub import { #{{{
  8. if (exists $IkiWiki::config{svnpath}) {
  9. # code depends on the path not having extraneous slashes
  10. $IkiWiki::config{svnpath}=~tr#/#/#s;
  11. $IkiWiki::config{svnpath}=~s/\/$//;
  12. $IkiWiki::config{svnpath}=~s/^\///;
  13. }
  14. } #}}}
  15. package IkiWiki;
  16. # svn needs LC_CTYPE set to a UTF-8 locale, so try to find one. Any will do.
  17. sub find_lc_ctype() {
  18. my $current = setlocale(LC_CTYPE());
  19. return $current if $current =~ m/UTF-?8$/i;
  20. # Make some obvious attempts to avoid calling `locale -a`
  21. foreach my $locale ("$current.UTF-8", "en_US.UTF-8", "en_GB.UTF-8") {
  22. return $locale if setlocale(LC_CTYPE(), $locale);
  23. }
  24. # Try to get all available locales and pick the first UTF-8 one found.
  25. if (my @locale = grep(/UTF-?8$/i, `locale -a`)) {
  26. chomp @locale;
  27. return $locale[0] if setlocale(LC_CTYPE(), $locale[0]);
  28. }
  29. # fallback to the current locale
  30. return $current;
  31. } # }}}
  32. $ENV{LC_CTYPE} = $ENV{LC_CTYPE} || find_lc_ctype();
  33. sub svn_info ($$) { #{{{
  34. my $field=shift;
  35. my $file=shift;
  36. my $info=`LANG=C svn info $file`;
  37. my ($ret)=$info=~/^$field: (.*)$/m;
  38. return $ret;
  39. } #}}}
  40. sub rcs_update () { #{{{
  41. if (-d "$config{srcdir}/.svn") {
  42. if (system("svn", "update", "--quiet", $config{srcdir}) != 0) {
  43. warn("svn update failed\n");
  44. }
  45. }
  46. } #}}}
  47. sub rcs_prepedit ($) { #{{{
  48. # Prepares to edit a file under revision control. Returns a token
  49. # that must be passed into rcs_commit when the file is ready
  50. # for committing.
  51. # The file is relative to the srcdir.
  52. my $file=shift;
  53. if (-d "$config{srcdir}/.svn") {
  54. # For subversion, return the revision of the file when
  55. # editing begins.
  56. my $rev=svn_info("Revision", "$config{srcdir}/$file");
  57. return defined $rev ? $rev : "";
  58. }
  59. } #}}}
  60. sub rcs_commit ($$$;$$) { #{{{
  61. # Tries to commit the page; returns undef on _success_ and
  62. # a version of the page with the rcs's conflict markers on failure.
  63. # The file is relative to the srcdir.
  64. my $file=shift;
  65. my $message=shift;
  66. my $rcstoken=shift;
  67. my $user=shift;
  68. my $ipaddr=shift;
  69. if (defined $user) {
  70. $message="web commit by $user".(length $message ? ": $message" : "");
  71. }
  72. elsif (defined $ipaddr) {
  73. $message="web commit from $ipaddr".(length $message ? ": $message" : "");
  74. }
  75. if (-d "$config{srcdir}/.svn") {
  76. # Check to see if the page has been changed by someone
  77. # else since rcs_prepedit was called.
  78. my ($oldrev)=$rcstoken=~/^([0-9]+)$/; # untaint
  79. my $rev=svn_info("Revision", "$config{srcdir}/$file");
  80. if (defined $rev && defined $oldrev && $rev != $oldrev) {
  81. # Merge their changes into the file that we've
  82. # changed.
  83. if (system("svn", "merge", "--quiet", "-r$oldrev:$rev",
  84. "$config{srcdir}/$file", "$config{srcdir}/$file") != 0) {
  85. warn("svn merge -r$oldrev:$rev failed\n");
  86. }
  87. }
  88. if (system("svn", "commit", "--quiet",
  89. "--encoding", "UTF-8", "-m",
  90. possibly_foolish_untaint($message),
  91. $config{srcdir}) != 0) {
  92. my $conflict=readfile("$config{srcdir}/$file");
  93. if (system("svn", "revert", "--quiet", "$config{srcdir}/$file") != 0) {
  94. warn("svn revert failed\n");
  95. }
  96. return $conflict;
  97. }
  98. }
  99. return undef # success
  100. } #}}}
  101. sub rcs_add ($) { #{{{
  102. # filename is relative to the root of the srcdir
  103. my $file=shift;
  104. if (-d "$config{srcdir}/.svn") {
  105. my $parent=dirname($file);
  106. while (! -d "$config{srcdir}/$parent/.svn") {
  107. $file=$parent;
  108. $parent=dirname($file);
  109. }
  110. if (system("svn", "add", "--quiet", "$config{srcdir}/$file") != 0) {
  111. warn("svn add failed\n");
  112. }
  113. }
  114. } #}}}
  115. sub rcs_recentchanges ($) { #{{{
  116. my $num=shift;
  117. my @ret;
  118. return unless -d "$config{srcdir}/.svn";
  119. eval q{
  120. use Date::Parse;
  121. use XML::SAX;
  122. use XML::Simple;
  123. };
  124. error($@) if $@;
  125. # avoid using XML::SAX::PurePerl, it's buggy with UTF-8 data
  126. my @parsers = map { ${$_}{Name} } @{XML::SAX->parsers()};
  127. do {
  128. $XML::Simple::PREFERRED_PARSER = pop @parsers;
  129. } until $XML::Simple::PREFERRED_PARSER ne 'XML::SAX::PurePerl';
  130. # --limit is only supported on Subversion 1.2.0+
  131. my $svn_version=`svn --version -q`;
  132. my $svn_limit='';
  133. $svn_limit="--limit $num"
  134. if $svn_version =~ /\d\.(\d)\.\d/ && $1 >= 2;
  135. my $svn_url=svn_info("URL", $config{srcdir});
  136. my $xml = XMLin(scalar `svn $svn_limit --xml -v log '$svn_url'`,
  137. ForceArray => [ 'logentry', 'path' ],
  138. GroupTags => { paths => 'path' },
  139. KeyAttr => { path => 'content' },
  140. );
  141. foreach my $logentry (@{$xml->{logentry}}) {
  142. my (@pages, @message);
  143. my $rev = $logentry->{revision};
  144. my $user = $logentry->{author};
  145. my $when=str2time($logentry->{date}, 'UTC');
  146. foreach my $msgline (split(/\n/, $logentry->{msg})) {
  147. push @message, { line => $msgline };
  148. }
  149. my $committype="web";
  150. if (defined $message[0] &&
  151. $message[0]->{line}=~/$config{web_commit_regexp}/) {
  152. $user=defined $2 ? "$2" : "$3";
  153. $message[0]->{line}=$4;
  154. }
  155. else {
  156. $committype="svn";
  157. }
  158. foreach my $file (keys %{$logentry->{paths}}) {
  159. if (length $config{svnpath}) {
  160. next unless $file=~/^\/\Q$config{svnpath}\E\/([^ ]+)(?:$|\s)/;
  161. $file=$1;
  162. }
  163. my $diffurl=$config{diffurl};
  164. $diffurl=~s/\[\[file\]\]/$file/g;
  165. $diffurl=~s/\[\[r1\]\]/$rev - 1/eg;
  166. $diffurl=~s/\[\[r2\]\]/$rev/g;
  167. push @pages, {
  168. page => pagename($file),
  169. diffurl => $diffurl,
  170. } if length $file;
  171. }
  172. push @ret, {
  173. rev => $rev,
  174. user => $user,
  175. committype => $committype,
  176. when => $when,
  177. message => [@message],
  178. pages => [@pages],
  179. } if @pages;
  180. return @ret if @ret >= $num;
  181. }
  182. return @ret;
  183. } #}}}
  184. sub rcs_notify () { #{{{
  185. if (! exists $ENV{REV}) {
  186. error(gettext("REV is not set, not running from svn post-commit hook, cannot send notifications"));
  187. }
  188. my $rev=int(possibly_foolish_untaint($ENV{REV}));
  189. my $user=`svnlook author $config{svnrepo} -r $rev`;
  190. chomp $user;
  191. my $message=`svnlook log $config{svnrepo} -r $rev`;
  192. if ($message=~/$config{web_commit_regexp}/) {
  193. $user=defined $2 ? "$2" : "$3";
  194. $message=$4;
  195. }
  196. my @changed_pages;
  197. foreach my $change (`svnlook changed $config{svnrepo} -r $rev`) {
  198. chomp $change;
  199. if (length $config{svnpath}) {
  200. if ($change =~ /^[A-Z]+\s+\Q$config{svnpath}\E\/(.*)/) {
  201. push @changed_pages, $1;
  202. }
  203. }
  204. else {
  205. push @changed_pages, $change;
  206. }
  207. }
  208. require IkiWiki::UserInfo;
  209. send_commit_mails(
  210. sub {
  211. return $message;
  212. },
  213. sub {
  214. `svnlook diff $config{svnrepo} -r $rev --no-diff-deleted`;
  215. }, $user, @changed_pages);
  216. } #}}}
  217. sub rcs_getctime ($) { #{{{
  218. my $file=shift;
  219. my $svn_log_infoline=qr/^r\d+\s+\|\s+[^\s]+\s+\|\s+(\d+-\d+-\d+\s+\d+:\d+:\d+\s+[-+]?\d+).*/;
  220. my $child = open(SVNLOG, "-|");
  221. if (! $child) {
  222. exec("svn", "log", $file) || error("svn log $file failed to run");
  223. }
  224. my $date;
  225. while (<SVNLOG>) {
  226. if (/$svn_log_infoline/) {
  227. $date=$1;
  228. }
  229. }
  230. close SVNLOG || warn "svn log $file exited $?";
  231. if (! defined $date) {
  232. warn "failed to parse svn log for $file\n";
  233. return 0;
  234. }
  235. eval q{use Date::Parse};
  236. error($@) if $@;
  237. $date=str2time($date);
  238. debug("found ctime ".localtime($date)." for $file");
  239. return $date;
  240. } #}}}
  241. 1