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