Also look in the next-highest directory when detecting VCS; add SVN
[interchange.git] / code / UserTag / email_raw.tag
1 # Copyright 2002-2007 Interchange Development Group and others
2
3 # This program is free software; you can redistribute it and/or modify
4 # it under the terms of the GNU General Public License as published by
5 # the Free Software Foundation; either version 2 of the License, or
6 # (at your option) any later version.  See the LICENSE file for details.
7
8 UserTag email-raw hasEndTag
9 UserTag email-raw addAttr
10 UserTag email-raw Interpolate
11 UserTag email-raw Version     1.8
12 UserTag email-raw Routine     <<EOR
13 sub {
14     my($opt, $body) = @_;
15     my($ok);
16     $body =~ s/^\s+//;
17
18         # If configured, intercept all outgoing email and re-route
19         if (
20                 my $intercept = $::Variable->{MV_EMAIL_INTERCEPT}
21                                 || $Global::Variable->{MV_EMAIL_INTERCEPT}
22         ) {
23                 $body =~ s/\A(.*?)\r?\n\r?\n//s;
24                 my $header_block = $1;
25                 # unfold valid RFC 2822 "2.2.3. Long Header Fields"
26                 $header_block =~ s/\r?\n([ \t]+)/$1/g;
27                 my @headers;
28                 for (split /\r?\n/, $header_block) {
29                         if (my ($header, $value) = /^(To|Cc|Bcc):\s*(.+)/si) {
30                                 logError(
31                                         "Intercepting outgoing email (%s: %s) and instead sending to '%s'",
32                                         $header, $value, $intercept
33                                 );
34                                 $_ = "$header: $intercept";
35                                 push @headers, "X-Intercepted-$header: $value";
36                         }
37                         push @headers, $_;
38                 }
39                 $body = join("\n", @headers) . "\n\n" . $body;
40         }
41
42     SEND: {
43         my $using = $Vend::Cfg->{SendMailProgram};
44
45         if (lc $using eq 'none') {
46                 $ok = 1;
47                 last SEND;
48         } elsif (lc $using eq 'net::smtp') {
49                 $body =~ s/^(.+?)(?:\r?\n){2}//s;
50                 my $headers = $1;
51                 last SEND unless $headers;
52                 my @head = split(/\r?\n/,$headers);
53                 $ok = send_mail(\@head,$body);
54         } else {
55                 open(Vend::MAIL,"|$using -t") or last SEND;
56                 print Vend::MAIL $body
57                         or last SEND;
58                 close Vend::MAIL
59                         or last SEND;
60                 $ok = ($? == 0);
61         }
62     }
63
64     if (!$ok) {
65         ::logError("Unable to send mail using $Vend::Cfg->{SendMailProgram}\n" .
66             "Message follows:\n\n$body");
67     }
68
69     return $opt->{hide} ? '' : $ok;
70 }
71 EOR