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