summaryrefslogtreecommitdiff
path: root/IkiWiki/Plugin/darcs.pm
blob: cd4fcd0fff438b250e7dd059d0e8eaa05be95bcf (plain)
  1. #!/usr/bin/perl
  2. package IkiWiki::Plugin::darcs;
  3. use warnings;
  4. use strict;
  5. use IkiWiki;
  6. sub import {
  7. hook(type => "checkconfig", id => "darcs", call => \&checkconfig);
  8. hook(type => "getsetup", id => "darcs", call => \&getsetup);
  9. hook(type => "rcs", id => "rcs_update", call => \&rcs_update);
  10. hook(type => "rcs", id => "rcs_prepedit", call => \&rcs_prepedit);
  11. hook(type => "rcs", id => "rcs_commit", call => \&rcs_commit);
  12. hook(type => "rcs", id => "rcs_commit_staged", call => \&rcs_commit_staged);
  13. hook(type => "rcs", id => "rcs_add", call => \&rcs_add);
  14. hook(type => "rcs", id => "rcs_remove", call => \&rcs_remove);
  15. hook(type => "rcs", id => "rcs_rename", call => \&rcs_rename);
  16. hook(type => "rcs", id => "rcs_recentchanges", call => \&rcs_recentchanges);
  17. hook(type => "rcs", id => "rcs_diff", call => \&rcs_diff);
  18. hook(type => "rcs", id => "rcs_getctime", call => \&rcs_getctime);
  19. hook(type => "rcs", id => "rcs_getmtime", call => \&rcs_getmtime);
  20. }
  21. sub silentsystem (@) {
  22. open(SAVED_STDOUT, ">&STDOUT");
  23. open(STDOUT, ">/dev/null");
  24. my $ret = system @_;
  25. open(STDOUT, ">&SAVED_STDOUT");
  26. return $ret;
  27. }
  28. sub darcs_info ($$$) {
  29. my $field = shift;
  30. my $repodir = shift;
  31. my $file = shift; # Relative to the repodir.
  32. my $child = open(DARCS_CHANGES, "-|");
  33. if (! $child) {
  34. exec('darcs', 'changes', '--repodir', $repodir, '--xml-output', $file) or
  35. error("failed to run 'darcs changes'");
  36. }
  37. # Brute force for now. :-/
  38. while (<DARCS_CHANGES>) {
  39. last if /^<\/created_as>$/;
  40. }
  41. ($_) = <DARCS_CHANGES> =~ /$field=\'([^\']+)/;
  42. $field eq 'hash' and s/\.gz//; # Strip away the '.gz' from 'hash'es.
  43. close(DARCS_CHANGES);
  44. return $_;
  45. }
  46. sub file_in_vc ($$) {
  47. my $repodir = shift;
  48. my $file = shift;
  49. my $child = open(DARCS_MANIFEST, "-|");
  50. if (! $child) {
  51. exec('darcs', 'query', 'manifest', '--repodir', $repodir) or
  52. error("failed to run 'darcs query manifest'");
  53. }
  54. my $found=0;
  55. while (<DARCS_MANIFEST>) {
  56. $found = 1 if /^(\.\/)?$file$/;
  57. }
  58. close(DARCS_MANIFEST) or error("'darcs query manifest' exited " . $?);
  59. return $found;
  60. }
  61. sub darcs_rev ($) {
  62. my $file = shift; # Relative to the repodir.
  63. my $repodir = $config{srcdir};
  64. return "" unless file_in_vc($repodir, $file);
  65. my $hash = darcs_info('hash', $repodir, $file);
  66. return defined $hash ? $hash : "";
  67. }
  68. sub checkconfig () {
  69. if (defined $config{darcs_wrapper} && length $config{darcs_wrapper}) {
  70. push @{$config{wrappers}}, {
  71. wrapper => $config{darcs_wrapper},
  72. wrappermode => (defined $config{darcs_wrappermode} ? $config{darcs_wrappermode} : "06755"),
  73. };
  74. }
  75. }
  76. sub getsetup () {
  77. return
  78. plugin => {
  79. safe => 0, # rcs plugin
  80. rebuild => undef,
  81. section => "rcs",
  82. },
  83. darcs_wrapper => {
  84. type => "string",
  85. example => "/darcs/repo/_darcs/ikiwiki-wrapper",
  86. description => "wrapper to generate (set as master repo apply hook)",
  87. safe => 0, # file
  88. rebuild => 0,
  89. },
  90. darcs_wrappermode => {
  91. type => "string",
  92. example => '06755',
  93. description => "mode for darcs_wrapper (can safely be made suid)",
  94. safe => 0,
  95. rebuild => 0,
  96. },
  97. historyurl => {
  98. type => "string",
  99. example => "http://darcs.example.com/darcsweb.cgi?r=wiki;a=filehistory;f=[[file]]",
  100. description => "darcsweb url to show file history ([[file]] substituted)",
  101. safe => 1,
  102. rebuild => 1,
  103. },
  104. diffurl => {
  105. type => "string",
  106. example => "http://darcs.example.com/darcsweb.cgi?r=wiki;a=filediff;h=[[hash]];f=[[file]]",
  107. description => "darcsweb url to show a diff ([[hash]] and [[file]] substituted)",
  108. safe => 1,
  109. rebuild => 1,
  110. },
  111. }
  112. sub rcs_update () {
  113. silentsystem('darcs', "pull", "--repodir", $config{srcdir}, "-qa")
  114. }
  115. sub rcs_prepedit ($) {
  116. # Prepares to edit a file under revision control. Returns a token that
  117. # must be passed to rcs_commit() when the file is to be commited. For us,
  118. # this token the hash value of the latest patch that modifies the file,
  119. # i.e. something like its current revision.
  120. my $file = shift; # Relative to the repodir.
  121. my $rev = darcs_rev($file);
  122. return $rev;
  123. }
  124. sub commitauthor (@) {
  125. my %params=@_;
  126. my $author="anon\@web";
  127. if (defined $params{session}) {
  128. if (defined $params{session}->param("name")) {
  129. return $params{session}->param("name").'@web';
  130. }
  131. elsif (defined $params{session}->remote_addr()) {
  132. return $params{session}->remote_addr().'@web';
  133. }
  134. }
  135. return 'anon@web';
  136. }
  137. sub rcs_commit (@) {
  138. # Commit the page. Returns 'undef' on success and a version of the page
  139. # with conflict markers on failure.
  140. my %params=@_;
  141. my ($file, $message, $token) =
  142. ($params{file}, $params{message}, $params{token});
  143. # Compute if the "revision" of $file changed.
  144. my $changed = darcs_rev($file) ne $token;
  145. # Yes, the following is a bit convoluted.
  146. if ($changed) {
  147. # TODO. Invent a better, non-conflicting name.
  148. rename("$config{srcdir}/$file", "$config{srcdir}/$file.save") or
  149. error("failed to rename $file to $file.save: $!");
  150. # Roll the repository back to $token.
  151. # TODO. Can we be sure that no changes are lost? I think that
  152. # we can, if we make sure that the 'darcs push' below will always
  153. # succeed.
  154. # We need to revert everything as 'darcs obliterate' might choke
  155. # otherwise.
  156. # TODO: 'yes | ...' needed? Doesn't seem so.
  157. silentsystem('darcs', "revert", "--repodir", $config{srcdir}, "--all") == 0 ||
  158. error("'darcs revert' failed");
  159. # Remove all patches starting at $token.
  160. my $child = open(DARCS_OBLITERATE, "|-");
  161. if (! $child) {
  162. open(STDOUT, ">/dev/null");
  163. exec('darcs', "obliterate", "--repodir", $config{srcdir},
  164. "--match", "hash " . $token) and
  165. error("'darcs obliterate' failed");
  166. }
  167. 1 while print DARCS_OBLITERATE "y";
  168. close(DARCS_OBLITERATE);
  169. # Restore the $token one.
  170. silentsystem('darcs', "pull", "--quiet", "--repodir", $config{srcdir},
  171. "--match", "hash " . $token, "--all") == 0 ||
  172. error("'darcs pull' failed");
  173. # We're back at $token. Re-install the modified file.
  174. rename("$config{srcdir}/$file.save", "$config{srcdir}/$file") or
  175. error("failed to rename $file.save to $file: $!");
  176. }
  177. # Record the changes.
  178. my $author=commitauthor(%params);
  179. if (!defined $message || !length($message)) {
  180. $message = "empty message";
  181. }
  182. silentsystem('darcs', 'record', '--repodir', $config{srcdir}, '--all',
  183. '-m', $message, '--author', $author, $file) == 0 ||
  184. error("'darcs record' failed");
  185. # Update the repository by pulling from the default repository, which is
  186. # master repository.
  187. silentsystem('darcs', "pull", "--quiet", "--repodir", $config{srcdir},
  188. "--all") == 0 || error("'darcs pull' failed");
  189. # If this updating yields any conflicts, we'll record them now to resolve
  190. # them. If nothing is recorded, there are no conflicts.
  191. $token = darcs_rev($file);
  192. # TODO: Use only the first line here, i.e. only the patch name?
  193. writefile("$file.log", $config{srcdir}, 'resolve conflicts: ' . $message);
  194. silentsystem('darcs', 'record', '--repodir', $config{srcdir}, '--all',
  195. '-m', 'resolve conflicts: ' . $message, '--author', $author, $file) == 0 ||
  196. error("'darcs record' failed");
  197. my $conflicts = darcs_rev($file) ne $token;
  198. unlink("$config{srcdir}/$file.log") or
  199. error("failed to remove '$file.log'");
  200. # Push the changes to the main repository.
  201. silentsystem('darcs', 'push', '--quiet', '--repodir', $config{srcdir}, '--all') == 0 ||
  202. error("'darcs push' failed");
  203. # TODO: darcs send?
  204. if ($conflicts) {
  205. my $document = readfile("$config{srcdir}/$file");
  206. # Try to leave everything in a consistent state.
  207. # TODO: 'yes | ...' needed? Doesn't seem so.
  208. silentsystem('darcs', "revert", "--repodir", $config{srcdir}, "--all") == 0 ||
  209. warn("'darcs revert' failed");
  210. return $document;
  211. }
  212. else {
  213. return undef;
  214. }
  215. }
  216. sub rcs_commit_staged (@) {
  217. my %params=@_;
  218. my $author=commitauthor(%params);
  219. if (!defined $params{message} || !length($params{message})) {
  220. $params{message} = "empty message";
  221. }
  222. silentsystem('darcs', "record", "--repodir", $config{srcdir},
  223. "-a", "-A", $author,
  224. "-m", $params{message},
  225. ) == 0 || error("'darcs record' failed");
  226. # Push the changes to the main repository.
  227. silentsystem('darcs', 'push', '--quiet', '--repodir', $config{srcdir}, '--all') == 0 ||
  228. error("'darcs push' failed");
  229. # TODO: darcs send?
  230. return undef;
  231. }
  232. sub rcs_add ($) {
  233. my $file = shift; # Relative to the repodir.
  234. if(! file_in_vc($config{srcdir}, $file)) {
  235. # Intermediate directories will be added automagically.
  236. system('darcs', 'add', '--quiet', '--repodir', $config{srcdir},
  237. '--boring', $file) == 0 || error("'darcs add' failed");
  238. }
  239. }
  240. sub rcs_remove ($) {
  241. my $file = shift; # Relative to the repodir.
  242. unlink($config{srcdir}.'/'.$file);
  243. }
  244. sub rcs_rename ($$) {
  245. my $a = shift; # Relative to the repodir.
  246. my $b = shift; # Relative to the repodir.
  247. system('darcs', 'mv', '--repodir', $config{srcdir}, $a, $b) == 0 ||
  248. error("'darcs mv' failed");
  249. }
  250. sub rcs_recentchanges ($) {
  251. my $num=shift;
  252. my @ret;
  253. eval q{use Date::Parse};
  254. eval q{use XML::Simple};
  255. my $repodir=$config{srcdir};
  256. my $child = open(LOG, "-|");
  257. if (! $child) {
  258. $ENV{"DARCS_DONT_ESCAPE_ANYTHING"}=1;
  259. exec("darcs", "changes", "--xml",
  260. "--summary",
  261. "--repodir", "$repodir",
  262. "--last", "$num")
  263. || error("'darcs changes' failed to run");
  264. }
  265. my $data;
  266. $data .= $_ while(<LOG>);
  267. close LOG;
  268. my $log = XMLin($data, ForceArray => 1);
  269. foreach my $patch (@{$log->{patch}}) {
  270. my $date=$patch->{local_date};
  271. my $hash=$patch->{hash};
  272. my $when=str2time($date);
  273. my (@pages, @files, @pg);
  274. push @pages, $_ foreach (@{$patch->{summary}->[0]->{modify_file}});
  275. push @pages, $_ foreach (@{$patch->{summary}->[0]->{add_file}});
  276. push @pages, $_ foreach (@{$patch->{summary}->[0]->{remove_file}});
  277. foreach my $f (@pages) {
  278. $f = $f->{content} if ref $f;
  279. $f =~ s,^\s+,,; $f =~ s,\s+$,,; # cut whitespace
  280. push @files, $f;
  281. }
  282. foreach my $p (@{$patch->{summary}->[0]->{move}}) {
  283. push @files, $p->{from};
  284. }
  285. foreach my $f (@files) {
  286. my $d = defined $config{'diffurl'} ? $config{'diffurl'} : "";
  287. $d =~ s/\[\[file\]\]/$f/go;
  288. $d =~ s/\[\[hash\]\]/$hash/go;
  289. push @pg, {
  290. page => pagename($f),
  291. diffurl => $d,
  292. };
  293. }
  294. next unless (scalar @pg > 0);
  295. my @message;
  296. push @message, { line => $_ } foreach (@{$patch->{name}});
  297. my $committype;
  298. my $author;
  299. if ($patch->{author} =~ /(.*)\@web$/) {
  300. $author = $1;
  301. $committype = "web";
  302. }
  303. else {
  304. $author=$patch->{author};
  305. $committype = "darcs";
  306. }
  307. push @ret, {
  308. rev => $patch->{hash},
  309. user => $author,
  310. committype => $committype,
  311. when => $when,
  312. message => [@message],
  313. pages => [@pg],
  314. };
  315. }
  316. return @ret;
  317. }
  318. sub rcs_diff ($;$) {
  319. my $rev=shift;
  320. my $maxlines=shift;
  321. my @lines;
  322. foreach my $line (silentsystem("darcs", "diff", "--match", "hash ".$rev)) {
  323. if (@lines || $line=~/^diff/) {
  324. last if defined $maxlines && @lines == $maxlines;
  325. push @lines, $line."\n";
  326. }
  327. }
  328. if (wantarray) {
  329. return @lines;
  330. }
  331. else {
  332. return join("", @lines);
  333. }
  334. }
  335. sub rcs_getctime ($) {
  336. my $file=shift;
  337. eval q{use Date::Parse};
  338. eval q{use XML::Simple};
  339. local $/=undef;
  340. my $child = open(LOG, "-|");
  341. if (! $child) {
  342. exec("darcs", "changes", "--xml", "--reverse",
  343. "--repodir", $config{srcdir}, $file)
  344. || error("'darcs changes $file' failed to run");
  345. }
  346. my $data;
  347. {
  348. local $/=undef;
  349. $data = <LOG>;
  350. }
  351. close LOG;
  352. my $log = XMLin($data, ForceArray => 1);
  353. my $datestr = $log->{patch}[0]->{local_date};
  354. if (! defined $datestr) {
  355. warn "failed to get ctime for $file";
  356. return 0;
  357. }
  358. my $date = str2time($datestr);
  359. debug("ctime for '$file': ". localtime($date));
  360. return $date;
  361. }
  362. sub rcs_getmtime ($) {
  363. error "rcs_getmtime is not implemented for darcs\n"; # TODO
  364. }
  365. 1