6 use POSIX qw(setlocale LC_CTYPE);
10 my $tla_webcommit=qr/^web commit (by (\w+)|from (\d+\.\d+\.\d+\.\d+)):?(.*)/;
12 sub quiet_system (@) {
13 open (SAVEOUT, ">&STDOUT");
16 open (STDOUT, ">&SAVEOUT");
21 sub rcs_update () { #{{{
22 if (-d "$config{srcdir}/{arch}") {
23 if (quiet_system("tla", "replay", "-d", $config{srcdir}) != 0) {
24 warn("tla replay failed\n");
29 sub rcs_prepedit ($) { #{{{
32 if (-d "$config{srcdir}/{arch}") {
33 # For Arch, return the tree-id of archive when
35 my $rev=`tla tree-id $config{srcdir}`;
36 return defined $rev ? $rev : "";
40 sub rcs_commit ($$$) { #{{{
45 if (-d "$config{srcdir}/{arch}") {
46 # Check to see if the page has been changed by someone
47 # else since rcs_prepedit was called.
48 my ($oldrev)=$rcstoken=~/^([A-Za-z0-9@\/._-]+)$/; # untaint
49 my $rev=`tla tree-id $config{srcdir}`;
50 if (defined $rev && defined $oldrev && $rev ne $oldrev) {
51 # Merge their changes into the file that we've
53 if (system("tla", "update", "-d",
54 "$config{srcdir}/$file") != 0) {
55 warn("tla update failed\n");
59 if (quiet_system("tla", "commit",
60 "-L".possibly_foolish_untaint($message),
61 '-d', $config{srcdir}) != 0) {
62 my $conflict=readfile("$config{srcdir}/$file");
63 if (system("tla", "undo", "--quiet", "-d", "$config{srcdir}") != 0) {
64 warn("tla undo failed\n");
69 return undef # success
72 sub rcs_add ($) { #{{{
75 if (-d "$config{srcdir}/{arch}") {
76 if (quiet_system("tla", "add", "$config{srcdir}/$file") != 0) {
77 warn("tla add failed\n");
82 sub rcs_recentchanges ($) {
86 return unless -d "$config{srcdir}/{arch}";
88 eval q{use Date::Parse};
89 eval q{use Mail::Header};
91 my $logs = `tla logs -d $config{srcdir}`;
92 my @changesets = reverse split(/\n/, $logs);
94 for (my $i=0; $i<$num && $i<$#changesets; $i++) {
95 my ($change)=$changesets[$i]=~/^([A-Za-z0-9@\/._-]+)$/; # untaint
97 open(LOG, "tla cat-log -d $config{srcdir} $change|");
98 my $head = Mail::Header->new(\*LOG);
101 my $rev = $head->get("Revision");
102 my $summ = $head->get("Summary");
103 my $newfiles = $head->get("New-files");
104 my $modfiles = $head->get("Modified-files");
105 my $user = $head->get("Creator");
107 my @paths = grep {!/^.*\/\.arch-ids\/.*\.id$/} split(/ /,
108 "$newfiles $modfiles");
110 my $sdate = $head->get("Standard-date");
111 my $when = time - str2time($sdate, 'UTC');
113 my $committype = "web";
114 if (defined $summ && $summ =~ /$tla_webcommit/) {
115 $user = defined $2 ? "$2" : "$3";
123 push @message, { line => escapeHTML($summ) };
124 $user = escapeHTML($user);
128 foreach my $file (@paths) {
129 my $diffurl=$config{diffurl};
130 $diffurl=~s/\[\[file\]\]/$file/g;
131 $diffurl=~s/\[\[rev\]\]/$change/g;
133 page => pagename($file),
137 push @ret, { rev => $change,
139 committype => $committype,
141 message => [@message],
151 sub rcs_notify () { #{{{
153 if (! exists $ENV{REV}) {
154 error("REV is not set, not running from tla post-commit hook, cannot send notifications");
156 my $rev=int(possibly_foolish_untaint($ENV{REV}));
158 eval q{use Mail::Header};
159 open(LOG, $ENV{"ARCH_LOG"});
160 my $head = Mail::Header->new(\*LOG);
163 my $message = $head->get("Summary");
164 my $user = $head->get("Creator");
166 my $newfiles = $head->get("New-files");
167 my $modfiles = $head->get("Modified-files");
169 my @changed_pages = grep {!/^.*\/\.arch-ids\/.*\.id$/} split(/ /,
170 "$newfiles $modfiles");
172 if ($message =~ /$tla_webcommit/) {
173 $user=defined $2 ? "$2" : "$3";
177 require IkiWiki::UserInfo;
178 my @email_recipients=commit_notify_list($user, @changed_pages);
179 if (@email_recipients) {
180 # TODO: if a commit spans multiple pages, this will send
181 # subscribers a diff that might contain pages they did not
182 # sign up for. Should separate the diff per page and
183 # reassemble into one mail with just the pages subscribed to.
184 my $logs = `tla logs -d $config{srcdir}`;
185 my @changesets = reverse split(/\n/, $logs);
188 for($i=0;$i<$#changesets;$i++) {
189 last if $changesets[$i] eq $rev;
192 my $revminusone = $changesets[$i+1];
193 my $diff=`tla diff -d $ENV{ARCH_TREE_ROOT} $revminusone`;
195 my $subject="$config{wikiname} update of ";
196 if (@changed_pages > 2) {
197 $subject.="$changed_pages[0] $changed_pages[1] etc";
200 $subject.=join(" ", @changed_pages);
202 $subject.=" by $user";
204 my $template=template("notifymail.tmpl");
206 wikiname => $config{wikiname},
212 eval q{use Mail::Sendmail};
213 foreach my $email (@email_recipients) {
216 From => "$config{wikiname} <$config{adminemail}>",
218 Message => $template->output,
219 ) or error("Failed to send update notification mail");
224 sub rcs_getctime ($) { #{{{
226 eval q{use Date::Parse};
227 eval q{use Mail::Header};
229 my $logs = `tla logs -d $config{srcdir}`;
230 my @changesets = reverse split(/\n/, $logs);
233 for (my $i=0; $i<$#changesets; $i++) {
234 my $change = $changesets[$i];
236 open(LOG, "tla cat-log -d $config{srcdir} $change|");
237 my $head = Mail::Header->new(\*LOG);
240 $sdate = $head->get("Standard-date");
241 my $newfiles = $head->get("New-files");
243 my ($lastcreation) = grep {/^$file$/} split(/ /, "$newfiles");
244 last if defined($lastcreation);
247 my $date=str2time($sdate, 'UTC');
248 debug("found ctime ".localtime($date)." for $file");