summaryrefslogtreecommitdiff
path: root/IkiWiki/Rcs/svn.pm
blob: ea193e08f33418ab7be3f91819fade367dda7092 (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_diff ($) { #{{{
  185. my $rev=possibly_foolish_untaint(int(shift));
  186. return `svnlook diff $config{svnrepo} -r$rev --no-diff-deleted`;
  187. } #}}}
  188. sub rcs_getctime ($) { #{{{
  189. my $file=shift;
  190. my $svn_log_infoline=qr/^r\d+\s+\|\s+[^\s]+\s+\|\s+(\d+-\d+-\d+\s+\d+:\d+:\d+\s+[-+]?\d+).*/;
  191. my $child = open(SVNLOG, "-|");
  192. if (! $child) {
  193. exec("svn", "log", $file) || error("svn log $file failed to run");
  194. }
  195. my $date;
  196. while (<SVNLOG>) {
  197. if (/$svn_log_infoline/) {
  198. $date=$1;
  199. }
  200. }
  201. close SVNLOG || warn "svn log $file exited $?";
  202. if (! defined $date) {
  203. warn "failed to parse svn log for $file\n";
  204. return 0;
  205. }
  206. eval q{use Date::Parse};
  207. error($@) if $@;
  208. $date=str2time($date);
  209. debug("found ctime ".localtime($date)." for $file");
  210. return $date;
  211. } #}}}
  212. 1