From 38353384cf7ccb4cbc81e77f82875d8a959fbea7 Mon Sep 17 00:00:00 2001 From: joey Date: Tue, 21 Aug 2007 03:58:00 +0000 Subject: minor changes (but lots of them) --- IkiWiki/Rcs/monotone.pm | 272 +++++++++++++++++++++++------------------------- 1 file changed, 129 insertions(+), 143 deletions(-) (limited to 'IkiWiki') 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 () { @@ -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 ; 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"(.*?)(?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 = )) { + while (($num >= 0) and (my $line = )) { 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 -- cgit v1.2.3