diff options
| -rw-r--r-- | IkiWiki/Rcs/monotone.pm | 272 |
1 files changed, 129 insertions, 143 deletions
diff --git a/IkiWiki/Rcs/monotone.pm b/IkiWiki/Rcs/monotone.pm index 4709dc04f..be6b36c66 100644 --- a/IkiWiki/Rcs/monotone.pm +++ b/IkiWiki/Rcs/monotone.pm @@ -10,7 +10,7 @@ package IkiWiki; my $sha1_pattern = qr/[0-9a-fA-F]{40}/; # pattern to validate sha1sums -sub check_config() { +sub check_config() { #{{{ if (!defined($config{mtnrootdir})) { $config{mtnrootdir} = $config{srcdir}; } @@ -24,20 +24,20 @@ sub check_config() { chdir $config{srcdir} or error("Cannot chdir to $config{srcdir}: $!"); -} +} #}}} -sub get_rev () { +sub get_rev () { #{{{ my $sha1 = `mtn --root=$config{mtnrootdir} automate get_base_revision_id`; ($sha1) = $sha1 =~ m/($sha1_pattern)/; # sha1 is untainted now if (! $sha1) { - warn("Unable to get base revision for '$config{srcdir}'.") + debug("Unable to get base revision for '$config{srcdir}'.") } return $sha1; -} +} #}}} -sub get_rev_auto ($) { +sub get_rev_auto ($) { #{{{ my $automator=shift; my @results = $automator->call("get_base_revision_id"); @@ -45,27 +45,29 @@ sub get_rev_auto ($) { my $sha1 = $results[0]; ($sha1) = $sha1 =~ m/($sha1_pattern)/; # sha1 is untainted now if (! $sha1) { - warn("Unable to get base revision for '$config{srcdir}'.") + debug("Unable to get base revision for '$config{srcdir}'.") } return $sha1; -} - -sub mtn_merge ($$$$$) { - my $leftRev=shift; - my $rightRev=shift; - my $branch=shift; - my $author=shift; - my $message=shift; # ignored for the moment because mtn doesn't support it +} #}}} + +sub mtn_merge ($$$$) { #{{{ + my $leftRev=shift; + my $rightRev=shift; + my $branch=shift; + my $author=shift; - my $mergeRev; + 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, $branch, "--author", $author, "--key", $config{mtnkey}) || error("mtn merge failed to run"); + exec("mtn", "--root=$config{mtnrootdir}", "--rcfile", + $mergerc, "explicit_merge", $leftRev, $rightRev, + $branch, "--author", $author, "--key", + $config{mtnkey}) || error("mtn merge failed to run"); } while (<MTNMERGE>) { @@ -76,12 +78,12 @@ sub mtn_merge ($$$$$) { close MTNMERGE || return undef; - warn("merged $leftRev, $rightRev to make $mergeRev"); + debug("merged $leftRev, $rightRev to make $mergeRev"); return $mergeRev; -} +} #}}} -sub commit_file_to_new_rev($$$$$$$$) { +sub commit_file_to_new_rev($$$$$$$$) { #{{{ my $automator=shift; my $wsfilename=shift; my $oldFileID=shift; @@ -94,48 +96,51 @@ sub commit_file_to_new_rev($$$$$$$$) { #store the file my ($out, $err) = $automator->call("put_file", $oldFileID, $newFileContents); my ($newFileID) = ($out =~ m/^($sha1_pattern)$/); - error("Failed to store file data for $wsfilename in repository") if (!defined($newFileID) || 40 != length $newFileID); + error("Failed to store file data for $wsfilename in repository") + if (! defined $newFileID || length $newFileID != 40); # get the mtn filename rather than the workspace filename ($out, $err) = $automator->call("get_corresponding_path", $oldrev, $wsfilename, $oldrev); my ($filename) = ($out =~ m/^file "(.*)"$/); error("Couldn't find monotone repository path for file $wsfilename") if (! $filename); - warn("Converted ws filename of $wsfilename to repos filename of $filename"); + debug("Converted ws filename of $wsfilename to repos filename of $filename"); # then stick in a new revision for this file - my $manifest = "format_version \"1\"\n\n". - "new_manifest [0000000000000000000000000000000000000000]\n\n". - "old_revision [$oldrev]\n\n". - "patch \"$filename\"\n". - " from [$oldFileID]\n". - " to [$newFileID]\n"; + my $manifest = "format_version \"1\"\n\n". + "new_manifest [0000000000000000000000000000000000000000]\n\n". + "old_revision [$oldrev]\n\n". + "patch \"$filename\"\n". + " from [$oldFileID]\n". + " to [$newFileID]\n"; ($out, $err) = $automator->call("put_revision", $manifest); my ($newRevID) = ($out =~ m/^($sha1_pattern)$/); - error("Unable to make new monotone repository revision") if (!defined($newRevID) || 40 != length $newRevID); - warn("put revision: $newRevID"); + error("Unable to make new monotone repository revision") + if (! defined $newRevID || length $newRevID != 40); + debug("put revision: $newRevID"); # now we need to add certs for this revision... # author, branch, changelog, date $automator->call("cert", $newRevID, "author", $author); $automator->call("cert", $newRevID, "branch", $branch); $automator->call("cert", $newRevID, "changelog", $message); - $automator->call("cert", $newRevID, "date", time2str("%Y-%m-%dT%T", time, "UTC")); + $automator->call("cert", $newRevID, "date", + time2str("%Y-%m-%dT%T", time, "UTC")); - warn("Added certs for rev: $newRevID"); + debug("Added certs for rev: $newRevID"); return $newRevID; -} +} #}}} -sub check_mergerc() { +sub check_mergerc () { #{{{ my $mergerc = $config{mtnmergerc}; if (! -r $mergerc ) { - warn("$mergerc doesn't exist. Creating file with default mergers."); - open(my $out, ">$mergerc") or error("can't open $mergerc: $!"); + debug("$mergerc doesn't exist. Creating file with default mergers."); + open (my $out, ">", $mergerc) or error("can't open $mergerc: $!"); print $out <DATA>; close $out; } -} +} #}}} -sub read_certs ($$) { +sub read_certs ($$) { #{{{ my $automator=shift; my $rev=shift; my @results = $automator->call("certs", $rev); @@ -153,9 +158,9 @@ sub read_certs ($$) { } return @ret; -} +} #}}} -sub get_changed_files ($$) { +sub get_changed_files ($$) { #{{{ my $automator=shift; my $rev=shift; @@ -167,38 +172,33 @@ sub get_changed_files ($$) { while ($changes =~ m/\s*(add_file|patch|delete|rename)\s"(.*?)(?<!\\)"\n/sg) { my $file = $2; - if (! $seen{$file}) { # don't add the same file multiple times + # don't add the same file multiple times + if (! $seen{$file}) { push @ret, $file; $seen{$file} = 1; } } return @ret; -} - -# The following functions are the ones actually called by Ikiwiki - -sub rcs_update () { - # Update working directory to current version. +} #}}} +sub rcs_update () { #{{{ check_config(); if (defined($config{mtnsync}) && $config{mtnsync}) { - if (system("mtn", "--root=$config{mtnrootdir}", "sync", "--quiet", "--ticker=none", "--key", $config{mtnkey}) != 0) { - warn("monotone sync failed before update\n"); + if (system("mtn", "--root=$config{mtnrootdir}", "sync", + "--quiet", "--ticker=none", + "--key", $config{mtnkey}) != 0) { + debug("monotone sync failed before update"); } } if (system("mtn", "--root=$config{mtnrootdir}", "update", "--quiet") != 0) { - warn("monotone update failed\n"); + debug("monotone update failed"); } -} +} #}}} -sub rcs_prepedit ($) { - # Prepares to edit a file under revision control. Returns a token - # that must be passed into rcs_commit when the file is ready - # for committing. - # The file is relative to the srcdir. +sub rcs_prepedit ($) { #{{{ my $file=shift; check_config(); @@ -206,9 +206,9 @@ sub rcs_prepedit ($) { # For monotone, return the revision of the file when # editing begins. return get_rev(); -} +} #}}} -sub rcs_commit ($$$;$$) { +sub rcs_commit ($$$;$$) { #{{{ # Tries to commit the page; returns undef on _success_ and # a version of the page with the rcs's conflict markers on failure. # The file is relative to the srcdir. @@ -248,11 +248,11 @@ sub rcs_commit ($$$;$$) { my $diff = `mtn --root=$config{mtnrootdir} au content_diff -r $oldrev -r $rev $file`; # was just $out; if ($diff) { - # this file has changed - # commit a revision with just this file changed off - # the old revision + # Commit a revision with just this file changed off + # the old revision. + # # first get the contents - warn("File changed: forming branch\n"); + debug("File changed: forming branch"); my $newfile=readfile("$config{srcdir}/$file"); # then get the old content ID from the diff @@ -274,52 +274,57 @@ sub rcs_commit ($$$;$$) { # if we made it to here then the file has been committed... revert the local copy if (system("mtn", "--root=$config{mtnrootdir}", "revert", $file) != 0) { - warn("Unable to revert $file after merge on conflicted commit!"); + debug("Unable to revert $file after merge on conflicted commit!"); } - warn("Divergence created! Attempting auto-merge."); + 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, "Auto-merging parallel web edits."); + my $mergeResult = mtn_merge($newRevID, $rev, $branch, $author); $ENV{MTN_MERGE}=""; # push any changes so far if (defined($config{mtnsync}) && $config{mtnsync}) { if (system("mtn", "--root=$config{mtnrootdir}", "push", "--quiet", "--ticker=none", "--key", $config{mtnkey}) != 0) { - warn("monotone push failed\n"); + debug("monotone push failed"); } } if (defined($mergeResult)) { # everything is merged - bring outselves up to date - if (system("mtn", "--root=$config{mtnrootdir}", "update", "-r", $mergeResult) != 0) { - warn("Unable to update to rev $mergeResult after merge on conflicted commit!"); + if (system("mtn", "--root=$config{mtnrootdir}", + "update", "-r", $mergeResult) != 0) { + debug("Unable to update to rev $mergeResult after merge on conflicted commit!"); } - } else { - warn("Auto-merge failed. Using diff-merge to add conflict markers."); + } + else { + debug("Auto-merge failed. Using diff-merge to add conflict markers."); $ENV{MTN_MERGE}="diffutils_force"; - $mergeResult = mtn_merge($newRevID, $rev, $branch, $author, "Merge parallel conflicting web edits (adding inline conflict markers).\nThis revision should be cleaned up manually."); + $mergeResult = mtn_merge($newRevID, $rev, $branch, $author); $ENV{MTN_MERGE}=""; if (!defined($mergeResult)) { - warn("Unable to insert conflict markers!"); - error("Your commit succeeded. Unfortunately, someone else committed something to the same\n". - "part of the wiki at the same time. Both versions are stored in the monotone repository,\n". - "but at present the different versions cannot be reconciled through the web interface.\n\n". - "Please use the non-web interface to resolve the conflicts.\n"); + debug("Unable to insert conflict markers!"); + error("Your commit succeeded. Unfortunately, someone else committed something to the same ". + "part of the wiki at the same time. Both versions are stored in the monotone repository, ". + "but at present the different versions cannot be reconciled through the web interface. ". + "Please use the non-web interface to resolve the conflicts."); } - # suspend this revision because it has conflict markers... - if (system("mtn", "--root=$config{mtnrootdir}", "update", "-r", $mergeResult) != 0) { - warn("Unable to update to rev $mergeResult after conflict-enhanced merge on conflicted commit!"); + # suspend this revision because it has + # conflict markers... + if (system("mtn", "--root=$config{mtnrootdir}", + "update", "-r", $mergeResult) != 0) { + debug("Unable to update to rev $mergeResult after conflict-enhanced merge on conflicted commit!"); } - # return "conflict enhanced" file to the user for cleanup - # note, this relies on the fact that ikiwiki seems to call rcs_prepedit() again - # after we return + # return "conflict enhanced" file to the user + # for cleanup note, this relies on the fact + # that ikiwiki seems to call rcs_prepedit() + # again after we return return readfile("$config{srcdir}/$file"); } return undef; @@ -327,59 +332,43 @@ sub rcs_commit ($$$;$$) { $automator->close(); } - # if we reached here then the file we're looking at hasn't changed since $oldrev. Commit it. + # If we reached here then the file we're looking at hasn't changed + # since $oldrev. Commit it. - if (system("mtn", "--root=$config{mtnrootdir}", "commit", "--quiet", "--author", $author, "--key", $config{mtnkey}, - "-m", possibly_foolish_untaint($message), $file) != 0) { - warn("Traditional commit failed!\nReturning data as conflict.\n"); + if (system("mtn", "--root=$config{mtnrootdir}", "commit", "--quiet", + "--author", $author, "--key", $config{mtnkey}, "-m", + possibly_foolish_untaint($message), $file) != 0) { + debug("Traditional commit failed! Returning data as conflict."); my $conflict=readfile("$config{srcdir}/$file"); - if (system("mtn", "--root=$config{mtnrootdir}", "revert", "--quiet", $file) != 0) { - warn("monotone revert failed\n"); + if (system("mtn", "--root=$config{mtnrootdir}", "revert", + "--quiet", $file) != 0) { + debug("monotone revert failed"); } return $conflict; } if (defined($config{mtnsync}) && $config{mtnsync}) { - if (system("mtn", "--root=$config{mtnrootdir}", "sync", "--quiet", "--ticker=none", "--key", $config{mtnkey}) != 0) { - warn("monotone sync failed\n"); + if (system("mtn", "--root=$config{mtnrootdir}", "sync", + "--quiet", "--ticker=none", "--key", + $config{mtnkey}) != 0) { + debug("monotone sync failed"); } } return undef # success -} +} #}}} -sub rcs_add ($) { - # Add a file. The filename is relative to the root of the srcdir. +sub rcs_add ($) { #{{{ my $file=shift; check_config(); - if (system("mtn", "--root=$config{mtnrootdir}", "add", "--quiet", "$config{srcdir}/$file") != 0) { + if (system("mtn", "--root=$config{mtnrootdir}", "add", "--quiet", + "$config{srcdir}/$file") != 0) { error("Monotone add failed"); } -} - -sub rcs_recentchanges ($) { - # Examine the RCS history and generate a list of recent changes. - # The data structure returned for each change is: - # { - # user => # name of user who made the change, - # committype => # either "web" or the name of the rcs, - # when => # time when the change was made, - # message => [ - # { line => "commit message line" }, - # { line => "commit message line" }, - # # etc, - # ], - # pages => [ - # { - # page => # name of page changed, - # diffurl => # optional url to a diff showing - # # the changes, - # }, - # # repeat for each page changed in this commit, - # ], - # } +} #}}} +sub rcs_recentchanges ($) { #{{{ my $num=shift; my @ret; @@ -393,18 +382,17 @@ sub rcs_recentchanges ($) { my $child = open(MTNLOG, "-|"); if (! $child) { - exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph", "--brief") || error("mtn log failed to run"); + exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph", + "--brief") || error("mtn log failed to run"); } - my $line; - - while (($num >= 0) and ($line = <MTNLOG>)) { + while (($num >= 0) and (my $line = <MTNLOG>)) { if ($line =~ m/^($sha1_pattern)/) { push @revs, $1; $num -= 1; } } - close MTNLOG || warn "mtn log exited $?"; + close MTNLOG || debug("mtn log exited $?"); my $automator = Monotone->new(); $automator->open(undef, $config{mtnrootdir}); @@ -421,10 +409,12 @@ sub rcs_recentchanges ($) { my (@pages, @message); foreach my $cert (@$certs) { - if ($cert->{signature} eq "ok" && $cert->{trust} eq "trusted") { + if ($cert->{signature} eq "ok" && + $cert->{trust} eq "trusted") { if ($cert->{name} eq "author") { $user = $cert->{value}; - # detect the source of the commit from the changelog + # detect the source of the commit + # from the changelog if ($cert->{key} eq $config{mtnkey}) { $committype = "web"; } else { @@ -434,7 +424,8 @@ sub rcs_recentchanges ($) { $when = time - str2time($cert->{value}, 'UTC'); } elsif ($cert->{name} eq "changelog") { my $messageText = $cert->{value}; - # split the changelog into multiple lines + # split the changelog into multiple + # lines foreach my $msgline (split(/\n/, $messageText)) { push @message, { line => $msgline }; } @@ -464,15 +455,10 @@ sub rcs_recentchanges ($) { $automator->close(); return @ret; -} +} #}}} -sub rcs_notify () { - # This function is called when a change is committed to the wiki, - # and ikiwiki is running as a post-commit hook from the RCS. - # It should examine the repository to somehow determine what pages - # changed, and then send emails to users subscribed to those pages. - - warn("The monotone rcs_notify function is currently untested. Use at own risk!"); +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")); @@ -515,19 +501,19 @@ sub rcs_notify () { }, sub { `mtn --root=$config{mtnrootdir} au content_diff -r $rev`; - }, $user, @changed_pages); -} + }, + $user, @changed_pages); +} #}}} -sub rcs_getctime ($) { - # Optional, used to get the page creation time from the RCS. - # error gettext("getctime not implemented"); +sub rcs_getctime ($) { #{{{ my $file=shift; check_config(); my $child = open(MTNLOG, "-|"); if (! $child) { - exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph", "--brief", $file) || error("mtn log $file failed to run"); + exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph", + "--brief", $file) || error("mtn log $file failed to run"); } my $firstRev; @@ -536,10 +522,10 @@ sub rcs_getctime ($) { $firstRev=$1; } } - close MTNLOG || warn "mtn log $file exited $?"; + close MTNLOG || debug("mtn log $file exited $?"); if (! defined $firstRev) { - warn "failed to parse mtn log for $file\n"; + debug "failed to parse mtn log for $file"; return 0; } @@ -561,14 +547,14 @@ sub rcs_getctime ($) { } if (! defined $date) { - warn "failed to find date cert for revision $firstRev when looking for creation time of $file\n"; + debug "failed to find date cert for revision $firstRev when looking for creation time of $file"; return 0; } $date=str2time($date, 'UTC'); debug("found ctime ".localtime($date)." for $file"); return $date; -} +} #}}} 1 |