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