diff options
Diffstat (limited to 'IkiWiki/Rcs')
| -rw-r--r-- | IkiWiki/Rcs/Stub.pm | 8 | ||||
| -rw-r--r-- | IkiWiki/Rcs/bzr.pm | 166 | ||||
| -rw-r--r-- | IkiWiki/Rcs/git.pm | 48 | ||||
| -rw-r--r-- | IkiWiki/Rcs/mercurial.pm | 6 | ||||
| -rw-r--r-- | IkiWiki/Rcs/monotone.pm | 79 | ||||
| -rw-r--r-- | IkiWiki/Rcs/svn.pm | 43 | ||||
| -rw-r--r-- | IkiWiki/Rcs/tla.pm | 50 |
7 files changed, 199 insertions, 201 deletions
diff --git a/IkiWiki/Rcs/Stub.pm b/IkiWiki/Rcs/Stub.pm index 19ecfa88d..df347f6a9 100644 --- a/IkiWiki/Rcs/Stub.pm +++ b/IkiWiki/Rcs/Stub.pm @@ -37,6 +37,7 @@ sub rcs_recentchanges ($) { # Examine the RCS history and generate a list of recent changes. # The data structure returned for each change is: # { + # rev => # the RCSs id for this commit # user => # name of user who made the change, # committype => # either "web" or the name of the rcs, # when => # time when the change was made, @@ -56,13 +57,6 @@ sub rcs_recentchanges ($) { # } } -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. -} - sub rcs_getctime ($) { # Optional, used to get the page creation time from the RCS. error gettext("getctime not implemented"); diff --git a/IkiWiki/Rcs/bzr.pm b/IkiWiki/Rcs/bzr.pm new file mode 100644 index 000000000..a04bfe1cb --- /dev/null +++ b/IkiWiki/Rcs/bzr.pm @@ -0,0 +1,166 @@ +#!/usr/bin/perl + +use warnings; +use strict; +use IkiWiki; +use Encode; +use open qw{:utf8 :std}; + +package IkiWiki; + +sub bzr_log ($) { #{{{ + my $out = shift; + my @infos = (); + my $key = undef; + + while (<$out>) { + my $line = $_; + my ($value); + if ($line =~ /^message:/) { + $key = "message"; + $infos[$#infos]{$key} = ""; + } + elsif ($line =~ /^(modified|added|renamed|renamed and modified|removed):/) { + $key = "files"; + unless (defined($infos[$#infos]{$key})) { $infos[$#infos]{$key} = ""; } + } + elsif (defined($key) and $line =~ /^ (.*)/) { + $infos[$#infos]{$key} .= $1; + } + elsif ($line eq "------------------------------------------------------------\n") { + $key = undef; + push (@infos, {}); + } + else { + chomp $line; + ($key, $value) = split /: +/, $line, 2; + $infos[$#infos]{$key} = $value; + } + } + close $out; + + return @infos; +} #}}} + +sub rcs_update () { #{{{ + my @cmdline = ("bzr", $config{srcdir}, "update"); + if (system(@cmdline) != 0) { + warn "'@cmdline' failed: $!"; + } +} #}}} + +sub rcs_prepedit ($) { #{{{ + return ""; +} #}}} + +sub rcs_commit ($$$;$$) { #{{{ + my ($file, $message, $rcstoken, $user, $ipaddr) = @_; + + if (defined $user) { + $user = possibly_foolish_untaint($user); + } + elsif (defined $ipaddr) { + $user = "Anonymous from ".possibly_foolish_untaint($ipaddr); + } + else { + $user = "Anonymous"; + } + + $message = possibly_foolish_untaint($message); + if (! length $message) { + $message = "no message given"; + } + + my @cmdline = ("bzr", "commit", "-m", $message, "--author", $user, + $config{srcdir}."/".$file); + if (system(@cmdline) != 0) { + warn "'@cmdline' failed: $!"; + } + + return undef; # success +} #}}} + +sub rcs_add ($) { # {{{ + my ($file) = @_; + + my @cmdline = ("bzr", "add", "$config{srcdir}/$file"); + if (system(@cmdline) != 0) { + warn "'@cmdline' failed: $!"; + } +} #}}} + +sub rcs_recentchanges ($) { #{{{ + my ($num) = @_; + + eval q{use CGI 'escapeHTML'}; + error($@) if $@; + + my @cmdline = ("bzr", "log", "-v", "--show-ids", "--limit", $num, + $config{srcdir}); + open (my $out, "@cmdline |"); + + eval q{use Date::Parse}; + error($@) if $@; + + my @ret; + foreach my $info (bzr_log($out)) { + my @pages = (); + my @message = (); + + foreach my $msgline (split(/\n/, $info->{message})) { + push @message, { line => $msgline }; + } + + foreach my $file (split(/\n/, $info->{files})) { + my ($filename, $fileid) = split(/[ \t]+/, $file); + my $diffurl = $config{'diffurl'}; + $diffurl =~ s/\[\[file\]\]/$filename/go; + $diffurl =~ s/\[\[file-id\]\]/$fileid/go; + $diffurl =~ s/\[\[r2\]\]/$info->{revno}/go; + + push @pages, { + page => pagename($filename), + diffurl => $diffurl, + }; + } + + my $user = $info->{"committer"}; + if (defined($info->{"author"})) { $user = $info->{"author"}; } + $user =~ s/\s*<.*>\s*$//; + $user =~ s/^\s*//; + + push @ret, { + rev => $info->{"revno"}, + user => $user, + committype => "bzr", + when => time - str2time($info->{"timestamp"}), + message => [@message], + pages => [@pages], + }; + } + + return @ret; +} #}}} + +sub rcs_getctime ($) { #{{{ + my ($file) = @_; + + # XXX filename passes through the shell here, should try to avoid + # that just in case + my @cmdline = ("bzr", "log", "--limit", '1', "$config{srcdir}/$file"); + open (my $out, "@cmdline |"); + + my @log = bzr_log($out); + + if (length @log < 1) { + return 0; + } + + eval q{use Date::Parse}; + error($@) if $@; + + my $ctime = str2time($log[0]->{"timestamp"}); + return $ctime; +} #}}} + +1 diff --git a/IkiWiki/Rcs/git.pm b/IkiWiki/Rcs/git.pm index fea1c11eb..26a6f4266 100644 --- a/IkiWiki/Rcs/git.pm +++ b/IkiWiki/Rcs/git.pm @@ -247,8 +247,6 @@ sub _parse_diff_tree ($@) { #{{{ last; } - debug("No detail in diff-tree output") if !defined $ci{'details'}; - return \%ci; } #}}} @@ -374,7 +372,7 @@ sub rcs_recentchanges ($) { #{{{ my ($sha1, $when) = ( $ci->{'sha1'}, - time - $ci->{'author_epoch'} + $ci->{'author_epoch'} ); my (@pages, @messages); @@ -421,50 +419,6 @@ sub rcs_recentchanges ($) { #{{{ return @rets; } #}}} -sub rcs_notify () { #{{{ - # Send notification mail to subscribed users. - # - # In usual Git usage, hooks/update script is presumed to send - # notification mails (see git-receive-pack(1)). But we prefer - # hooks/post-update to support IkiWiki commits coming from a - # cloned repository (through command line) because post-update - # is called _after_ each ref in repository is updated (update - # hook is called _before_ the repository is updated). Since - # post-update hook does not accept command line arguments, we - # don't have an $ENV variable in this function. - # - # Here, we rely on a simple fact: we can extract all parts of the - # notification content by parsing the "HEAD" commit (which also - # triggers a refresh of IkiWiki pages). - - my $ci = git_commit_info('HEAD'); - return if !defined $ci; - - my @changed_pages = map { $_->{'file'} } @{ $ci->{'details'} }; - - my ($user, $message); - if (@{ $ci->{'comment'} }[0] =~ m/$config{web_commit_regexp}/) { - $user = defined $2 ? "$2" : "$3"; - $message = $4; - } - else { - $user = $ci->{'author_username'}; - $message = join "\n", @{ $ci->{'comment'} }; - } - - my $sha1 = $ci->{'sha1'}; - - require IkiWiki::UserInfo; - send_commit_mails( - sub { - $message; - }, - sub { - join "\n", run_or_die('git', 'diff', "${sha1}^", $sha1); - }, $user, @changed_pages - ); -} #}}} - sub rcs_getctime ($) { #{{{ my $file=shift; # Remove srcdir prefix diff --git a/IkiWiki/Rcs/mercurial.pm b/IkiWiki/Rcs/mercurial.pm index 15edb3245..db6a396ac 100644 --- a/IkiWiki/Rcs/mercurial.pm +++ b/IkiWiki/Rcs/mercurial.pm @@ -142,7 +142,7 @@ sub rcs_recentchanges ($) { #{{{ rev => $info->{"changeset"}, user => $user, committype => "mercurial", - when => time - str2time($info->{"date"}), + when => str2time($info->{"date"}), message => [@message], pages => [@pages], }; @@ -151,10 +151,6 @@ sub rcs_recentchanges ($) { #{{{ return @ret; } #}}} -sub rcs_notify () { #{{{ - # TODO -} #}}} - sub rcs_getctime ($) { #{{{ my ($file) = @_; diff --git a/IkiWiki/Rcs/monotone.pm b/IkiWiki/Rcs/monotone.pm index 5717e0043..c4a6d9864 100644 --- a/IkiWiki/Rcs/monotone.pm +++ b/IkiWiki/Rcs/monotone.pm @@ -342,10 +342,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"); } } @@ -416,7 +416,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 @@ -431,10 +431,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, { @@ -452,54 +470,6 @@ 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_getctime ($) { #{{{ my $file=shift; @@ -604,4 +574,3 @@ __DATA__ return true end } -EOF diff --git a/IkiWiki/Rcs/svn.pm b/IkiWiki/Rcs/svn.pm index 987469ba0..f7d2242f0 100644 --- a/IkiWiki/Rcs/svn.pm +++ b/IkiWiki/Rcs/svn.pm @@ -171,7 +171,7 @@ sub rcs_recentchanges ($) { #{{{ my $rev = $logentry->{revision}; my $user = $logentry->{author}; - my $when=time - str2time($logentry->{date}, 'UTC'); + my $when=str2time($logentry->{date}, 'UTC'); foreach my $msgline (split(/\n/, $logentry->{msg})) { push @message, { line => $msgline }; @@ -203,7 +203,8 @@ sub rcs_recentchanges ($) { #{{{ diffurl => $diffurl, } if length $file; } - push @ret, { rev => $rev, + push @ret, { + rev => $rev, user => $user, committype => $committype, when => $when, @@ -216,44 +217,6 @@ sub rcs_recentchanges ($) { #{{{ return @ret; } #}}} -sub rcs_notify () { #{{{ - if (! exists $ENV{REV}) { - error(gettext("REV is not set, not running from svn post-commit hook, cannot send notifications")); - } - my $rev=int(possibly_foolish_untaint($ENV{REV})); - - my $user=`svnlook author $config{svnrepo} -r $rev`; - chomp $user; - - my $message=`svnlook log $config{svnrepo} -r $rev`; - if ($message=~/$config{web_commit_regexp}/) { - $user=defined $2 ? "$2" : "$3"; - $message=$4; - } - - my @changed_pages; - foreach my $change (`svnlook changed $config{svnrepo} -r $rev`) { - chomp $change; - if (length $config{svnpath}) { - if ($change =~ /^[A-Z]+\s+\Q$config{svnpath}\E\/(.*)/) { - push @changed_pages, $1; - } - } - else { - push @changed_pages, $change; - } - } - - require IkiWiki::UserInfo; - send_commit_mails( - sub { - return $message; - }, - sub { - `svnlook diff $config{svnrepo} -r $rev --no-diff-deleted`; - }, $user, @changed_pages); -} #}}} - sub rcs_getctime ($) { #{{{ my $file=shift; diff --git a/IkiWiki/Rcs/tla.pm b/IkiWiki/Rcs/tla.pm index 1dbc006c1..ecc561bde 100644 --- a/IkiWiki/Rcs/tla.pm +++ b/IkiWiki/Rcs/tla.pm @@ -120,7 +120,7 @@ sub rcs_recentchanges ($) { split(/ /, "$newfiles $modfiles .arch-ids/fake.id"); my $sdate = $head->get("Standard-date"); - my $when = time - str2time($sdate, 'UTC'); + my $when = str2time($sdate, 'UTC'); my $committype = "web"; if (defined $summ && $summ =~ /$config{web_commit_regexp}/) { @@ -145,7 +145,8 @@ sub rcs_recentchanges ($) { diffurl => $diffurl, } if length $file; } - push @ret, { rev => $change, + push @ret, { + rev => $change, user => $user, committype => $committype, when => $when, @@ -159,51 +160,6 @@ sub rcs_recentchanges ($) { return @ret; } -sub rcs_notify () { #{{{ - # FIXME: Not set - if (! exists $ENV{ARCH_VERSION}) { - error("ARCH_VERSION is not set, not running from tla post-commit hook, cannot send notifications"); - } - my $rev=int(possibly_foolish_untaint($ENV{REV})); - - eval q{use Mail::Header}; - error($@) if $@; - open(LOG, $ENV{"ARCH_LOG"}); - my $head = Mail::Header->new(\*LOG); - close(LOG); - - my $user = $head->get("Creator"); - - my $newfiles = $head->get("New-files"); - my $modfiles = $head->get("Modified-files"); - my $remfiles = $head->get("Removed-files"); - - my @changed_pages = grep { !/(^.*\/)?\.arch-ids\/.*\.id$/ } - split(/ /, "$newfiles $modfiles $remfiles .arch-ids/fake.id"); - - require IkiWiki::UserInfo; - send_commit_mails( - sub { - my $message = $head->get("Summary"); - if ($message =~ /$config{web_commit_regexp}/) { - $user=defined $2 ? "$2" : "$3"; - $message=$4; - } - }, - sub { - my $logs = `tla logs -d $config{srcdir}`; - my @changesets = reverse split(/\n/, $logs); - my $i; - - for($i=0;$i<$#changesets;$i++) { - last if $changesets[$i] eq $rev; - } - - my $revminusone = $changesets[$i+1]; - `tla diff -d $ENV{ARCH_TREE_ROOT} $revminusone`; - }, $user, @changed_pages); -} #}}} - sub rcs_getctime ($) { #{{{ my $file=shift; eval q{use Date::Parse}; |