X-Git-Url: http://git.vanrenterghem.biz/git.ikiwiki.info.git/blobdiff_plain/99d52a1794f25ee2efc7a580e8e9bc8819811bd9..b277e00d4ec2dc3b50a111957b7fbd0c5ac7bbd9:/IkiWiki/Rcs/tla.pm?ds=sidebyside diff --git a/IkiWiki/Rcs/tla.pm b/IkiWiki/Rcs/tla.pm index 0f62dfa83..4232e1fe8 100644 --- a/IkiWiki/Rcs/tla.pm +++ b/IkiWiki/Rcs/tla.pm @@ -1,18 +1,18 @@ #!/usr/bin/perl +package IkiWiki; + use warnings; use strict; use IkiWiki; -use POSIX qw(setlocale LC_CTYPE); - -package IkiWiki; - -my $tla_webcommit=qr/^web commit (by (\w+)|from (\d+\.\d+\.\d+\.\d+)):?(.*)/; sub quiet_system (@) { + # See Debian bug #385939. open (SAVEOUT, ">&STDOUT"); close STDOUT; + open (STDOUT, ">/dev/null"); my $ret=system(@_); + close STDOUT; open (STDOUT, ">&SAVEOUT"); close SAVEOUT; return $ret; @@ -37,10 +37,19 @@ sub rcs_prepedit ($) { #{{{ } } #}}} -sub rcs_commit ($$$) { #{{{ +sub rcs_commit ($$$;$$) { #{{{ my $file=shift; my $message=shift; my $rcstoken=shift; + my $user=shift; + my $ipaddr=shift; + + if (defined $user) { + $message="web commit by $user".(length $message ? ": $message" : ""); + } + elsif (defined $ipaddr) { + $message="web commit from $ipaddr".(length $message ? ": $message" : ""); + } if (-d "$config{srcdir}/{arch}") { # Check to see if the page has been changed by someone @@ -50,8 +59,8 @@ sub rcs_commit ($$$) { #{{{ if (defined $rev && defined $oldrev && $rev ne $oldrev) { # Merge their changes into the file that we've # changed. - if (system("tla", "update", "-d", - "$config{srcdir}/$file") != 0) { + if (quiet_system("tla", "update", "-d", + "$config{srcdir}") != 0) { warn("tla update failed\n"); } } @@ -60,7 +69,7 @@ sub rcs_commit ($$$) { #{{{ "-L".possibly_foolish_untaint($message), '-d', $config{srcdir}) != 0) { my $conflict=readfile("$config{srcdir}/$file"); - if (system("tla", "undo", "--quiet", "-d", "$config{srcdir}") != 0) { + if (system("tla", "undo", "-n", "--quiet", "-d", "$config{srcdir}") != 0) { warn("tla undo failed\n"); } return $conflict; @@ -69,6 +78,14 @@ 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)=@_; + + error("rcs_commit_staged not implemented for tla"); # TODO +} + sub rcs_add ($) { #{{{ my $file=shift; @@ -79,6 +96,18 @@ sub rcs_add ($) { #{{{ } } #}}} +sub rcs_remove ($) { # {{{ + my $file = shift; + + error("rcs_remove not implemented for tla"); # TODO +} #}}} + +sub rcs_rename ($$) { # {{{a + my ($src, $dest) = @_; + + error("rcs_rename not implemented for tla"); # TODO +} #}}} + sub rcs_recentchanges ($) { my $num=shift; my @ret; @@ -86,7 +115,9 @@ sub rcs_recentchanges ($) { return unless -d "$config{srcdir}/{arch}"; eval q{use Date::Parse}; + error($@) if $@; eval q{use Mail::Header}; + error($@) if $@; my $logs = `tla logs -d $config{srcdir}`; my @changesets = reverse split(/\n/, $logs); @@ -102,16 +133,17 @@ sub rcs_recentchanges ($) { my $summ = $head->get("Summary"); my $newfiles = $head->get("New-files"); my $modfiles = $head->get("Modified-files"); + my $remfiles = $head->get("Removed-files"); my $user = $head->get("Creator"); - my @paths = grep {!/^.*\/\.arch-ids\/.*\.id$/} split(/ /, - "$newfiles $modfiles"); + my @paths = grep { !/^(.*\/)?\.arch-ids\/.*\.id$/ } + 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 =~ /$tla_webcommit/) { + if (defined $summ && $summ =~ /$config{web_commit_regexp}/) { $user = defined $2 ? "$2" : "$3"; $summ = $4; } @@ -120,8 +152,7 @@ sub rcs_recentchanges ($) { } my @message; - push @message, { line => escapeHTML($summ) }; - $user = escapeHTML($user); + push @message, { line => $summ }; my @pages; @@ -134,7 +165,8 @@ sub rcs_recentchanges ($) { diffurl => $diffurl, } if length $file; } - push @ret, { rev => $change, + push @ret, { + rev => $change, user => $user, committype => $committype, when => $when, @@ -148,83 +180,26 @@ sub rcs_recentchanges ($) { return @ret; } -sub rcs_notify () { #{{{ - # FIXME: Not set - if (! exists $ENV{REV}) { - error("REV 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}; - open(LOG, $ENV{"ARCH_LOG"}); - my $head = Mail::Header->new(\*LOG); - close(LOG); - - my $message = $head->get("Summary"); - my $user = $head->get("Creator"); - - my $newfiles = $head->get("New-files"); - my $modfiles = $head->get("Modified-files"); - - my @changed_pages = grep {!/^.*\/\.arch-ids\/.*\.id$/} split(/ /, - "$newfiles $modfiles"); +sub rcs_diff ($) { #{{{ + my $rev=shift; + my $logs = `tla logs -d $config{srcdir}`; + my @changesets = reverse split(/\n/, $logs); + my $i; - if ($message =~ /$tla_webcommit/) { - $user=defined $2 ? "$2" : "$3"; - $message=$4; + for($i=0;$i<$#changesets;$i++) { + last if $changesets[$i] eq $rev; } - require IkiWiki::UserInfo; - my @email_recipients=commit_notify_list($user, @changed_pages); - if (@email_recipients) { - # TODO: if a commit spans multiple pages, this will send - # subscribers a diff that might contain pages they did not - # sign up for. Should separate the diff per page and - # reassemble into one mail with just the pages subscribed to. - 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]; - my $diff=`tla diff -d $ENV{ARCH_TREE_ROOT} $revminusone`; - - my $subject="$config{wikiname} update of "; - if (@changed_pages > 2) { - $subject.="$changed_pages[0] $changed_pages[1] etc"; - } - else { - $subject.=join(" ", @changed_pages); - } - $subject.=" by $user"; - - my $template=template("notifymail.tmpl"); - $template->param( - wikiname => $config{wikiname}, - diff => $diff, - user => $user, - message => $message, - ); - - eval q{use Mail::Sendmail}; - foreach my $email (@email_recipients) { - sendmail( - To => $email, - From => "$config{wikiname} <$config{adminemail}>", - Subject => $subject, - Message => $template->output, - ) or error("Failed to send update notification mail"); - } - } + my $revminusone = $changesets[$i+1]; + return `tla diff -d $config{srcdir} $revminusone`; } #}}} sub rcs_getctime ($) { #{{{ my $file=shift; eval q{use Date::Parse}; + error($@) if $@; eval q{use Mail::Header}; + error($@) if $@; my $logs = `tla logs -d $config{srcdir}`; my @changesets = reverse split(/\n/, $logs);