X-Git-Url: http://git.vanrenterghem.biz/git.ikiwiki.info.git/blobdiff_plain/749c1e36d90998043c1988a49894d9ee23e60ec4..56b9b85e3332fbb920fb74b4dd30574fce6dc469:/IkiWiki/Rcs/monotone.pm?ds=inline diff --git a/IkiWiki/Rcs/monotone.pm b/IkiWiki/Rcs/monotone.pm index a6c850f0d..3b3cd5008 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,11 +9,9 @@ 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() { #{{{ +hook(type => "checkconfig", id => "monotone", call => sub { #{{{ if (!defined($config{mtnrootdir})) { $config{mtnrootdir} = $config{srcdir}; } @@ -18,13 +19,70 @@ 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"; + my $child = open(MTN, "-|"); + if (! $child) { + open STDERR, ">/dev/null"; + exec("mtn", "version") || error("mtn version failed to run"); } - - chdir $config{srcdir} - or error("Cannot chdir to $config{srcdir}: $!"); -} #}}} + + 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"); + } +}); #}}} + +hook(type => "getsetup", id => "monotone", call => sub { #{{{ + return + mtnkey => { + type => "string", + default => "", + example => 'web@example.com', + description => "your monotone key", + safe => 1, + rebuild => 0, + }, + historyurl => { + type => "string", + default => "", + example => "http://viewmtn.example.com/branch/head/filechanges/com.example.branch/[[file]]", + description => "viewmtn url to show file history ([[file]] substituted)", + safe => 1, + rebuild => 1, + }, + diffurl => { + type => "string", + default => "", + example => "http://viewmtn.example.com/revision/diff/[[r1]]/with/[[r2]]/[[file]]", + description => "viewmtn url to show a diff ([[r1]], [[r2]], and [[file]] substituted)", + safe => 1, + rebuild => 1, + }, + mtnsync => { + type => "boolean", + default => 0, + description => "sync on update and commit?", + safe => 0, # paranoia + rebuild => 0, + }, + mtnrootdir => { + type => "string", + default => "", + description => "path to your workspace (defaults to the srcdir; specify if the srcdir is a subdirectory of the workspace)", + safe => 0, # path + rebuild => 0, + }, +}); #}}} sub get_rev () { #{{{ my $sha1 = `mtn --root=$config{mtnrootdir} automate get_base_revision_id`; @@ -59,13 +117,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 +186,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; @@ -183,7 +229,8 @@ sub get_changed_files ($$) { #{{{ } #}}} sub rcs_update () { #{{{ - check_config(); + chdir $config{srcdir} + or error("Cannot chdir to $config{srcdir}: $!"); if (defined($config{mtnsync}) && $config{mtnsync}) { if (system("mtn", "--root=$config{mtnrootdir}", "sync", @@ -201,7 +248,8 @@ sub rcs_update () { #{{{ sub rcs_prepedit ($) { #{{{ my $file=shift; - check_config(); + chdir $config{srcdir} + or error("Cannot chdir to $config{srcdir}: $!"); # For monotone, return the revision of the file when # editing begins. @@ -229,7 +277,8 @@ sub rcs_commit ($$$;$$) { #{{{ $author="Web: Anonymous"; } - check_config(); + chdir $config{srcdir} + or error("Cannot chdir to $config{srcdir}: $!"); my ($oldrev)= $rcstoken=~ m/^($sha1_pattern)$/; # untaint my $rev = get_rev(); @@ -275,8 +324,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); @@ -299,9 +346,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!"); @@ -352,10 +401,41 @@ sub rcs_commit ($$$;$$) { #{{{ return undef # success } #}}} +sub rcs_commit_staged ($$$) { + # Commits all staged changes. Changes can be staged using rcs_add, + # rcs_remove, and rcs_rename. + my ($message, $user, $ipaddr)=@_; + + # Note - this will also commit any spurious changes that happen to be + # lying around in the working copy. There shouldn't be any, but... + + chdir $config{srcdir} + or error("Cannot chdir to $config{srcdir}: $!"); + + my $author; + + if (defined $user) { + $author="Web user: " . $user; + } + elsif (defined $ipaddr) { + $author="Web IP: " . $ipaddr; + } + else { + $author="Web: Anonymous"; + } + + if (system("mtn", "--root=$config{mtnrootdir}", "commit", "--quiet", + "--author", $author, "--key", $config{mtnkey}, "-m", + possibly_foolish_untaint($message)) != 0) { + error("Monotone commit failed"); + } +} + sub rcs_add ($) { #{{{ my $file=shift; - check_config(); + chdir $config{srcdir} + or error("Cannot chdir to $config{srcdir}: $!"); if (system("mtn", "--root=$config{mtnrootdir}", "add", "--quiet", $file) != 0) { @@ -363,11 +443,43 @@ sub rcs_add ($) { #{{{ } } #}}} +sub rcs_remove ($) { # {{{ + my $file = shift; + + chdir $config{srcdir} + or error("Cannot chdir to $config{srcdir}: $!"); + + # Note: it is difficult to undo a remove in Monotone at the moment. + # Until this is fixed, it might be better to make 'rm' move things + # into an attic, rather than actually remove them. + # To resurrect a file, you currently add a new file with the contents + # you want it to have. This loses all connectivity and automated + # merging with the 'pre-delete' versions of the file. + + if (system("mtn", "--root=$config{mtnrootdir}", "rm", "--quiet", + $file) != 0) { + error("Monotone remove failed"); + } +} #}}} + +sub rcs_rename ($$) { # {{{ + my ($src, $dest) = @_; + + chdir $config{srcdir} + or error("Cannot chdir to $config{srcdir}: $!"); + + if (system("mtn", "--root=$config{mtnrootdir}", "rename", "--quiet", + $src, $dest) != 0) { + error("Monotone rename failed"); + } +} #}}} + sub rcs_recentchanges ($) { #{{{ my $num=shift; my @ret; - check_config(); + chdir $config{srcdir} + or error("Cannot chdir to $config{srcdir}: $!"); # use log --brief to get a list of revs, as this # gives the results in a nice order @@ -470,10 +582,35 @@ sub rcs_recentchanges ($) { #{{{ return @ret; } #}}} +sub rcs_diff ($) { #{{{ + my $rev=shift; + my ($sha1) = $rev =~ /^($sha1_pattern)$/; # untaint + + chdir $config{srcdir} + or error("Cannot chdir to $config{srcdir}: $!"); + + my $child = open(MTNDIFF, "-|"); + if (! $child) { + exec("mtn", "diff", "--root=$config{mtnrootdir}", "-r", "p:".$sha1, "-r", $sha1) || error("mtn diff $sha1 failed to run"); + } + + my (@lines) = ; + + close MTNDIFF || debug("mtn diff $sha1 exited $?"); + + if (wantarray) { + return @lines; + } + else { + return join("", @lines); + } +} #}}} + sub rcs_getctime ($) { #{{{ my $file=shift; - check_config(); + chdir $config{srcdir} + or error("Cannot chdir to $config{srcdir}: $!"); my $child = open(MTNLOG, "-|"); if (! $child) { @@ -522,56 +659,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