2 # Support for the darcs rcs, <URL:http://darcs.net/>.
3 # Copyright (C) 2006 Thomas Schwinge <tschwinge@gnu.org>
4 # 2007 Benjamin A'Lee <bma@bmalee.eu>
5 # Tuomo Valkonen <tuomov@iki.fi>
6 # 2008 Simon Michael <simon@joyful.com>
7 # Petr Ročkai <me@mornfall.net>
8 # Sven M. Hallberg <pesco@khjk.org>
10 # This program is free software; you can redistribute it and/or modify it
11 # under the terms of the GNU General Public License as published by the
12 # Free Software Foundation; either version 2 of the License, or (at your
13 # option) any later version.
15 # This program is distributed in the hope that it will be useful, but
16 # WITHOUT ANY WARRANTY; without even the implied warranty of
17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 # General Public License for more details.
20 # You should have received a copy of the GNU General Public License along
21 # with this program; if not, write to the Free Software Foundation, Inc.,
22 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
24 # History (see http://ikiwiki.info/todo/darcs/):
26 # * Thomas Schwinge wrote the original file, implementing only rcs_commit.
27 # * Benjamin A'Lee contributed an alternative implementation.
28 # * Tuomo Valkonen contributed rcs_getctime and stub rcs_recentchanges.
29 # * Simon Michael contributed multiple changes.
30 # * Petr Ročkai fixed rcs_recentchanges and added caching to rcs_getctime.
31 # * Sven M. Hallberg merged the above and added missing features.
34 # We're guaranteed to be the only instance of ikiwiki running at a given
35 # time. It is essential that only ikiwiki is working on a particular
36 # repository. That means one instance of ikiwiki and it also means that
37 # you must not 'darcs push' into this repository, as this might create
38 # race conditions, as I understand it.
40 package IkiWiki::Plugin::darcs;
47 hook(type => "checkconfig", id => "darcs", call => \&checkconfig);
48 hook(type => "getsetup", id => "darcs", call => \&getsetup);
49 hook(type => "rcs", id => "rcs_update", call => \&rcs_update);
50 hook(type => "rcs", id => "rcs_prepedit", call => \&rcs_prepedit);
51 hook(type => "rcs", id => "rcs_commit", call => \&rcs_commit);
52 hook(type => "rcs", id => "rcs_commit_staged", call => \&rcs_commit_staged);
53 hook(type => "rcs", id => "rcs_add", call => \&rcs_add);
54 hook(type => "rcs", id => "rcs_remove", call => \&rcs_remove);
55 hook(type => "rcs", id => "rcs_rename", call => \&rcs_rename);
56 hook(type => "rcs", id => "rcs_recentchanges", call => \&rcs_recentchanges);
57 hook(type => "rcs", id => "rcs_diff", call => \&rcs_diff);
58 hook(type => "rcs", id => "rcs_getctime", call => \&rcs_getctime);
61 sub silentsystem (@) {
62 open(SAVED_STDOUT, ">&STDOUT");
63 open(STDOUT, ">/dev/null");
65 open(STDOUT, ">&SAVED_STDOUT");
69 sub darcs_info ($$$) {
72 my $file = shift; # Relative to the repodir.
74 my $child = open(DARCS_CHANGES, "-|");
76 exec('darcs', 'changes', '--repodir', $repodir, '--xml-output', $file) or
77 error("failed to run 'darcs changes'");
80 # Brute force for now. :-/
81 while (<DARCS_CHANGES>) {
82 last if /^<\/created_as>$/;
84 ($_) = <DARCS_CHANGES> =~ /$field=\'([^\']+)/;
85 $field eq 'hash' and s/\.gz//; # Strip away the '.gz' from 'hash'es.
96 my $child = open(DARCS_MANIFEST, "-|");
98 exec('darcs', 'query', 'manifest', '--repodir', $repodir) or
99 error("failed to run 'darcs query manifest'");
102 while (<DARCS_MANIFEST>) {
103 $found = 1, last if /^(\.\/)?$file$/;
105 close(DARCS_MANIFEST) or error("'darcs query manifest' exited " . $?);
111 my $file = shift; # Relative to the repodir.
112 my $repodir = $config{srcdir};
114 return "" if (! file_in_vc($repodir, $file));
115 my $hash = darcs_info('hash', $repodir, $file);
116 return defined $hash ? $hash : "";
120 if (defined $config{darcs_wrapper} && length $config{darcs_wrapper}) {
121 push @{$config{wrappers}}, {
122 wrapper => $config{darcs_wrapper},
123 wrappermode => (defined $config{darcs_wrappermode} ? $config{darcs_wrappermode} : "06755"),
131 safe => 0, # rcs plugin
136 example => "/darcs/repo/_darcs/ikiwiki-wrapper",
137 description => "wrapper to generate (set as master repo apply hook)",
141 darcs_wrappermode => {
144 description => "mode for darcs_wrapper (can safely be made suid)",
150 example => "http://darcs.example.com/darcsweb.cgi?r=wiki;a=filehistory;f=[[file]]",
151 description => "darcsweb url to show file history ([[file]] substituted)",
157 example => "http://darcs.example.com/darcsweb.cgi?r=wiki;a=filediff;h=[[hash]];f=[[file]]",
158 description => "darcsweb url to show a diff ([[hash]] and [[file]] substituted)",
165 silentsystem('darcs', "pull", "--repodir", $config{srcdir}, "-qa")
168 sub rcs_prepedit ($) {
169 # Prepares to edit a file under revision control. Returns a token that
170 # must be passed to rcs_commit() when the file is to be commited. For us,
171 # this token the hash value of the latest patch that modifies the file,
172 # i.e. something like its current revision.
174 my $file = shift; # Relative to the repodir.
175 my $rev = darcs_rev($file);
179 sub rcs_commit ($$$;$$) {
180 # Commit the page. Returns 'undef' on success and a version of the page
181 # with conflict markers on failure.
183 my ($file, $message, $rcstoken, $user, $ipaddr) = @_;
185 # Compute if the "revision" of $file changed.
186 my $changed = darcs_rev($file) ne $rcstoken;
188 # Yes, the following is a bit convoluted.
190 # TODO. Invent a better, non-conflicting name.
191 rename("$config{srcdir}/$file", "$config{srcdir}/$file.save") or
192 error("failed to rename $file to $file.save: $!");
194 # Roll the repository back to $rcstoken.
196 # TODO. Can we be sure that no changes are lost? I think that
197 # we can, if we make sure that the 'darcs push' below will always
200 # We need to revert everything as 'darcs obliterate' might choke
202 # TODO: 'yes | ...' needed? Doesn't seem so.
203 silentsystem('darcs', "revert", "--repodir", $config{srcdir}, "--all") == 0 ||
204 error("'darcs revert' failed");
205 # Remove all patches starting at $rcstoken.
206 my $child = open(DARCS_OBLITERATE, "|-");
208 open(STDOUT, ">/dev/null");
209 exec('darcs', "obliterate", "--repodir", $config{srcdir},
210 "--match", "hash " . $rcstoken) and
211 error("'darcs obliterate' failed");
213 1 while print DARCS_OBLITERATE "y";
214 close(DARCS_OBLITERATE);
215 # Restore the $rcstoken one.
216 silentsystem('darcs', "pull", "--quiet", "--repodir", $config{srcdir},
217 "--match", "hash " . $rcstoken, "--all") == 0 ||
218 error("'darcs pull' failed");
220 # We're back at $rcstoken. Re-install the modified file.
221 rename("$config{srcdir}/$file.save", "$config{srcdir}/$file") or
222 error("failed to rename $file.save to $file: $!");
225 # Record the changes.
228 $author = "$user\@web";
230 elsif (defined $ipaddr) {
231 $author = "$ipaddr\@web";
234 $author = "anon\@web";
236 if (!defined $message || !length($message)) {
237 $message = "empty message";
239 silentsystem('darcs', 'record', '--repodir', $config{srcdir}, '--all',
240 '-m', $message, '--author', $author, $file) == 0 ||
241 error("'darcs record' failed");
243 # Update the repository by pulling from the default repository, which is
245 silentsystem('darcs', "pull", "--quiet", "--repodir", $config{srcdir},
246 "--all") !=0 || error("'darcs pull' failed");
248 # If this updating yields any conflicts, we'll record them now to resolve
249 # them. If nothing is recorded, there are no conflicts.
250 $rcstoken = darcs_rev($file);
251 # TODO: Use only the first line here, i.e. only the patch name?
252 writefile("$file.log", $config{srcdir}, 'resolve conflicts: ' . $message);
253 silentsystem('darcs', 'record', '--repodir', $config{srcdir}, '--all',
254 '-m', 'resolve conflicts: ' . $message, '--author', $author, $file) == 0 ||
255 error("'darcs record' failed");
256 my $conflicts = darcs_rev($file) ne $rcstoken;
257 unlink("$config{srcdir}/$file.log") or
258 error("failed to remove '$file.log'");
260 # Push the changes to the main repository.
261 silentsystem('darcs', 'push', '--quiet', '--repodir', $config{srcdir}, '--all') == 0 ||
262 error("'darcs push' failed");
266 my $document = readfile("$config{srcdir}/$file");
267 # Try to leave everything in a consistent state.
268 # TODO: 'yes | ...' needed? Doesn't seem so.
269 silentsystem('darcs', "revert", "--repodir", $config{srcdir}, "--all") == 0 ||
270 warn("'darcs revert' failed");
278 sub rcs_commit_staged($$$) {
279 my ($message, $user, $ipaddr) = @_;
283 $author = "$user\@web";
285 elsif (defined $ipaddr) {
286 $author = "$ipaddr\@web";
289 $author = "anon\@web";
291 if (!defined $message || !length($message)) {
292 $message = "empty message";
295 silentsystem('darcs', "record", "--repodir", $config{srcdir}, "-a", "-A", $author,
296 "-m", $message) == 0 || error("'darcs record' failed");
298 # Push the changes to the main repository.
299 silentsystem('darcs', 'push', '--quiet', '--repodir', $config{srcdir}, '--all') == 0 ||
300 error("'darcs push' failed");
307 my $file = shift; # Relative to the repodir.
309 if(! file_in_vc($config{srcdir}, $file)) {
310 # Intermediate directories will be added automagically.
311 system('darcs', 'add', '--quiet', '--repodir', $config{srcdir},
312 '--boring', $file) == 0 || error("'darcs add' failed");
317 my $file = shift; # Relative to the repodir.
319 unlink($config{srcdir}.'/'.$file);
322 sub rcs_rename ($$) {
323 my $a = shift; # Relative to the repodir.
324 my $b = shift; # Relative to the repodir.
326 system('darcs', 'mv', '--repodir', $config{srcdir}, $a, $b) == 0 ||
327 error("'darcs mv' failed");
330 sub rcs_recentchanges ($) {
334 eval q{use Date::Parse};
335 eval q{use XML::Simple};
337 my $repodir=$config{srcdir};
339 debug("darcs recent changes: $num");
341 my $child = open(LOG, "-|");
343 $ENV{"DARCS_DONT_ESCAPE_ANYTHING"}=1;
344 exec("darcs", "changes", "--xml",
346 "--repodir", "$repodir",
348 || error("'darcs changes' failed to run");
351 $data .= $_ while(<LOG>);
354 my $log = XMLin($data, ForceArray => 1);
356 debug("parsing recent changes...");
357 foreach my $patch (@{$log->{patch}}) {
358 my $date=$patch->{local_date};
359 my $hash=$patch->{hash};
360 my $when=str2time($date);
361 my (@pages, @files, @pg);
362 push @pages, $_ for (@{$patch->{summary}->[0]->{modify_file}});
363 push @pages, $_ for (@{$patch->{summary}->[0]->{add_file}});
364 push @pages, $_ for (@{$patch->{summary}->[0]->{remove_file}});
365 foreach my $f (@pages) {
366 $f = $f->{content} if ref $f;
367 $f =~ s,^\s+,,; $f =~ s,\s+$,,; # cut whitespace
371 foreach my $p (@{$patch->{summary}->[0]->{move}}) {
372 push @files, $p->{from};
375 foreach my $f (@files) {
376 my $d = defined $config{'diffurl'} ? $config{'diffurl'} : "";
377 $d =~ s/\[\[file\]\]/$f/go;
378 $d =~ s/\[\[hash\]\]/$hash/go;
381 debug("diffurl: $d");
383 page => pagename($f),
387 next unless (scalar @pg > 0);
388 debug("recent change: " . $patch->{name}[0] . " ("
389 . scalar @pg . " changes)");
392 push @message, { line => $_ } foreach (@{$patch->{name}});
395 if ($patch->{author} =~ /\@web$/) {
399 $committype = "darcs";
403 rev => $patch->{hash},
404 user => $patch->{author},
405 committype => $committype,
407 message => [@message],
418 foreach my $line (silentsystem("darcs", "diff", "--match", "hash ".$rev)) {
419 if (@lines || $line=~/^diff/) {
420 push @lines, $line."\n";
427 return join("", @lines);
431 sub rcs_getctime ($) {
434 eval q{use Date::Parse};
435 eval q{use XML::Simple};
438 # Sigh... doing things the hard way again
439 my $repodir=$config{srcdir};
441 my $filer=substr($file, length($repodir));
444 my $child = open(LOG, "-|");
446 exec("darcs", "changes", "--xml", "--reverse",
447 "--repodir", "$repodir", "$filer")
448 || error("'darcs changes $filer' failed to run");
458 my $log = XMLin($data, ForceArray => 1);
460 my $datestr = $log->{patch}[0]->{local_date};
462 if (! defined $datestr) {
463 warn "failed to get ctime for $filer";
467 my $date = str2time($datestr);
469 debug("ctime for '$file': ". localtime($date));