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