summaryrefslogtreecommitdiff
path: root/IkiWiki/Plugin/darcs.pm
blob: bc8394b904c3e774773b3eb6b0ce2883ffdc886d (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. section => "rcs",
  81. },
  82. darcs_wrapper => {
  83. type => "string",
  84. example => "/darcs/repo/_darcs/ikiwiki-wrapper",
  85. description => "wrapper to generate (set as master repo apply hook)",
  86. safe => 0, # file
  87. rebuild => 0,
  88. },
  89. darcs_wrappermode => {
  90. type => "string",
  91. example => '06755',
  92. description => "mode for darcs_wrapper (can safely be made suid)",
  93. safe => 0,
  94. rebuild => 0,
  95. },
  96. historyurl => {
  97. type => "string",
  98. example => "http://darcs.example.com/darcsweb.cgi?r=wiki;a=filehistory;f=[[file]]",
  99. description => "darcsweb url to show file history ([[file]] substituted)",
  100. safe => 1,
  101. rebuild => 1,
  102. },
  103. diffurl => {
  104. type => "string",
  105. example => "http://darcs.example.com/darcsweb.cgi?r=wiki;a=filediff;h=[[hash]];f=[[file]]",
  106. description => "darcsweb url to show a diff ([[hash]] and [[file]] substituted)",
  107. safe => 1,
  108. rebuild => 1,
  109. },
  110. }
  111. sub rcs_update () {
  112. silentsystem('darcs', "pull", "--repodir", $config{srcdir}, "-qa")
  113. }
  114. sub rcs_prepedit ($) {
  115. # Prepares to edit a file under revision control. Returns a token that
  116. # must be passed to rcs_commit() when the file is to be commited. For us,
  117. # this token the hash value of the latest patch that modifies the file,
  118. # i.e. something like its current revision.
  119. my $file = shift; # Relative to the repodir.
  120. my $rev = darcs_rev($file);
  121. return $rev;
  122. }
  123. sub rcs_commit ($$$;$$) {
  124. # Commit the page. Returns 'undef' on success and a version of the page
  125. # with conflict markers on failure.
  126. my ($file, $message, $rcstoken, $user, $ipaddr) = @_;
  127. # Compute if the "revision" of $file changed.
  128. my $changed = darcs_rev($file) ne $rcstoken;
  129. # Yes, the following is a bit convoluted.
  130. if ($changed) {
  131. # TODO. Invent a better, non-conflicting name.
  132. rename("$config{srcdir}/$file", "$config{srcdir}/$file.save") or
  133. error("failed to rename $file to $file.save: $!");
  134. # Roll the repository back to $rcstoken.
  135. # TODO. Can we be sure that no changes are lost? I think that
  136. # we can, if we make sure that the 'darcs push' below will always
  137. # succeed.
  138. # We need to revert everything as 'darcs obliterate' might choke
  139. # otherwise.
  140. # TODO: 'yes | ...' needed? Doesn't seem so.
  141. silentsystem('darcs', "revert", "--repodir", $config{srcdir}, "--all") == 0 ||
  142. error("'darcs revert' failed");
  143. # Remove all patches starting at $rcstoken.
  144. my $child = open(DARCS_OBLITERATE, "|-");
  145. if (! $child) {
  146. open(STDOUT, ">/dev/null");
  147. exec('darcs', "obliterate", "--repodir", $config{srcdir},
  148. "--match", "hash " . $rcstoken) and
  149. error("'darcs obliterate' failed");
  150. }
  151. 1 while print DARCS_OBLITERATE "y";
  152. close(DARCS_OBLITERATE);
  153. # Restore the $rcstoken one.
  154. silentsystem('darcs', "pull", "--quiet", "--repodir", $config{srcdir},
  155. "--match", "hash " . $rcstoken, "--all") == 0 ||
  156. error("'darcs pull' failed");
  157. # We're back at $rcstoken. Re-install the modified file.
  158. rename("$config{srcdir}/$file.save", "$config{srcdir}/$file") or
  159. error("failed to rename $file.save to $file: $!");
  160. }
  161. # Record the changes.
  162. my $author;
  163. if (defined $user) {
  164. $author = "$user\@web";
  165. }
  166. elsif (defined $ipaddr) {
  167. $author = "$ipaddr\@web";
  168. }
  169. else {
  170. $author = "anon\@web";
  171. }
  172. if (!defined $message || !length($message)) {
  173. $message = "empty message";
  174. }
  175. silentsystem('darcs', 'record', '--repodir', $config{srcdir}, '--all',
  176. '-m', $message, '--author', $author, $file) == 0 ||
  177. error("'darcs record' failed");
  178. # Update the repository by pulling from the default repository, which is
  179. # master repository.
  180. silentsystem('darcs', "pull", "--quiet", "--repodir", $config{srcdir},
  181. "--all") == 0 || error("'darcs pull' failed");
  182. # If this updating yields any conflicts, we'll record them now to resolve
  183. # them. If nothing is recorded, there are no conflicts.
  184. $rcstoken = darcs_rev($file);
  185. # TODO: Use only the first line here, i.e. only the patch name?
  186. writefile("$file.log", $config{srcdir}, 'resolve conflicts: ' . $message);
  187. silentsystem('darcs', 'record', '--repodir', $config{srcdir}, '--all',
  188. '-m', 'resolve conflicts: ' . $message, '--author', $author, $file) == 0 ||
  189. error("'darcs record' failed");
  190. my $conflicts = darcs_rev($file) ne $rcstoken;
  191. unlink("$config{srcdir}/$file.log") or
  192. error("failed to remove '$file.log'");
  193. # Push the changes to the main repository.
  194. silentsystem('darcs', 'push', '--quiet', '--repodir', $config{srcdir}, '--all') == 0 ||
  195. error("'darcs push' failed");
  196. # TODO: darcs send?
  197. if ($conflicts) {
  198. my $document = readfile("$config{srcdir}/$file");
  199. # Try to leave everything in a consistent state.
  200. # TODO: 'yes | ...' needed? Doesn't seem so.
  201. silentsystem('darcs', "revert", "--repodir", $config{srcdir}, "--all") == 0 ||
  202. warn("'darcs revert' failed");
  203. return $document;
  204. }
  205. else {
  206. return undef;
  207. }
  208. }
  209. sub rcs_commit_staged ($$$) {
  210. my ($message, $user, $ipaddr) = @_;
  211. my $author;
  212. if (defined $user) {
  213. $author = "$user\@web";
  214. }
  215. elsif (defined $ipaddr) {
  216. $author = "$ipaddr\@web";
  217. }
  218. else {
  219. $author = "anon\@web";
  220. }
  221. if (!defined $message || !length($message)) {
  222. $message = "empty message";
  223. }
  224. silentsystem('darcs', "record", "--repodir", $config{srcdir}, "-a", "-A", $author,
  225. "-m", $message) == 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 @lines;
  321. foreach my $line (silentsystem("darcs", "diff", "--match", "hash ".$rev)) {
  322. if (@lines || $line=~/^diff/) {
  323. push @lines, $line."\n";
  324. }
  325. }
  326. if (wantarray) {
  327. return @lines;
  328. }
  329. else {
  330. return join("", @lines);
  331. }
  332. }
  333. sub rcs_getctime ($) {
  334. my $file=shift;
  335. eval q{use Date::Parse};
  336. eval q{use XML::Simple};
  337. local $/=undef;
  338. my $filer=substr($file, length($config{srcdir}));
  339. $filer =~ s:^[/]+::;
  340. my $child = open(LOG, "-|");
  341. if (! $child) {
  342. exec("darcs", "changes", "--xml", "--reverse",
  343. "--repodir", $config{srcdir}, $filer)
  344. || error("'darcs changes $filer' 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 $filer";
  356. return 0;
  357. }
  358. my $date = str2time($datestr);
  359. debug("ctime for '$file': ". localtime($date));
  360. return $date;
  361. }
  362. 1