web commit by http://bmalee.eu/~bma/: Here's my mostly-working darcs plugin.

master
joey 2007-03-19 17:51:39 +00:00
parent 16112c3294
commit 0b57bfe5b9
1 changed files with 128 additions and 0 deletions

View File

@ -201,3 +201,131 @@ Here's Thomas Schwinge unfinished darcs support for ikiwiki.
1
"""]]
This is my ([bma](bma@bmalee.eu)) darcs.pm - it's messy (my Perl isn't up to much) but seems to work. It uses just one repo, like the mercurial plugin (unlike the above version, which AIUI uses two).
`rcs_commit()` uses backticks instead of `system()`, to prevent darcs' output being sent to the browser and mucking with the HTTP headers (`darcs record` has no --quiet option). And `rcs_recentchanges()` uses regexes rather than parsing darcs' XML output.
[[toggle text="show"]]
[[toggleable text="""
#!/usr/bin/perl
use warnings;
use strict;
use IkiWiki;
use Date::Parse;
use open qw{:utf8 :std};
package IkiWiki;
sub rcs_update () { #{{{
# Do nothing - there's nowhere to update *from*.
} #}}}
sub rcs_prepedit ($) { #{{{
} #}}}
sub rcs_commit ($$$;$$) { #{{{
my ($file, $message, $rcstoken, $user, $ipaddr) = @_;
# $user should probably be a name and an email address, by darcs
# convention.
if (defined $user) {
$user = possibly_foolish_untaint($user);
}
elsif (defined $ipaddr) {
$user = "Anonymous from $ipaddr";
}
else {
$user = "Anonymous";
}
$message = possibly_foolish_untaint($message);
# BUG: this outputs one line of text, and there's not a -q or --quiet
# option. Redirecting output to /dev/null works, but I still get the
# HTTP status and location headers displayed in the browser - is that
# darcs' fault or ikiwiki's?
# Doing it in backticks *works*, but I'm sure it could be done better.
my @cmdline = ("darcs", "record", "--repodir", "$config{srcdir}",
"-a", "-m", "$message", "--author", "$user", $file);
`darcs record --repodir "$config{srcdir}" -a -m "$message" --author "$user" $file`; # Return value? Output? Who needs 'em?
#if (system(@cmdline) != 0) {
# warn "'@cmdline' failed: $!";
#}
return undef; # success
sub rcs_add ($) { # {{{
my ($file) = @_;
my @cmdline = ("darcs", "add", "--repodir", "$config{srcdir}", "-a", "-q", "$file");
if (system(@cmdline) != 0) {
warn "'@cmdline' failed: $!";
}
} #}}}
sub rcs_recentchanges ($) { #{{{
# TODO: This is horrible code. It doesn't work perfectly, and uses regexes
# rather than parsing Darcs' XML output.
my $num=shift;
my @ret;
return unless -d "$config{srcdir}/_darcs";
my $changelog = `darcs changes --xml --summary --repodir "$config{srcdir}"`;
$changelog = join("", split(/\s*\n\s*/, $changelog));
my @changes = split(/<\/patch>.*?<patch/m, $changelog);
foreach my $change (@changes) {
$change =~ m/hash='(.*?)'/;
my $rev = $1;
$change =~ m/author='(.*?)'/;
my $user = $1."\n";
my $committype = "web";
if($user =~ m/&lt;/) {
# Author fields generated by darcs include an email address: look for the "<".
$committype = "darcs";
use HTML::Entities;
$user = decode_entities $user;
}
$change =~ m/local_date='(.*?)'/;
my $when = $1;
$when=time - str2time($when, 'UTC');
$change =~ m/<name>(.*?)<\/name>/g;
my @message = {line => $1};
foreach my $match ($change =~ m/<comment>(.*?)<\/comment>/gm) {
push @message, {line => $1};
}
my @pages;
foreach my $match ($change =~ m/<.*?_(file|directory)>(.*?)(<(added|removed)_lines.*\/>)*<\/.*?_(file|directory)>/g) {
# My perl-fu is weak. I'm probably going about this all wrong, anyway.
push @pages, {page => pagename($match)} if ( -f $config{srcdir}."/".$match || -d $config{srcdir}."/".$match) and not $match =~ m/^$/;
}
push @ret, { rev => $rev,
user => $user,
committype => $committype,
when => $when,
message => [@message],
pages => [@pages],
}
}
return @ret;
} #}}}
sub rcs_notify () { #{{{
# TODO
} #}}}
sub rcs_getctime ($) { #{{{
error gettext("getctime not implemented");
} #}}}
1
"""]]