X-Git-Url: http://git.vanrenterghem.biz/git.ikiwiki.info.git/blobdiff_plain/c2c943bc25a83b5c4c3eab3b43a7b6e4c4f4ba33..35668b87d3247a7de6c4dbb9edd7e0d909603524:/IkiWiki/Rcs/monotone.pm diff --git a/IkiWiki/Rcs/monotone.pm b/IkiWiki/Rcs/monotone.pm index 992065931..ce4a2a3ed 100644 --- a/IkiWiki/Rcs/monotone.pm +++ b/IkiWiki/Rcs/monotone.pm @@ -1,4 +1,7 @@ #!/usr/bin/perl + +package IkiWiki; + use warnings; use strict; use IkiWiki; @@ -6,8 +9,6 @@ use Monotone; use Date::Parse qw(str2time); use Date::Format qw(time2str); -package IkiWiki; - my $sha1_pattern = qr/[0-9a-fA-F]{40}/; # pattern to validate sha1sums sub check_config() { #{{{ @@ -18,12 +19,30 @@ sub check_config() { #{{{ error("Ikiwiki srcdir does not seem to be a Monotone workspace (or set the mtnrootdir)!"); } - if (!defined($config{mtnmergerc})) { - $config{mtnmergerc} = "$config{mtnrootdir}/_MTN/mergerc"; - } - chdir $config{srcdir} or error("Cannot chdir to $config{srcdir}: $!"); + + my $child = open(MTN, "-|"); + if (! $child) { + open STDERR, ">/dev/null"; + exec("mtn", "version") || error("mtn version failed to run"); + } + + my $version=undef; + while () { + if (/^monotone (\d+\.\d+) /) { + $version=$1; + } + } + + close MTN || debug("mtn version exited $?"); + + if (!defined($version)) { + error("Cannot determine monotone version"); + } + if ($version < 0.38) { + error("Monotone version too old, is $version but required 0.38"); + } } #}}} sub get_rev () { #{{{ @@ -59,13 +78,11 @@ sub mtn_merge ($$$$) { #{{{ my $mergeRev; - my $mergerc = $config{mtnmergerc}; - my $child = open(MTNMERGE, "-|"); if (! $child) { open STDERR, ">&STDOUT"; - exec("mtn", "--root=$config{mtnrootdir}", "--rcfile", - $mergerc, "explicit_merge", $leftRev, $rightRev, + exec("mtn", "--root=$config{mtnrootdir}", + "explicit_merge", $leftRev, $rightRev, $branch, "--author", $author, "--key", $config{mtnkey}) || error("mtn merge failed to run"); } @@ -130,16 +147,6 @@ sub commit_file_to_new_rev($$$$$$$$) { #{{{ return $newRevID; } #}}} -sub check_mergerc () { #{{{ - my $mergerc = $config{mtnmergerc}; - if (! -r $mergerc ) { - debug("$mergerc doesn't exist. Creating file with default mergers."); - open (my $out, ">", $mergerc) or error("can't open $mergerc: $!"); - print $out ; - close $out; - } -} #}}} - sub read_certs ($$) { #{{{ my $automator=shift; my $rev=shift; @@ -239,17 +246,11 @@ sub rcs_commit ($$$;$$) { #{{{ # Something has been committed, has this file changed? my ($out, $err); - #$automator->setOpts("-r", $oldrev, "-r", $rev); - #my ($out, $err) = $automator->call("content_diff", $file); - #debug("Problem committing $file") if ($err ne ""); - # FIXME: use of $file in these backticks is not wise from a - # security POV. Probably safe, but should be avoided - # anyway. - # At the moment the backticks are used because the above call using the automate - # interface was failing. When that bug in monotone is fixed, we should switch - # back. - my $diff = `mtn --root=$config{mtnrootdir} au content_diff -r $oldrev -r $rev $file`; # was just $out; - + $automator->setOpts("r", $oldrev, "r", $rev); + ($out, $err) = $automator->call("content_diff", $file); + debug("Problem committing $file") if ($err ne ""); + my $diff = $out; + if ($diff) { # Commit a revision with just this file changed off # the old revision. @@ -281,8 +282,6 @@ sub rcs_commit ($$$;$$) { #{{{ } debug("Divergence created! Attempting auto-merge."); - check_mergerc(); - # see if it will merge cleanly $ENV{MTN_MERGE}="fail"; my $mergeResult = mtn_merge($newRevID, $rev, $branch, $author); @@ -305,9 +304,11 @@ sub rcs_commit ($$$;$$) { #{{{ else { debug("Auto-merge failed. Using diff-merge to add conflict markers."); - $ENV{MTN_MERGE}="diffutils_force"; + $ENV{MTN_MERGE}="diffutils"; + $ENV{MTN_MERGE_DIFFUTILS}="partial=true"; $mergeResult = mtn_merge($newRevID, $rev, $branch, $author); $ENV{MTN_MERGE}=""; + $ENV{MTN_MERGE_DIFFUTILS}=""; if (!defined($mergeResult)) { debug("Unable to insert conflict markers!"); @@ -348,10 +349,10 @@ sub rcs_commit ($$$;$$) { #{{{ return $conflict; } if (defined($config{mtnsync}) && $config{mtnsync}) { - if (system("mtn", "--root=$config{mtnrootdir}", "sync", + if (system("mtn", "--root=$config{mtnrootdir}", "push", "--quiet", "--ticker=none", "--key", $config{mtnkey}) != 0) { - debug("monotone sync failed"); + debug("monotone push failed"); } } @@ -422,7 +423,7 @@ sub rcs_recentchanges ($) { #{{{ $committype = "monotone"; } } elsif ($cert->{name} eq "date") { - $when = time - str2time($cert->{value}, 'UTC'); + $when = str2time($cert->{value}, 'UTC'); } elsif ($cert->{name} eq "changelog") { my $messageText = $cert->{value}; # split the changelog into multiple @@ -437,10 +438,28 @@ sub rcs_recentchanges ($) { #{{{ my @changed_files = get_changed_files($automator, $rev); my $file; + my ($out, $err) = $automator->call("parents", $rev); + my @parents = ($out =~ m/^($sha1_pattern)$/); + my $parent = $parents[0]; + foreach $file (@changed_files) { - push @pages, { - page => pagename($file), - } if length $file; + next unless length $file; + + if (defined $config{diffurl} and (@parents == 1)) { + my $diffurl=$config{diffurl}; + $diffurl=~s/\[\[r1\]\]/$parent/g; + $diffurl=~s/\[\[r2\]\]/$rev/g; + $diffurl=~s/\[\[file\]\]/$file/g; + push @pages, { + page => pagename($file), + diffurl => $diffurl, + }; + } + else { + push @pages, { + page => pagename($file), + } + } } push @ret, { @@ -458,52 +477,8 @@ sub rcs_recentchanges ($) { #{{{ return @ret; } #}}} -sub rcs_notify () { #{{{ - debug("The monotone rcs_notify function is currently untested. Use at own risk!"); - - if (! exists $ENV{REV}) { - error(gettext("REV is not set, not running from mtn post-commit hook, cannot send notifications")); - } - if ($ENV{REV} !~ m/($sha1_pattern)/) { # sha1 is untainted now - error(gettext("REV is not a valid revision identifier, cannot send notifications")); - } - my $rev = $1; - - check_config(); - - my $automator = Monotone->new(); - $automator->open(undef, $config{mtnrootdir}); - - my $certs = [read_certs($automator, $rev)]; - my $user; - my $message; - my $when; - - foreach my $cert (@$certs) { - if ($cert->{signature} eq "ok" && $cert->{trust} eq "trusted") { - if ($cert->{name} eq "author") { - $user = $cert->{value}; - } elsif ($cert->{name} eq "date") { - $when = $cert->{value}; - } elsif ($cert->{name} eq "changelog") { - $message = $cert->{value}; - } - } - } - - my @changed_pages = get_changed_files($automator, $rev); - - $automator->close(); - - require IkiWiki::UserInfo; - send_commit_mails( - sub { - return $message; - }, - sub { - `mtn --root=$config{mtnrootdir} au content_diff -r $rev`; - }, - $user, @changed_pages); +sub rcs_diff ($) { #{{{ + # TODO } #}}} sub rcs_getctime ($) { #{{{ @@ -558,56 +533,3 @@ sub rcs_getctime ($) { #{{{ } #}}} 1 - -# default mergerc content -__DATA__ - function local_execute_redirected(stdin, stdout, stderr, path, ...) - local pid - local ret = -1 - io.flush(); - pid = spawn_redirected(stdin, stdout, stderr, path, unpack(arg)) - if (pid ~= -1) then ret, pid = wait(pid) end - return ret - end - if (not execute_redirected) then -- use standard function if available - execute_redirected = local_execute_redirected - end - if (not mergers.fail) then -- use standard merger if available - mergers.fail = { - cmd = function (tbl) return false end, - available = function () return true end, - wanted = function () return true end - } - end - mergers.diffutils_force = { - cmd = function (tbl) - local ret = execute_redirected( - "", - tbl.outfile, - "", - "diff3", - "--merge", - "--show-overlap", - "--label", string.format("[Yours]", tbl.left_path ), - "--label", string.format("[Original]", tbl.anc_path ), - "--label", string.format("[Theirs]", tbl.right_path), - tbl.lfile, - tbl.afile, - tbl.rfile - ) - if (ret > 1) then - io.write(gettext("Error running GNU diffutils 3-way difference tool 'diff3'")) - return false - end - return tbl.outfile - end, - available = - function () - return program_exists_in_path("diff3"); - end, - wanted = - function () - return true - end - } -EOF