git.oblomov.eu Git - ikiwiki/blob - IkiWiki/Plugin/darcs.pm

   1 # Support for the darcs rcs, <URL:http://darcs.net/>.
   2 # Copyright (C) 2006  Thomas Schwinge <tschwinge@gnu.org>
   3 #               2007  Benjamin A'Lee <bma@bmalee.eu>
   4 #                     Tuomo Valkonen <tuomov@iki.fi>
   5 #               2008  Simon Michael <simon@joyful.com>
   6 #                     Petr Ročkai <me@mornfall.net>
   7 #                     Sven M. Hallberg <pesco@khjk.org>
   8 #
   9 # This program is free software; you can redistribute it and/or modify it
  10 # under the terms of the GNU General Public License as published by the
  11 # Free Software Foundation; either version 2 of the License, or (at your
  12 # option) any later version.
  13 #
  14 # This program is distributed in the hope that it will be useful, but
  15 # WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 # General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License along
  20 # with this program; if not, write to the Free Software Foundation, Inc.,
  21 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  22
  23 # History (see http://ikiwiki.info/todo/darcs/):
  24 #
  25 #  * Thomas Schwinge wrote the original file, implementing only rcs_commit.
  26 #  * Benjamin A'Lee contributed an alternative implementation.
  27 #  * Tuomo Valkonen contributed rcs_getctime and stub rcs_recentchanges.
  28 #  * Simon Michael contributed multiple changes.
  29 #  * Petr Ročkai fixed rcs_recentchanges and added caching to rcs_getctime.
  30 #  * Sven M. Hallberg merged the above and added missing features.
  31
  32
  33 # We're guaranteed to be the only instance of ikiwiki running at a given
  34 # time.  It is essential that only ikiwiki is working on a particular
  35 # repository.  That means one instance of ikiwiki and it also means that
  36 # you must not 'darcs push' into this repository, as this might create
  37 # race conditions, as I understand it.
  38
  39
  40 package IkiWiki::Plugin::darcs;
  41
  42 use warnings;
  43 use strict;
  44 use IkiWiki;
  45
  46
  47 sub import {
  48         hook(type => "checkconfig", id => "darcs", call => \&checkconfig);
  49         hook(type => "getsetup", id => "darcs", call => \&getsetup);
  50         hook(type => "rcs", id => "rcs_update", call => \&rcs_update);
  51         hook(type => "rcs", id => "rcs_prepedit", call => \&rcs_prepedit);
  52         hook(type => "rcs", id => "rcs_commit", call => \&rcs_commit);
  53         hook(type => "rcs", id => "rcs_commit_staged", call => \&rcs_commit_staged);
  54         hook(type => "rcs", id => "rcs_add", call => \&rcs_add);
  55         hook(type => "rcs", id => "rcs_remove", call => \&rcs_remove);
  56         hook(type => "rcs", id => "rcs_rename", call => \&rcs_rename);
  57         hook(type => "rcs", id => "rcs_recentchanges", call => \&rcs_recentchanges);
  58         hook(type => "rcs", id => "rcs_diff", call => \&rcs_diff);
  59         hook(type => "rcs", id => "rcs_getctime", call => \&rcs_getctime);
  60 }
  61
  62
  63 # Internal functions
  64
  65 sub silentsystem (@) {
  66         open(SAVED_STDOUT, ">&STDOUT");
  67         open(STDOUT, ">/dev/null");
  68         my $ret = system @_;
  69         open(STDOUT, ">&SAVED_STDOUT");
  70         return $ret;
  71 }
  72
  73 sub darcs_info ($$$) {
  74         my $field = shift;
  75         my $repodir = shift;
  76         my $file = shift; # Relative to the repodir.
  77
  78         my $child = open(DARCS_CHANGES, "-|");
  79         if (! $child) {
  80                 exec('darcs', 'changes', '--repodir', $repodir, '--xml-output', $file) or
  81                         error("failed to run 'darcs changes'");
  82         }
  83
  84         # Brute force for now.  :-/
  85         while (<DARCS_CHANGES>) {
  86                 last if /^<\/created_as>$/;
  87         }
  88         ($_) = <DARCS_CHANGES> =~ /$field=\'([^\']+)/;
  89         $field eq 'hash' and s/\.gz//; # Strip away the '.gz' from 'hash'es.
  90
  91         close(DARCS_CHANGES);
  92
  93         return $_;
  94 }
  95
  96 sub file_in_vc($$) {
  97     my $repodir = shift;
  98     my $file = shift;
  99
 100         my $child = open(DARCS_MANIFEST, "-|");
 101         if (! $child) {
 102                 exec('darcs', 'query', 'manifest', '--repodir', $repodir) or
 103                         error("failed to run 'darcs query manifest'");
 104         }
 105         my $found=0;
 106         while (<DARCS_MANIFEST>) {
 107                 $found = 1, last if /^(\.\/)?$file$/;
 108         }
 109         close(DARCS_MANIFEST) or error("'darcs query manifest' exited " . $?);
 110
 111         return $found;
 112 }
 113
 114 sub darcs_rev($) {
 115         my $file = shift; # Relative to the repodir.
 116         my $repodir = $config{srcdir};
 117
 118     return "" if (! file_in_vc($repodir, $file));
 119         my $hash = darcs_info('hash', $repodir, $file);
 120         return defined $hash ? $hash : "";
 121 }
 122
 123
 124 # Exported functions.
 125
 126 sub checkconfig() {
 127         if (defined $config{darcs_wrapper} && length $config{darcs_wrapper}) {
 128                 push @{$config{wrappers}}, {
 129                         wrapper => $config{darcs_wrapper},
 130                         wrappermode => (defined $config{darcs_wrappermode} ? $config{darcs_wrappermode} : "06755"),
 131                 };
 132         }
 133 }
 134
 135 sub getsetup() {
 136         return
 137         plugin => {
 138                 safe => 0, # rcs plugin
 139                 rebuild => undef,
 140         },
 141         darcs_wrapper => {
 142                 type => "string",
 143                 example => "/darcs/repo/_darcs/ikiwiki-wrapper",
 144                 description => "wrapper to generate (set as master repo apply hook)",
 145                 safe => 0, # file
 146                 rebuild => 0,
 147         },
 148         darcs_wrappermode => {
 149                 type => "string",
 150                 example => '06755',
 151                 description => "mode for darcs_wrapper (can safely be made suid)",
 152                 safe => 0,
 153                 rebuild => 0,
 154         },
 155         historyurl => {
 156                 type => "string",
 157                 example => "http://darcs.example.com/darcsweb.cgi?r=wiki;a=filehistory;f=[[file]]",
 158                 description => "darcsweb url to show file history ([[file]] substituted)",
 159                 safe => 1,
 160                 rebuild => 1,
 161         },
 162         diffurl => {
 163                 type => "string",
 164                 example => "http://darcs.example.com/darcsweb.cgi?r=wiki;a=filediff;h=[[hash]];f=[[file]]",
 165                 description => "darcsweb url to show a diff ([[hash]] and [[file]] substituted)",
 166                 safe => 1,
 167                 rebuild => 1,
 168         },
 169 }
 170
 171 sub rcs_update () {
 172         silentsystem('darcs', "pull", "--repodir", $config{srcdir}, "-qa")
 173 }
 174
 175 sub rcs_prepedit ($) {
 176         # Prepares to edit a file under revision control.  Returns a token that
 177         # must be passed to rcs_commit() when the file is to be commited.  For us,
 178         # this token the hash value of the latest patch that modifies the file,
 179         # i.e. something like its current revision.  If the file is not yet added
 180         # to the repository, we return TODO: the empty string.
 181
 182         my $file = shift; # Relative to the repodir.
 183         my $rev = darcs_rev($file);
 184         return $rev;
 185 }
 186
 187 sub rcs_commit ($$$;$$) {
 188         # Commit the page.  Returns 'undef' on success and a version of the page
 189         # with conflict markers on failure.
 190
 191         my ($file, $message, $rcstoken, $user, $ipaddr) = @_;
 192
 193         # Compute if the "revision" of $file changed.
 194         my $changed = darcs_rev($file) ne $rcstoken;
 195
 196         # Yes, the following is a bit convoluted.
 197         if ($changed) {
 198         # TODO.  Invent a better, non-conflicting name.
 199         rename("$config{srcdir}/$file", "$config{srcdir}/$file.save") or
 200                 error("failed to rename $file to $file.save: $!");
 201
 202         # Roll the repository back to $rcstoken.
 203
 204         # TODO.  Can we be sure that no changes are lost?  I think that
 205         # we can, if we make sure that the 'darcs push' below will always
 206         # succeed.
 207
 208         # We need to revert everything as 'darcs obliterate' might choke
 209         # otherwise.
 210         # TODO: 'yes | ...' needed?  Doesn't seem so.
 211         silentsystem('darcs', "revert", "--repodir", $config{srcdir}, "--all") and
 212                 error("'darcs revert' failed");
 213         # Remove all patches starting at $rcstoken.
 214         my $child = open(DARCS_OBLITERATE, "|-");
 215         if (! $child) {
 216                 open(STDOUT, ">/dev/null");
 217                 exec('darcs', "obliterate", "--repodir", $config{srcdir},
 218                    "--match", "hash " . $rcstoken) and
 219                    error("'darcs obliterate' failed");
 220         }
 221         while (print DARCS_OBLITERATE "y") {
 222                 ;
 223         }
 224         close(DARCS_OBLITERATE);
 225         # Restore the $rcstoken one.
 226         silentsystem('darcs', "pull", "--quiet", "--repodir", $config{srcdir},
 227                 "--match", "hash " . $rcstoken, "--all") and
 228                 error("'darcs pull' failed");
 229
 230         # We're back at $rcstoken.  Re-install the modified file.
 231         rename("$config{srcdir}/$file.save", "$config{srcdir}/$file") or
 232                 error("failed to rename $file.save to $file: $!");
 233         }
 234
 235         # Record the changes.
 236         my $author;
 237         if (defined $user) {
 238                 $author = "$user\@web";
 239         } elsif (defined $ipaddr) {
 240                 $author = "$ipaddr\@web";
 241         } else {
 242                 $author = "anon\@web";
 243         }
 244         if (!defined $message || !length($message)) {
 245                 $message = "empty message";
 246         }
 247         silentsystem('darcs', 'record', '--repodir', $config{srcdir}, '--all',
 248            '-m', $message, '--author', $author, $file) and
 249                 error("'darcs record' failed");
 250
 251         # Update the repository by pulling from the default repository, which is
 252         # master repository.
 253         silentsystem('darcs', "pull", "--quiet", "--repodir", $config{srcdir},
 254                 "--all") and error("'darcs pull' failed");
 255
 256         # If this updating yields any conflicts, we'll record them now to resolve
 257         # them.  If nothing is recorded, there are no conflicts.
 258         $rcstoken = darcs_rev($file);
 259         # TODO: Use only the first line here, i.e. only the patch name?
 260         writefile("$file.log", $config{srcdir}, 'resolve conflicts: ' . $message);
 261         silentsystem('darcs', 'record', '--repodir', $config{srcdir}, '--all',
 262                 '-m', 'resolve conflicts: ' . $message, '--author', $author, $file) and
 263                 error("'darcs record' failed");
 264         my $conflicts = darcs_rev($file) ne $rcstoken;
 265         unlink("$config{srcdir}/$file.log") or
 266         error("failed to remove '$file.log'");
 267
 268         # Push the changes to the main repository.
 269         silentsystem('darcs', 'push', '--quiet', '--repodir', $config{srcdir}, '--all')
 270         and error("'darcs push' failed");
 271         # TODO: darcs send?
 272
 273         if ($conflicts) {
 274                 my $document = readfile("$config{srcdir}/$file");
 275                 # Try to leave everything in a consistent state.
 276                 # TODO: 'yes | ...' needed?  Doesn't seem so.
 277                 silentsystem('darcs', "revert", "--repodir", $config{srcdir}, "--all") and
 278                         warn("'darcs revert' failed");
 279                 return $document;
 280         } else {
 281                 return undef;
 282         }
 283 }
 284
 285 sub rcs_commit_staged($$$) {
 286         my ($message, $user, $ipaddr) = @_;
 287
 288         my $author;
 289         if (defined $user) {
 290                 $author = "$user\@web";
 291         } elsif (defined $ipaddr) {
 292                 $author = "$ipaddr\@web";
 293         } else {
 294                 $author = "anon\@web";
 295         }
 296         if (!defined $message || !length($message)) {
 297                 $message = "empty message";
 298         }
 299
 300         silentsystem('darcs', "record", "--repodir", $config{srcdir}, "-a", "-A", $author,
 301                 "-m", $message) and error("'darcs record' failed");
 302
 303         # Push the changes to the main repository.
 304         silentsystem('darcs', 'push', '--quiet', '--repodir', $config{srcdir}, '--all')
 305                 and error("'darcs push' failed");
 306         # TODO: darcs send?
 307
 308         return undef;
 309 }
 310
 311 sub rcs_add ($) {
 312         my $file = shift; # Relative to the repodir.
 313
 314         if(! file_in_vc($config{srcdir}, $file)) {
 315                 # Intermediate directories will be added automagically.
 316                 system('darcs', 'add', '--quiet', '--repodir', $config{srcdir},
 317                         '--boring', $file) and error("'darcs add' failed");
 318         }
 319 }
 320
 321 sub rcs_remove ($) {
 322         my $file = shift; # Relative to the repodir.
 323
 324         unlink($config{srcdir}.'/'.$file);
 325 }
 326
 327 sub rcs_rename ($$) {
 328         my $a = shift; # Relative to the repodir.
 329         my $b = shift; # Relative to the repodir.
 330
 331         system('darcs', 'mv', '--repodir', $config{srcdir}, $a, $b)
 332            and error("'darcs mv' failed");
 333 }
 334
 335 sub rcs_recentchanges ($) {
 336         my $num=shift;
 337         my @ret;
 338
 339         eval q{use Date::Parse};
 340         eval q{use XML::Simple};
 341
 342         my $repodir=$config{srcdir};
 343
 344         debug("darcs recent changes: $num");
 345
 346         my $child = open(LOG, "-|");
 347         if (! $child) {
 348                 $ENV{"DARCS_DONT_ESCAPE_ANYTHING"}=1;
 349                 exec("darcs", "changes", "--xml",
 350                         "--summary",
 351                          "--repodir", "$repodir",
 352                          "--last", "$num")
 353                 || error("'darcs changes' failed to run");
 354         }
 355         my $data;
 356         $data .= $_ while(<LOG>);
 357         close LOG;
 358
 359         my $log = XMLin($data, ForceArray => 1);
 360
 361         debug("parsing recent changes...");
 362         foreach my $patch (@{$log->{patch}}) {
 363                 my $date=$patch->{local_date};
 364                 my $hash=$patch->{hash};
 365                 my $when=str2time($date);
 366                 my (@pages, @files, @pg);
 367                 push @pages, $_ for (@{$patch->{summary}->[0]->{modify_file}});
 368                 push @pages, $_ for (@{$patch->{summary}->[0]->{add_file}});
 369                 push @pages, $_ for (@{$patch->{summary}->[0]->{remove_file}});
 370                 for (@pages) {
 371                         my $f = $_;
 372                         $f = $_->{content} if (ref $_);
 373                         $f =~ s,^\s+,,; $f =~ s,\s+$,,; # cut whitespace
 374
 375                         push @files, $f;
 376                 }
 377                 for (@{$patch->{summary}->[0]->{move}}) {
 378                         my $p = $_;
 379                         push @files, $p->{from};
 380                 }
 381
 382                 for (@files) {
 383                         my $f = $_;
 384                         my $d = defined $config{'diffurl'} ? $config{'diffurl'} : "";
 385                         $d =~ s/\[\[file\]\]/$f/go;
 386                         $d =~ s/\[\[hash\]\]/$hash/go;
 387
 388                         debug("file: $f");
 389                         debug("diffurl: $d");
 390                         push @pg, {
 391                                 page => pagename($f),
 392                                 diffurl => $d,
 393                         };
 394                 }
 395                 next unless (scalar @pg > 0);
 396                 debug("recent change: " . $patch->{name}[0] . " ("
 397                         . scalar @pg . " changes)");
 398
 399                 my @message;
 400                 push @message, { line => $_ } for (@{$patch->{name}});
 401
 402                 my $committype;
 403                 if ($patch->{author} =~ /\@web$/) {
 404                         $committype = "web";
 405                 } else {
 406                         $committype = "darcs";
 407                 }
 408
 409                 push @ret, {
 410                         rev => $patch->{hash},
 411                         user => $patch->{author},
 412                         committype => $committype,
 413                         when => $when,
 414                         message => [@message],
 415                         pages => [@pg],
 416                 };
 417         }
 418
 419         return @ret;
 420 }
 421
 422 sub rcs_diff ($) {
 423         my $rev=shift;
 424         my @lines;
 425         foreach my $line (silentsystem("darcs", "diff", "--match", "hash ".$rev)) {
 426                 if (@lines || $line=~/^diff/) {
 427                         push @lines, $line."\n";
 428                 }
 429         }
 430         if (wantarray) {
 431                 return @lines;
 432         }
 433         else {
 434                 return join("", @lines);
 435         }
 436 }
 437
 438 sub rcs_getctime ($) {
 439         my $file=shift;
 440
 441         eval q{use Date::Parse};
 442         eval q{use XML::Simple};
 443         local $/=undef;
 444
 445         # Sigh... doing things the hard way again
 446         my $repodir=$config{srcdir};
 447
 448         my $filer=substr($file, length($repodir));
 449         $filer =~ s:^[/]+::;
 450
 451         my $child = open(LOG, "-|");
 452         if (! $child) {
 453                 exec("darcs", "changes", "--xml", "--reverse",
 454                         "--repodir", "$repodir", "$filer")
 455                 || error("'darcs changes $filer' failed to run");
 456         }
 457
 458         my $data;
 459         $data .= $_ while(<LOG>);
 460         close LOG;
 461
 462         my $log = XMLin($data, ForceArray => 1);
 463
 464         my $datestr=$log->{patch}[0]->{local_date};
 465
 466         if (! defined $datestr) {
 467                 warn "failed to get ctime for $filer";
 468                 return 0;
 469         }
 470
 471         my $date=str2time($datestr);
 472
 473         #debug("found ctime ".localtime($date)." for $filer");
 474
 475         return $date;
 476 }
 477
 478 1
 479
 480 # vim: ts=4 sw=4 noet