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