summaryrefslogtreecommitdiff
path: root/IkiWiki/Plugin/mercurial.pm
blob: 34e009c7a659a343f409adf4a1da1f379e469be6 (plain)
  1. #!/usr/bin/perl
  2. package IkiWiki::Plugin::mercurial;
  3. use warnings;
  4. use strict;
  5. use IkiWiki;
  6. use Encode;
  7. use open qw{:utf8 :std};
  8. sub import {
  9. hook(type => "checkconfig", id => "mercurial", call => \&checkconfig);
  10. hook(type => "getsetup", id => "mercurial", call => \&getsetup);
  11. hook(type => "rcs", id => "rcs_update", call => \&rcs_update);
  12. hook(type => "rcs", id => "rcs_prepedit", call => \&rcs_prepedit);
  13. hook(type => "rcs", id => "rcs_commit", call => \&rcs_commit);
  14. hook(type => "rcs", id => "rcs_commit_staged", call => \&rcs_commit_staged);
  15. hook(type => "rcs", id => "rcs_add", call => \&rcs_add);
  16. hook(type => "rcs", id => "rcs_remove", call => \&rcs_remove);
  17. hook(type => "rcs", id => "rcs_rename", call => \&rcs_rename);
  18. hook(type => "rcs", id => "rcs_recentchanges", call => \&rcs_recentchanges);
  19. hook(type => "rcs", id => "rcs_diff", call => \&rcs_diff);
  20. hook(type => "rcs", id => "rcs_getctime", call => \&rcs_getctime);
  21. hook(type => "rcs", id => "rcs_getmtime", call => \&rcs_getmtime);
  22. }
  23. sub checkconfig () {
  24. if (exists $config{mercurial_wrapper} && length $config{mercurial_wrapper}) {
  25. push @{$config{wrappers}}, {
  26. wrapper => $config{mercurial_wrapper},
  27. wrappermode => (defined $config{mercurial_wrappermode} ? $config{mercurial_wrappermode} : "06755"),
  28. };
  29. }
  30. }
  31. sub getsetup () {
  32. return
  33. plugin => {
  34. safe => 0, # rcs plugin
  35. rebuild => undef,
  36. section => "rcs",
  37. },
  38. mercurial_wrapper => {
  39. type => "string",
  40. #example => # FIXME add example
  41. description => "mercurial post-commit hook to generate",
  42. safe => 0, # file
  43. rebuild => 0,
  44. },
  45. mercurial_wrappermode => {
  46. type => "string",
  47. example => '06755',
  48. description => "mode for mercurial_wrapper (can safely be made suid)",
  49. safe => 0,
  50. rebuild => 0,
  51. },
  52. historyurl => {
  53. type => "string",
  54. example => "http://example.com:8000/log/tip/[[file]]",
  55. description => "url to hg serve'd repository, to show file history ([[file]] substituted)",
  56. safe => 1,
  57. rebuild => 1,
  58. },
  59. diffurl => {
  60. type => "string",
  61. example => "http://localhost:8000/?fd=[[r2]];file=[[file]]",
  62. description => "url to hg serve'd repository, to show diff ([[file]] and [[r2]] substituted)",
  63. safe => 1,
  64. rebuild => 1,
  65. },
  66. }
  67. sub mercurial_log ($) {
  68. my $out = shift;
  69. my @infos;
  70. while (<$out>) {
  71. my $line = $_;
  72. my ($key, $value);
  73. if (/^description:/) {
  74. $key = "description";
  75. $value = "";
  76. # slurp everything as the description text
  77. # until the next changeset
  78. while (<$out>) {
  79. if (/^changeset: /) {
  80. $line = $_;
  81. last;
  82. }
  83. $value .= $_;
  84. }
  85. local $/ = "";
  86. chomp $value;
  87. $infos[$#infos]{$key} = $value;
  88. }
  89. chomp $line;
  90. ($key, $value) = split /: +/, $line, 2;
  91. if ($key eq "changeset") {
  92. push @infos, {};
  93. # remove the revision index, which is strictly
  94. # local to the repository
  95. $value =~ s/^\d+://;
  96. }
  97. $infos[$#infos]{$key} = $value;
  98. }
  99. close $out;
  100. return @infos;
  101. }
  102. sub rcs_update () {
  103. my @cmdline = ("hg", "-q", "-R", "$config{srcdir}", "update");
  104. if (system(@cmdline) != 0) {
  105. warn "'@cmdline' failed: $!";
  106. }
  107. }
  108. sub rcs_prepedit ($) {
  109. return "";
  110. }
  111. sub rcs_commit ($$$;$$) {
  112. my ($file, $message, $rcstoken, $user, $ipaddr) = @_;
  113. if (defined $user) {
  114. $user = IkiWiki::possibly_foolish_untaint($user);
  115. }
  116. elsif (defined $ipaddr) {
  117. $user = "Anonymous from ".IkiWiki::possibly_foolish_untaint($ipaddr);
  118. }
  119. else {
  120. $user = "Anonymous";
  121. }
  122. $message = IkiWiki::possibly_foolish_untaint($message);
  123. if (! length $message) {
  124. $message = "no message given";
  125. }
  126. my @cmdline = ("hg", "-q", "-R", $config{srcdir}, "commit",
  127. "-m", $message, "-u", $user);
  128. if (system(@cmdline) != 0) {
  129. warn "'@cmdline' failed: $!";
  130. }
  131. return undef; # success
  132. }
  133. sub rcs_commit_staged ($$$) {
  134. # Commits all staged changes. Changes can be staged using rcs_add,
  135. # rcs_remove, and rcs_rename.
  136. my ($message, $user, $ipaddr)=@_;
  137. error("rcs_commit_staged not implemented for mercurial"); # TODO
  138. }
  139. sub rcs_add ($) {
  140. my ($file) = @_;
  141. my @cmdline = ("hg", "-q", "-R", "$config{srcdir}", "add", "$config{srcdir}/$file");
  142. if (system(@cmdline) != 0) {
  143. warn "'@cmdline' failed: $!";
  144. }
  145. }
  146. sub rcs_remove ($) {
  147. my ($file) = @_;
  148. error("rcs_remove not implemented for mercurial"); # TODO
  149. }
  150. sub rcs_rename ($$) {
  151. my ($src, $dest) = @_;
  152. error("rcs_rename not implemented for mercurial"); # TODO
  153. }
  154. sub rcs_recentchanges ($) {
  155. my ($num) = @_;
  156. my @cmdline = ("hg", "-R", $config{srcdir}, "log", "-v", "-l", $num,
  157. "--style", "default");
  158. open (my $out, "@cmdline |");
  159. eval q{use Date::Parse};
  160. error($@) if $@;
  161. my @ret;
  162. foreach my $info (mercurial_log($out)) {
  163. my @pages = ();
  164. my @message = ();
  165. foreach my $msgline (split(/\n/, $info->{description})) {
  166. push @message, { line => $msgline };
  167. }
  168. foreach my $file (split / /,$info->{files}) {
  169. my $diffurl = defined $config{diffurl} ? $config{'diffurl'} : "";
  170. $diffurl =~ s/\[\[file\]\]/$file/go;
  171. $diffurl =~ s/\[\[r2\]\]/$info->{changeset}/go;
  172. push @pages, {
  173. page => pagename($file),
  174. diffurl => $diffurl,
  175. };
  176. }
  177. my $user = $info->{"user"};
  178. $user =~ s/\s*<.*>\s*$//;
  179. $user =~ s/^\s*//;
  180. push @ret, {
  181. rev => $info->{"changeset"},
  182. user => $user,
  183. committype => "hg",
  184. when => str2time($info->{"date"}),
  185. message => [@message],
  186. pages => [@pages],
  187. };
  188. }
  189. return @ret;
  190. }
  191. sub rcs_diff ($) {
  192. # TODO
  193. }
  194. sub rcs_getctime ($) {
  195. my ($file) = @_;
  196. # XXX filename passes through the shell here, should try to avoid
  197. # that just in case
  198. my @cmdline = ("hg", "-R", $config{srcdir}, "log", "-v",
  199. "--style", "default", "$config{srcdir}/$file");
  200. open (my $out, "@cmdline |");
  201. my @log = mercurial_log($out);
  202. if (length @log < 1) {
  203. return 0;
  204. }
  205. eval q{use Date::Parse};
  206. error($@) if $@;
  207. my $ctime = str2time($log[$#log]->{"date"});
  208. return $ctime;
  209. }
  210. sub rcs_getmtime ($) {
  211. error "rcs_getmtime is not implemented for mercurial\n"; # TODO
  212. }
  213. 1