summaryrefslogtreecommitdiff
path: root/IkiWiki/Plugin/bzr.pm
blob: 783623dee1d841207be58412de21d8a2f24567d6 (plain)
  1. #!/usr/bin/perl
  2. package IkiWiki::Plugin::bzr;
  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 => "bzr", call => \&checkconfig);
  10. hook(type => "getsetup", id => "bzr", 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 (defined $config{bzr_wrapper} && length $config{bzr_wrapper}) {
  24. push @{$config{wrappers}}, {
  25. wrapper => $config{bzr_wrapper},
  26. wrappermode => (defined $config{bzr_wrappermode} ? $config{bzr_wrappermode} : "06755"),
  27. };
  28. }
  29. }
  30. sub getsetup () {
  31. return
  32. plugin => {
  33. safe => 0, # rcs plugin
  34. rebuild => undef,
  35. },
  36. bzr_wrapper => {
  37. type => "string",
  38. #example => "", # FIXME add example
  39. description => "bzr post-commit hook to generate",
  40. safe => 0, # file
  41. rebuild => 0,
  42. },
  43. bzr_wrappermode => {
  44. type => "string",
  45. example => '06755',
  46. description => "mode for bzr_wrapper (can safely be made suid)",
  47. safe => 0,
  48. rebuild => 0,
  49. },
  50. historyurl => {
  51. type => "string",
  52. #example => "", # FIXME add example
  53. description => "url to show file history, using loggerhead ([[file]] substituted)",
  54. safe => 1,
  55. rebuild => 1,
  56. },
  57. diffurl => {
  58. type => "string",
  59. example => "http://example.com/revision?start_revid=[[r2]]#[[file]]-s",
  60. description => "url to view a diff, using loggerhead ([[file]] and [[r2]] substituted)",
  61. safe => 1,
  62. rebuild => 1,
  63. },
  64. }
  65. sub bzr_log ($) {
  66. my $out = shift;
  67. my @infos = ();
  68. my $key = undef;
  69. while (<$out>) {
  70. my $line = $_;
  71. my ($value);
  72. if ($line =~ /^message:/) {
  73. $key = "message";
  74. $infos[$#infos]{$key} = "";
  75. }
  76. elsif ($line =~ /^(modified|added|renamed|renamed and modified|removed):/) {
  77. $key = "files";
  78. unless (defined($infos[$#infos]{$key})) { $infos[$#infos]{$key} = ""; }
  79. }
  80. elsif (defined($key) and $line =~ /^ (.*)/) {
  81. $infos[$#infos]{$key} .= "$1\n";
  82. }
  83. elsif ($line eq "------------------------------------------------------------\n") {
  84. $key = undef;
  85. push (@infos, {});
  86. }
  87. else {
  88. chomp $line;
  89. ($key, $value) = split /: +/, $line, 2;
  90. $infos[$#infos]{$key} = $value;
  91. }
  92. }
  93. close $out;
  94. return @infos;
  95. }
  96. sub rcs_update () {
  97. my @cmdline = ("bzr", "update", "--quiet", $config{srcdir});
  98. if (system(@cmdline) != 0) {
  99. warn "'@cmdline' failed: $!";
  100. }
  101. }
  102. sub rcs_prepedit ($) {
  103. return "";
  104. }
  105. sub bzr_author ($$) {
  106. my ($user, $ipaddr) = @_;
  107. if (defined $user) {
  108. return IkiWiki::possibly_foolish_untaint($user);
  109. }
  110. elsif (defined $ipaddr) {
  111. return "Anonymous from ".IkiWiki::possibly_foolish_untaint($ipaddr);
  112. }
  113. else {
  114. return "Anonymous";
  115. }
  116. }
  117. sub rcs_commit ($$$;$$) {
  118. my ($file, $message, $rcstoken, $user, $ipaddr) = @_;
  119. $user = bzr_author($user, $ipaddr);
  120. $message = IkiWiki::possibly_foolish_untaint($message);
  121. if (! length $message) {
  122. $message = "no message given";
  123. }
  124. my @cmdline = ("bzr", "commit", "--quiet", "-m", $message, "--author", $user,
  125. $config{srcdir}."/".$file);
  126. if (system(@cmdline) != 0) {
  127. warn "'@cmdline' failed: $!";
  128. }
  129. return undef; # success
  130. }
  131. sub rcs_commit_staged ($$$) {
  132. # Commits all staged changes. Changes can be staged using rcs_add,
  133. # rcs_remove, and rcs_rename.
  134. my ($message, $user, $ipaddr)=@_;
  135. $user = bzr_author($user, $ipaddr);
  136. $message = IkiWiki::possibly_foolish_untaint($message);
  137. if (! length $message) {
  138. $message = "no message given";
  139. }
  140. my @cmdline = ("bzr", "commit", "--quiet", "-m", $message, "--author", $user,
  141. $config{srcdir});
  142. if (system(@cmdline) != 0) {
  143. warn "'@cmdline' failed: $!";
  144. }
  145. return undef; # success
  146. }
  147. sub rcs_add ($) {
  148. my ($file) = @_;
  149. my @cmdline = ("bzr", "add", "--quiet", "$config{srcdir}/$file");
  150. if (system(@cmdline) != 0) {
  151. warn "'@cmdline' failed: $!";
  152. }
  153. }
  154. sub rcs_remove ($) {
  155. my ($file) = @_;
  156. my @cmdline = ("bzr", "rm", "--force", "--quiet", "$config{srcdir}/$file");
  157. if (system(@cmdline) != 0) {
  158. warn "'@cmdline' failed: $!";
  159. }
  160. }
  161. sub rcs_rename ($$) {
  162. my ($src, $dest) = @_;
  163. my $parent = IkiWiki::dirname($dest);
  164. if (system("bzr", "add", "--quiet", "$config{srcdir}/$parent") != 0) {
  165. warn("bzr add $parent failed\n");
  166. }
  167. my @cmdline = ("bzr", "mv", "--quiet", "$config{srcdir}/$src", "$config{srcdir}/$dest");
  168. if (system(@cmdline) != 0) {
  169. warn "'@cmdline' failed: $!";
  170. }
  171. }
  172. sub rcs_recentchanges ($) {
  173. my ($num) = @_;
  174. my @cmdline = ("bzr", "log", "-v", "--show-ids", "--limit", $num,
  175. $config{srcdir});
  176. open (my $out, "@cmdline |");
  177. eval q{use Date::Parse};
  178. error($@) if $@;
  179. my @ret;
  180. foreach my $info (bzr_log($out)) {
  181. my @pages = ();
  182. my @message = ();
  183. foreach my $msgline (split(/\n/, $info->{message})) {
  184. push @message, { line => $msgline };
  185. }
  186. foreach my $file (split(/\n/, $info->{files})) {
  187. my ($filename, $fileid) = ($file =~ /^(.*?) +([^ ]+)$/);
  188. # Skip directories
  189. next if ($filename =~ /\/$/);
  190. # Skip source name in renames
  191. $filename =~ s/^.* => //;
  192. my $diffurl = defined $config{'diffurl'} ? $config{'diffurl'} : "";
  193. $diffurl =~ s/\[\[file\]\]/$filename/go;
  194. $diffurl =~ s/\[\[file-id\]\]/$fileid/go;
  195. $diffurl =~ s/\[\[r2\]\]/$info->{revno}/go;
  196. push @pages, {
  197. page => pagename($filename),
  198. diffurl => $diffurl,
  199. };
  200. }
  201. my $user = $info->{"committer"};
  202. if (defined($info->{"author"})) { $user = $info->{"author"}; }
  203. $user =~ s/\s*<.*>\s*$//;
  204. $user =~ s/^\s*//;
  205. push @ret, {
  206. rev => $info->{"revno"},
  207. user => $user,
  208. committype => "bzr",
  209. when => str2time($info->{"timestamp"}),
  210. message => [@message],
  211. pages => [@pages],
  212. };
  213. }
  214. return @ret;
  215. }
  216. sub rcs_diff ($) {
  217. # TODO
  218. }
  219. sub rcs_getctime ($) {
  220. my ($file) = @_;
  221. # XXX filename passes through the shell here, should try to avoid
  222. # that just in case
  223. my @cmdline = ("bzr", "log", "--limit", '1', "$config{srcdir}/$file");
  224. open (my $out, "@cmdline |");
  225. my @log = bzr_log($out);
  226. if (length @log < 1) {
  227. return 0;
  228. }
  229. eval q{use Date::Parse};
  230. error($@) if $@;
  231. my $ctime = str2time($log[0]->{"timestamp"});
  232. return $ctime;
  233. }
  234. 1