summaryrefslogtreecommitdiff
path: root/IkiWiki/Plugin/bzr.pm
blob: 562d5d3893fcf5c2c0c6ba0b82e574c362f36891 (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 $session=shift;
  118. return unless defined $session;
  119. my $user=$session->param("name");
  120. my $ipaddr=$session->remote_addr();
  121. if (defined $user) {
  122. return IkiWiki::possibly_foolish_untaint($user);
  123. }
  124. elsif (defined $ipaddr) {
  125. return "Anonymous from ".IkiWiki::possibly_foolish_untaint($ipaddr);
  126. }
  127. else {
  128. return "Anonymous";
  129. }
  130. }
  131. sub rcs_commit (@) {
  132. my %params=@_;
  133. my $user=bzr_author($params{session});
  134. $params{message} = IkiWiki::possibly_foolish_untaint($params{message});
  135. if (! length $params{message}) {
  136. $params{message} = "no message given";
  137. }
  138. my @cmdline = ("bzr", "commit", "--quiet", "-m", $params{message},
  139. (defined $user ? ("--author", $user) : ()),
  140. $config{srcdir}."/".$params{file});
  141. if (system(@cmdline) != 0) {
  142. warn "'@cmdline' failed: $!";
  143. }
  144. return undef; # success
  145. }
  146. sub rcs_commit_staged (@) {
  147. my %params=@_;
  148. my $user=bzr_author($params{session});
  149. $params{message} = IkiWiki::possibly_foolish_untaint($params{message});
  150. if (! length $params{message}) {
  151. $params{message} = "no message given";
  152. }
  153. my @cmdline = ("bzr", "commit", "--quiet", "-m", $params{message},
  154. (defined $user ? ("--author", $user) : ()),
  155. $config{srcdir});
  156. if (system(@cmdline) != 0) {
  157. warn "'@cmdline' failed: $!";
  158. }
  159. return undef; # success
  160. }
  161. sub rcs_add ($) {
  162. my ($file) = @_;
  163. my @cmdline = ("bzr", "add", "--quiet", "$config{srcdir}/$file");
  164. if (system(@cmdline) != 0) {
  165. warn "'@cmdline' failed: $!";
  166. }
  167. }
  168. sub rcs_remove ($) {
  169. my ($file) = @_;
  170. my @cmdline = ("bzr", "rm", "--force", "--quiet", "$config{srcdir}/$file");
  171. if (system(@cmdline) != 0) {
  172. warn "'@cmdline' failed: $!";
  173. }
  174. }
  175. sub rcs_rename ($$) {
  176. my ($src, $dest) = @_;
  177. my $parent = IkiWiki::dirname($dest);
  178. if (system("bzr", "add", "--quiet", "$config{srcdir}/$parent") != 0) {
  179. warn("bzr add $parent failed\n");
  180. }
  181. my @cmdline = ("bzr", "mv", "--quiet", "$config{srcdir}/$src", "$config{srcdir}/$dest");
  182. if (system(@cmdline) != 0) {
  183. warn "'@cmdline' failed: $!";
  184. }
  185. }
  186. sub rcs_recentchanges ($) {
  187. my ($num) = @_;
  188. my @cmdline = ("bzr", "log", "-v", "--show-ids", "--limit", $num,
  189. $config{srcdir});
  190. open (my $out, "@cmdline |");
  191. eval q{use Date::Parse};
  192. error($@) if $@;
  193. my @ret;
  194. foreach my $info (bzr_log($out)) {
  195. my @pages = ();
  196. my @message = ();
  197. foreach my $msgline (split(/\n/, $info->{message})) {
  198. push @message, { line => $msgline };
  199. }
  200. foreach my $file (split(/\n/, $info->{files})) {
  201. my ($filename, $fileid) = ($file =~ /^(.*?) +([^ ]+)$/);
  202. # Skip directories
  203. next if ($filename =~ /\/$/);
  204. # Skip source name in renames
  205. $filename =~ s/^.* => //;
  206. my $diffurl = defined $config{'diffurl'} ? $config{'diffurl'} : "";
  207. $diffurl =~ s/\[\[file\]\]/$filename/go;
  208. $diffurl =~ s/\[\[file-id\]\]/$fileid/go;
  209. $diffurl =~ s/\[\[r2\]\]/$info->{revno}/go;
  210. push @pages, {
  211. page => pagename($filename),
  212. diffurl => $diffurl,
  213. };
  214. }
  215. my $user = $info->{"committer"};
  216. if (defined($info->{"author"})) { $user = $info->{"author"}; }
  217. $user =~ s/\s*<.*>\s*$//;
  218. $user =~ s/^\s*//;
  219. push @ret, {
  220. rev => $info->{"revno"},
  221. user => $user,
  222. committype => "bzr",
  223. when => str2time($info->{"timestamp"}),
  224. message => [@message],
  225. pages => [@pages],
  226. };
  227. }
  228. return @ret;
  229. }
  230. sub rcs_diff ($) {
  231. my $taintedrev=shift;
  232. my ($rev) = $taintedrev =~ /^(\d+(\.\d+)*)$/; # untaint
  233. my $prevspec = "before:" . $rev;
  234. my $revspec = "revno:" . $rev;
  235. my @cmdline = ("bzr", "diff", "--old", $config{srcdir},
  236. "--new", $config{srcdir},
  237. "-r", $prevspec . ".." . $revspec);
  238. open (my $out, "@cmdline |");
  239. my @lines = <$out>;
  240. if (wantarray) {
  241. return @lines;
  242. }
  243. else {
  244. return join("", @lines);
  245. }
  246. }
  247. sub extract_timestamp (@) {
  248. open (my $out, "-|", @_);
  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 $time = str2time($log[0]->{"timestamp"});
  256. return $time;
  257. }
  258. sub rcs_getctime ($) {
  259. my ($file) = @_;
  260. my @cmdline = ("bzr", "log", "--forward", "--limit", '1', "$config{srcdir}/$file");
  261. return extract_timestamp(@cmdline);
  262. }
  263. sub rcs_getmtime ($) {
  264. my ($file) = @_;
  265. my @cmdline = ("bzr", "log", "--limit", '1', "$config{srcdir}/$file");
  266. return extract_timestamp(@cmdline);
  267. }
  268. 1