summaryrefslogtreecommitdiff
path: root/IkiWiki/Rcs/SVN.pm
blob: c6f8f2ab1c53fddef977507f68f985a158eb48c6 (plain)
  1. #!/usr/bin/perl
  2. # For subversion support.
  3. use warnings;
  4. use strict;
  5. package IkiWiki;
  6. my $svn_log_infoline=qr/^r(\d+)\s+\|\s+([^\s]+)\s+\|\s+(\d+-\d+-\d+\s+\d+:\d+:\d+\s+[-+]?\d+).*/;
  7. sub svn_info ($$) { #{{{
  8. my $field=shift;
  9. my $file=shift;
  10. my $info=`LANG=C svn info $file`;
  11. my ($ret)=$info=~/^$field: (.*)$/m;
  12. return $ret;
  13. } #}}}
  14. sub rcs_update () { #{{{
  15. if (-d "$config{srcdir}/.svn") {
  16. if (system("svn", "update", "--quiet", $config{srcdir}) != 0) {
  17. warn("svn update failed\n");
  18. }
  19. }
  20. } #}}}
  21. sub rcs_prepedit ($) { #{{{
  22. # Prepares to edit a file under revision control. Returns a token
  23. # that must be passed into rcs_commit when the file is ready
  24. # for committing.
  25. # The file is relative to the srcdir.
  26. my $file=shift;
  27. if (-d "$config{srcdir}/.svn") {
  28. # For subversion, return the revision of the file when
  29. # editing begins.
  30. my $rev=svn_info("Revision", "$config{srcdir}/$file");
  31. return defined $rev ? $rev : "";
  32. }
  33. } #}}}
  34. sub rcs_commit ($$$) { #{{{
  35. # Tries to commit the page; returns undef on _success_ and
  36. # a version of the page with the rcs's conflict markers on failure.
  37. # The file is relative to the srcdir.
  38. my $file=shift;
  39. my $message=shift;
  40. my $rcstoken=shift;
  41. if (-d "$config{srcdir}/.svn") {
  42. # Check to see if the page has been changed by someone
  43. # else since rcs_prepedit was called.
  44. my ($oldrev)=$rcstoken=~/^([0-9]+)$/; # untaint
  45. my $rev=svn_info("Revision", "$config{srcdir}/$file");
  46. if (defined $rev && defined $oldrev && $rev != $oldrev) {
  47. # Merge their changes into the file that we've
  48. # changed.
  49. chdir($config{srcdir}); # svn merge wants to be here
  50. if (system("svn", "merge", "--quiet", "-r$oldrev:$rev",
  51. "$config{srcdir}/$file") != 0) {
  52. warn("svn merge -r$oldrev:$rev failed\n");
  53. }
  54. }
  55. if (system("svn", "commit", "--quiet", "-m",
  56. possibly_foolish_untaint($message),
  57. "$config{srcdir}") != 0) {
  58. my $conflict=readfile("$config{srcdir}/$file");
  59. if (system("svn", "revert", "--quiet", "$config{srcdir}/$file") != 0) {
  60. warn("svn revert failed\n");
  61. }
  62. return $conflict;
  63. }
  64. }
  65. return undef # success
  66. } #}}}
  67. sub rcs_add ($) { #{{{
  68. # filename is relative to the root of the srcdir
  69. my $file=shift;
  70. if (-d "$config{srcdir}/.svn") {
  71. my $parent=dirname($file);
  72. while (! -d "$config{srcdir}/$parent/.svn") {
  73. $file=$parent;
  74. $parent=dirname($file);
  75. }
  76. if (system("svn", "add", "--quiet", "$config{srcdir}/$file") != 0) {
  77. warn("svn add failed\n");
  78. }
  79. }
  80. } #}}}
  81. sub rcs_recentchanges ($) { #{{{
  82. my $num=shift;
  83. my @ret;
  84. eval q{use CGI 'escapeHTML'};
  85. eval q{use Date::Parse};
  86. eval q{use Time::Duration};
  87. if (-d "$config{srcdir}/.svn") {
  88. my $svn_url=svn_info("URL", $config{srcdir});
  89. # FIXME: currently assumes that the wiki is somewhere
  90. # under trunk in svn, doesn't support other layouts.
  91. my ($svn_base)=$svn_url=~m!(/trunk(?:/.*)?)$!;
  92. my $div=qr/^--------------------+$/;
  93. my $state='start';
  94. my ($rev, $user, $when, @pages, @message);
  95. foreach (`LANG=C svn log -v '$svn_url'`) {
  96. chomp;
  97. if ($state eq 'start' && /$div/) {
  98. $state='header';
  99. }
  100. elsif ($state eq 'header' && /$svn_log_infoline/) {
  101. $rev=$1;
  102. $user=$2;
  103. $when=concise(ago(time - str2time($3)));
  104. }
  105. elsif ($state eq 'header' && /^\s+[A-Z]\s+\Q$svn_base\E\/([^ ]+)(?:$|\s)/) {
  106. my $file=$1;
  107. my $diffurl=$config{diffurl};
  108. $diffurl=~s/\[\[file\]\]/$file/g;
  109. $diffurl=~s/\[\[r1\]\]/$rev - 1/eg;
  110. $diffurl=~s/\[\[r2\]\]/$rev/g;
  111. push @pages, {
  112. link => htmllink("", pagename($file), 1),
  113. diffurl => $diffurl,
  114. } if length $file;
  115. }
  116. elsif ($state eq 'header' && /^$/) {
  117. $state='body';
  118. }
  119. elsif ($state eq 'body' && /$div/) {
  120. my $committype="web";
  121. if (defined $message[0] &&
  122. $message[0]->{line}=~/^web commit by (\w+):?(.*)/) {
  123. $user="$1";
  124. $message[0]->{line}=$2;
  125. }
  126. else {
  127. $committype="svn";
  128. }
  129. push @ret, { rev => $rev,
  130. user => htmllink("", $user, 1),
  131. committype => $committype,
  132. when => $when, message => [@message],
  133. pages => [@pages],
  134. } if @pages;
  135. return @ret if @ret >= $num;
  136. $state='header';
  137. $rev=$user=$when=undef;
  138. @pages=@message=();
  139. }
  140. elsif ($state eq 'body') {
  141. push @message, {line => escapeHTML($_)},
  142. }
  143. }
  144. }
  145. return @ret;
  146. } #}}}
  147. sub rcs_getctime () { #{{{
  148. eval q{use Date::Parse};
  149. foreach my $page (keys %pagectime) {
  150. my $file="$config{srcdir}/$pagesources{$page}";
  151. next unless -e $file;
  152. my $child = open(SVNLOG, "-|");
  153. if (! $child) {
  154. exec("svn", "log", $file) || error("svn log $file failed to run");
  155. }
  156. my $date;
  157. while (<SVNLOG>) {
  158. if (/$svn_log_infoline/) {
  159. $date=$3;
  160. }
  161. }
  162. close SVNLOG || warn "svn log $file exited $?";
  163. if (! defined $date) {
  164. warn "failed to parse svn log for $file\n";
  165. next;
  166. }
  167. $pagectime{$page}=$date=str2time($date);
  168. debug("found ctime ".localtime($date)." for $page");
  169. }
  170. } #}}}
  171. 1