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