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