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