summaryrefslogtreecommitdiff
path: root/IkiWiki/Plugin/darcs.pm
blob: f17fadcb10ef5a66b5530ae6d65d41b175a186b7 (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 rcs_commit ($$$;$$) {
  125. # Commit the page. Returns 'undef' on success and a version of the page
  126. # with conflict markers on failure.
  127. my ($file, $message, $rcstoken, $user, $ipaddr) = @_;
  128. # Compute if the "revision" of $file changed.
  129. my $changed = darcs_rev($file) ne $rcstoken;
  130. # Yes, the following is a bit convoluted.
  131. if ($changed) {
  132. # TODO. Invent a better, non-conflicting name.
  133. rename("$config{srcdir}/$file", "$config{srcdir}/$file.save") or
  134. error("failed to rename $file to $file.save: $!");
  135. # Roll the repository back to $rcstoken.
  136. # TODO. Can we be sure that no changes are lost? I think that
  137. # we can, if we make sure that the 'darcs push' below will always
  138. # succeed.
  139. # We need to revert everything as 'darcs obliterate' might choke
  140. # otherwise.
  141. # TODO: 'yes | ...' needed? Doesn't seem so.
  142. silentsystem('darcs', "revert", "--repodir", $config{srcdir}, "--all") == 0 ||
  143. error("'darcs revert' failed");
  144. # Remove all patches starting at $rcstoken.
  145. my $child = open(DARCS_OBLITERATE, "|-");
  146. if (! $child) {
  147. open(STDOUT, ">/dev/null");
  148. exec('darcs', "obliterate", "--repodir", $config{srcdir},
  149. "--match", "hash " . $rcstoken) and
  150. error("'darcs obliterate' failed");
  151. }
  152. 1 while print DARCS_OBLITERATE "y";
  153. close(DARCS_OBLITERATE);
  154. # Restore the $rcstoken one.
  155. silentsystem('darcs', "pull", "--quiet", "--repodir", $config{srcdir},
  156. "--match", "hash " . $rcstoken, "--all") == 0 ||
  157. error("'darcs pull' failed");
  158. # We're back at $rcstoken. Re-install the modified file.
  159. rename("$config{srcdir}/$file.save", "$config{srcdir}/$file") or
  160. error("failed to rename $file.save to $file: $!");
  161. }
  162. # Record the changes.
  163. my $author;
  164. if (defined $user) {
  165. $author = "$user\@web";
  166. }
  167. elsif (defined $ipaddr) {
  168. $author = "$ipaddr\@web";
  169. }
  170. else {
  171. $author = "anon\@web";
  172. }
  173. if (!defined $message || !length($message)) {
  174. $message = "empty message";
  175. }
  176. silentsystem('darcs', 'record', '--repodir', $config{srcdir}, '--all',
  177. '-m', $message, '--author', $author, $file) == 0 ||
  178. error("'darcs record' failed");
  179. # Update the repository by pulling from the default repository, which is
  180. # master repository.
  181. silentsystem('darcs', "pull", "--quiet", "--repodir", $config{srcdir},
  182. "--all") == 0 || error("'darcs pull' failed");
  183. # If this updating yields any conflicts, we'll record them now to resolve
  184. # them. If nothing is recorded, there are no conflicts.
  185. $rcstoken = darcs_rev($file);
  186. # TODO: Use only the first line here, i.e. only the patch name?
  187. writefile("$file.log", $config{srcdir}, 'resolve conflicts: ' . $message);
  188. silentsystem('darcs', 'record', '--repodir', $config{srcdir}, '--all',
  189. '-m', 'resolve conflicts: ' . $message, '--author', $author, $file) == 0 ||
  190. error("'darcs record' failed");
  191. my $conflicts = darcs_rev($file) ne $rcstoken;
  192. unlink("$config{srcdir}/$file.log") or
  193. error("failed to remove '$file.log'");
  194. # Push the changes to the main repository.
  195. silentsystem('darcs', 'push', '--quiet', '--repodir', $config{srcdir}, '--all') == 0 ||
  196. error("'darcs push' failed");
  197. # TODO: darcs send?
  198. if ($conflicts) {
  199. my $document = readfile("$config{srcdir}/$file");
  200. # Try to leave everything in a consistent state.
  201. # TODO: 'yes | ...' needed? Doesn't seem so.
  202. silentsystem('darcs', "revert", "--repodir", $config{srcdir}, "--all") == 0 ||
  203. warn("'darcs revert' failed");
  204. return $document;
  205. }
  206. else {
  207. return undef;
  208. }
  209. }
  210. sub rcs_commit_staged ($$$) {
  211. my ($message, $user, $ipaddr) = @_;
  212. my $author;
  213. if (defined $user) {
  214. $author = "$user\@web";
  215. }
  216. elsif (defined $ipaddr) {
  217. $author = "$ipaddr\@web";
  218. }
  219. else {
  220. $author = "anon\@web";
  221. }
  222. if (!defined $message || !length($message)) {
  223. $message = "empty message";
  224. }
  225. silentsystem('darcs', "record", "--repodir", $config{srcdir}, "-a", "-A", $author,
  226. "-m", $message) == 0 || error("'darcs record' failed");
  227. # Push the changes to the main repository.
  228. silentsystem('darcs', 'push', '--quiet', '--repodir', $config{srcdir}, '--all') == 0 ||
  229. error("'darcs push' failed");
  230. # TODO: darcs send?
  231. return undef;
  232. }
  233. sub rcs_add ($) {
  234. my $file = shift; # Relative to the repodir.
  235. if(! file_in_vc($config{srcdir}, $file)) {
  236. # Intermediate directories will be added automagically.
  237. system('darcs', 'add', '--quiet', '--repodir', $config{srcdir},
  238. '--boring', $file) == 0 || error("'darcs add' failed");
  239. }
  240. }
  241. sub rcs_remove ($) {
  242. my $file = shift; # Relative to the repodir.
  243. unlink($config{srcdir}.'/'.$file);
  244. }
  245. sub rcs_rename ($$) {
  246. my $a = shift; # Relative to the repodir.
  247. my $b = shift; # Relative to the repodir.
  248. system('darcs', 'mv', '--repodir', $config{srcdir}, $a, $b) == 0 ||
  249. error("'darcs mv' failed");
  250. }
  251. sub rcs_recentchanges ($) {
  252. my $num=shift;
  253. my @ret;
  254. eval q{use Date::Parse};
  255. eval q{use XML::Simple};
  256. my $repodir=$config{srcdir};
  257. my $child = open(LOG, "-|");
  258. if (! $child) {
  259. $ENV{"DARCS_DONT_ESCAPE_ANYTHING"}=1;
  260. exec("darcs", "changes", "--xml",
  261. "--summary",
  262. "--repodir", "$repodir",
  263. "--last", "$num")
  264. || error("'darcs changes' failed to run");
  265. }
  266. my $data;
  267. $data .= $_ while(<LOG>);
  268. close LOG;
  269. my $log = XMLin($data, ForceArray => 1);
  270. foreach my $patch (@{$log->{patch}}) {
  271. my $date=$patch->{local_date};
  272. my $hash=$patch->{hash};
  273. my $when=str2time($date);
  274. my (@pages, @files, @pg);
  275. push @pages, $_ foreach (@{$patch->{summary}->[0]->{modify_file}});
  276. push @pages, $_ foreach (@{$patch->{summary}->[0]->{add_file}});
  277. push @pages, $_ foreach (@{$patch->{summary}->[0]->{remove_file}});
  278. foreach my $f (@pages) {
  279. $f = $f->{content} if ref $f;
  280. $f =~ s,^\s+,,; $f =~ s,\s+$,,; # cut whitespace
  281. push @files, $f;
  282. }
  283. foreach my $p (@{$patch->{summary}->[0]->{move}}) {
  284. push @files, $p->{from};
  285. }
  286. foreach my $f (@files) {
  287. my $d = defined $config{'diffurl'} ? $config{'diffurl'} : "";
  288. $d =~ s/\[\[file\]\]/$f/go;
  289. $d =~ s/\[\[hash\]\]/$hash/go;
  290. push @pg, {
  291. page => pagename($f),
  292. diffurl => $d,
  293. };
  294. }
  295. next unless (scalar @pg > 0);
  296. my @message;
  297. push @message, { line => $_ } foreach (@{$patch->{name}});
  298. my $committype;
  299. my $author;
  300. if ($patch->{author} =~ /(.*)\@web$/) {
  301. $author = $1;
  302. $committype = "web";
  303. }
  304. else {
  305. $author=$patch->{author};
  306. $committype = "darcs";
  307. }
  308. push @ret, {
  309. rev => $patch->{hash},
  310. user => $author,
  311. committype => $committype,
  312. when => $when,
  313. message => [@message],
  314. pages => [@pg],
  315. };
  316. }
  317. return @ret;
  318. }
  319. sub rcs_diff ($) {
  320. my $rev=shift;
  321. my @lines;
  322. foreach my $line (silentsystem("darcs", "diff", "--match", "hash ".$rev)) {
  323. if (@lines || $line=~/^diff/) {
  324. push @lines, $line."\n";
  325. }
  326. }
  327. if (wantarray) {
  328. return @lines;
  329. }
  330. else {
  331. return join("", @lines);
  332. }
  333. }
  334. sub rcs_getctime ($) {
  335. my $file=shift;
  336. eval q{use Date::Parse};
  337. eval q{use XML::Simple};
  338. local $/=undef;
  339. my $filer=substr($file, length($config{srcdir}));
  340. $filer =~ s:^[/]+::;
  341. my $child = open(LOG, "-|");
  342. if (! $child) {
  343. exec("darcs", "changes", "--xml", "--reverse",
  344. "--repodir", $config{srcdir}, $filer)
  345. || error("'darcs changes $filer' failed to run");
  346. }
  347. my $data;
  348. {
  349. local $/=undef;
  350. $data = <LOG>;
  351. }
  352. close LOG;
  353. my $log = XMLin($data, ForceArray => 1);
  354. my $datestr = $log->{patch}[0]->{local_date};
  355. if (! defined $datestr) {
  356. warn "failed to get ctime for $filer";
  357. return 0;
  358. }
  359. my $date = str2time($datestr);
  360. debug("ctime for '$file': ". localtime($date));
  361. return $date;
  362. }
  363. sub rcs_getmtime ($) {
  364. error "rcs_getmtime is not implemented for darcs\n"; # TODO
  365. }
  366. 1