16 |
our @EXPORT = qw( |
our @EXPORT = qw( |
17 |
); |
); |
18 |
|
|
19 |
our $VERSION = '0.8'; |
our $VERSION = '0.9'; |
20 |
|
|
21 |
use Class::DBI::Loader; |
use Class::DBI::Loader; |
22 |
use Email::Valid; |
use Email::Valid; |
90 |
debug => 1, |
debug => 1, |
91 |
verbose => 1, |
verbose => 1, |
92 |
hash_len => 8, |
hash_len => 8, |
93 |
|
full_hostname_in_aliases => 0, |
94 |
); |
); |
95 |
|
|
96 |
Parametar C<hash_len> defines length of hash which will be added to each |
Parametar C<hash_len> defines length of hash which will be added to each |
97 |
outgoing e-mail message to ensure that replies can be linked with sent e-mails. |
outgoing e-mail message to ensure that replies can be linked with sent e-mails. |
98 |
|
|
99 |
|
C<full_hostname_in_aliases> will turn on old behaviour (not supported by Postfix |
100 |
|
postalias) to include full hostname in aliases file. |
101 |
|
|
102 |
|
|
103 |
=cut |
=cut |
104 |
|
|
105 |
sub new { |
sub new { |
106 |
my $class = shift; |
my $class = shift; |
107 |
my $self = {@_}; |
my $self = {@_}; |
108 |
bless($self, $class); |
bless($self, $class); |
109 |
|
|
110 |
croak "need at least dsn" unless ($self->{'dsn'}); |
croak "need at least dsn" unless ($self->{'dsn'}); |
426 |
|
|
427 |
my $m = Email::Simple->new($message_text) || croak "can't parse message"; |
my $m = Email::Simple->new($message_text) || croak "can't parse message"; |
428 |
|
|
429 |
unless( $m->header('Subject') ) { |
warn "message doesn't have Subject header\n" unless( $m->header('Subject') ); |
|
warn "message doesn't have Subject header\n"; |
|
|
return; |
|
|
} |
|
430 |
|
|
431 |
my $lists = $self->{'loader'}->find_class('lists'); |
my $lists = $self->{'loader'}->find_class('lists'); |
432 |
|
|
463 |
list => 'My list', |
list => 'My list', |
464 |
driver => 'smtp', |
driver => 'smtp', |
465 |
sleep => 3, |
sleep => 3, |
466 |
|
verbose => 1, |
467 |
); |
); |
468 |
|
|
469 |
Second option is driver which will be used for e-mail delivery. If not |
Second option is driver which will be used for e-mail delivery. If not |
477 |
|
|
478 |
Send e-mail using SMTP server at 127.0.0.1 |
Send e-mail using SMTP server at 127.0.0.1 |
479 |
|
|
480 |
|
=item verbose |
481 |
|
|
482 |
|
Display diagnostic output to C<STDOUT> and C<STDERR>. |
483 |
|
|
484 |
=back |
=back |
485 |
|
|
486 |
Any other driver name will try to use C<Email::Send::that_driver> module. |
Any other driver name will try to use C<Email::Send::that_driver> module. |
499 |
my $list_name = lc($arg->{'list'}) || ''; |
my $list_name = lc($arg->{'list'}) || ''; |
500 |
my $driver = $arg->{'driver'} || ''; |
my $driver = $arg->{'driver'} || ''; |
501 |
my $sleep = $arg->{'sleep'}; |
my $sleep = $arg->{'sleep'}; |
502 |
|
my $verbose = $arg->{verbose}; |
503 |
$sleep ||= 3 unless defined($sleep); |
$sleep ||= 3 unless defined($sleep); |
504 |
|
|
505 |
# number of messages sent o.k. |
# number of messages sent o.k. |
514 |
} elsif ($driver && $driver ne '') { |
} elsif ($driver && $driver ne '') { |
515 |
$email_send_driver = 'Email::Send::' . $driver; |
$email_send_driver = 'Email::Send::' . $driver; |
516 |
} else { |
} else { |
517 |
warn "dumping all messages to STDERR\n"; |
warn "dumping all messages to STDERR\n" if ($verbose); |
518 |
} |
} |
519 |
|
|
520 |
my $lists = $self->{'loader'}->find_class('lists'); |
my $lists = $self->{'loader'}->find_class('lists'); |
535 |
while (my $m = $my_q->next) { |
while (my $m = $my_q->next) { |
536 |
next if ($m->all_sent); |
next if ($m->all_sent); |
537 |
|
|
538 |
print "sending message ",$m->message_id," enqueued on ",$m->date," to list ",$m->list_id->name,"\n"; |
print "sending message ",$m->message_id," enqueued on ",$m->date," to list ",$m->list_id->name,"\n" if ($verbose); |
539 |
my $msg = $m->message_id->message; |
my $msg = $m->message_id->message; |
540 |
|
|
541 |
foreach my $u ($user_list->search(list_id => $m->list_id)) { |
foreach my $u ($user_list->search(list_id => $m->list_id)) { |
545 |
my ($from,$domain) = split(/@/, $u->list_id->email, 2); |
my ($from,$domain) = split(/@/, $u->list_id->email, 2); |
546 |
|
|
547 |
if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) { |
if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) { |
548 |
print "SKIP $to_email message allready sent\n"; |
print "SKIP $to_email message allready sent\n" if ($verbose); |
549 |
} else { |
} else { |
550 |
print "=> $to_email "; |
print "=> $to_email " if ($verbose); |
551 |
|
|
552 |
my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id; |
my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id; |
553 |
my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} ); |
my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} ); |
564 |
my $m_obj = Email::Simple->new($msg) || croak "can't parse message"; |
my $m_obj = Email::Simple->new($msg) || croak "can't parse message"; |
565 |
|
|
566 |
$m_obj->header_set('Return-Path', $from_email_only) || croak "can't set Return-Path: header"; |
$m_obj->header_set('Return-Path', $from_email_only) || croak "can't set Return-Path: header"; |
567 |
$m_obj->header_set('Sender', $from_email_only) || croak "can't set Sender: header"; |
#$m_obj->header_set('Sender', $from_email_only) || croak "can't set Sender: header"; |
568 |
$m_obj->header_set('Errors-To', $from_email_only) || croak "can't set Errors-To: header"; |
$m_obj->header_set('Errors-To', $from_email_only) || croak "can't set Errors-To: header"; |
569 |
$m_obj->header_set('From', $from_addr) || croak "can't set From: header"; |
$m_obj->header_set('From', $from_addr) || croak "can't set From: header"; |
570 |
$m_obj->header_set('To', $to) || croak "can't set To: header"; |
$m_obj->header_set('To', $to) || croak "can't set To: header"; |
595 |
}); |
}); |
596 |
$sent->dbi_commit; |
$sent->dbi_commit; |
597 |
|
|
598 |
print " - $sent_status\n"; |
print " - $sent_status\n" if ($verbose); |
599 |
|
|
600 |
$ok++; |
$ok++; |
601 |
} else { |
} else { |
602 |
warn "ERROR: $sent_status\n"; |
warn "ERROR: $sent_status\n" if ($verbose); |
603 |
} |
} |
604 |
|
|
605 |
if ($sleep) { |
if ($sleep) { |
606 |
warn "sleeping $sleep seconds\n"; |
warn "sleeping $sleep seconds\n" if ($verbose); |
607 |
sleep($sleep); |
sleep($sleep); |
608 |
} |
} |
609 |
} |
} |
877 |
$target .= qq#"| cd $self_path && ./sender.pl --inbox='$list'"#; |
$target .= qq#"| cd $self_path && ./sender.pl --inbox='$list'"#; |
878 |
|
|
879 |
# remove hostname from email to make Postfix's postalias happy |
# remove hostname from email to make Postfix's postalias happy |
880 |
$email =~ s/@.+//; |
$email =~ s/@.+// if (not $self->{full_hostname_in_aliases}); |
881 |
|
|
882 |
if ($a->exists($email)) { |
if ($a->exists($email)) { |
883 |
$a->update($email, $target) or croak "can't update alias ".$a->error_check; |
$a->update($email, $target) or croak "can't update alias ".$a->error_check; |
885 |
$a->append($email, $target) or croak "can't add alias ".$a->error_check; |
$a->append($email, $target) or croak "can't add alias ".$a->error_check; |
886 |
} |
} |
887 |
|
|
888 |
#$a->write($aliases) or croak "can't save aliases $aliases ".$a->error_check; |
# $a->write($aliases) or croak "can't save aliases $aliases ".$a->error_check; |
889 |
|
|
890 |
return 1; |
return 1; |
891 |
} |
} |
1049 |
=cut |
=cut |
1050 |
|
|
1051 |
sub new { |
sub new { |
1052 |
my $class = shift; |
my $class = shift; |
1053 |
my $self = {@_}; |
my $self = {@_}; |
1054 |
|
|
1055 |
croak "need aliases parametar" unless ($self->{'aliases'}); |
croak "need aliases parametar" unless ($self->{'aliases'}); |
1056 |
|
|
1239 |
} |
} |
1240 |
} |
} |
1241 |
|
|
1242 |
|
=head2 SendTest |
1243 |
|
|
1244 |
|
Internal function which does e-mail sending using C<Email::Send::Test> driver. |
1245 |
|
|
1246 |
|
my $sent = SendTest( list => 'My list' ); |
1247 |
|
|
1248 |
|
Returns number of messages sent |
1249 |
|
|
1250 |
|
=cut |
1251 |
|
|
1252 |
|
sub SendTest { |
1253 |
|
my $self = shift; |
1254 |
|
my $args = shift; |
1255 |
|
die "list name required" unless ($args->{list}); |
1256 |
|
|
1257 |
|
require Email::Send::Test; |
1258 |
|
|
1259 |
|
my $nr_sent = $nos->send_queued_messages( |
1260 |
|
list => $args->{list}, |
1261 |
|
driver => 'Test', |
1262 |
|
sleep => 0, |
1263 |
|
verbose => 0, |
1264 |
|
); |
1265 |
|
|
1266 |
|
my @emails = Email::Send::Test->emails; |
1267 |
|
|
1268 |
|
open(my $tmp, ">/tmp/soap-debug"); |
1269 |
|
use Data::Dump qw/dump/; |
1270 |
|
print $tmp "sent $nr_sent emails\n", dump(@emails); |
1271 |
|
close($tmp); |
1272 |
|
|
1273 |
|
return $nr_sent; |
1274 |
|
} |
1275 |
|
|
1276 |
### |
### |
1277 |
|
|
1278 |
=head1 NOTE ON ARRAYS IN SOAP |
=head1 NOTE ON ARRAYS IN SOAP |