--- trunk/Nos.pm 2005/08/24 22:11:00 76 +++ trunk/Nos.pm 2006/12/19 15:04:05 93 @@ -16,7 +16,7 @@ our @EXPORT = qw( ); -our $VERSION = '0.8'; +our $VERSION = '0.9'; use Class::DBI::Loader; use Email::Valid; @@ -27,6 +27,7 @@ use Email::Address; use Mail::DeliveryStatus::BounceParser; use Class::DBI::AbstractSearch; +use SQL::Abstract; use Mail::Alias; use Cwd qw(abs_path); @@ -89,16 +90,21 @@ debug => 1, verbose => 1, hash_len => 8, + full_hostname_in_aliases => 0, ); Parametar C defines length of hash which will be added to each outgoing e-mail message to ensure that replies can be linked with sent e-mails. +C will turn on old behaviour (not supported by Postfix +postalias) to include full hostname in aliases file. + + =cut sub new { - my $class = shift; - my $self = {@_}; + my $class = shift; + my $self = {@_}; bless($self, $class); croak "need at least dsn" unless ($self->{'dsn'}); @@ -116,20 +122,6 @@ $self->{'hash_len'} ||= 8; - $self->{'loader'}->find_class('received')->set_sql( - 'received' => qq{ - select - received.id as id, - lists.name as list, - users.ext_id as ext_id, - users.email as email, - bounced,received.date as date - from received - join lists on lists.id = list_id - join users on users.id = user_id - }, - ); - $self ? return $self : return undef; } @@ -434,10 +426,7 @@ my $m = Email::Simple->new($message_text) || croak "can't parse message"; - unless( $m->header('Subject') ) { - warn "message doesn't have Subject header\n"; - return; - } + warn "message doesn't have Subject header\n" unless( $m->header('Subject') ); my $lists = $self->{'loader'}->find_class('lists'); @@ -474,6 +463,7 @@ list => 'My list', driver => 'smtp', sleep => 3, + verbose => 1, ); Second option is driver which will be used for e-mail delivery. If not @@ -487,6 +477,10 @@ Send e-mail using SMTP server at 127.0.0.1 +=item verbose + +Display diagnostic output to C and C. + =back Any other driver name will try to use C module. @@ -505,6 +499,7 @@ my $list_name = lc($arg->{'list'}) || ''; my $driver = $arg->{'driver'} || ''; my $sleep = $arg->{'sleep'}; + my $verbose = $arg->{verbose}; $sleep ||= 3 unless defined($sleep); # number of messages sent o.k. @@ -519,7 +514,7 @@ } elsif ($driver && $driver ne '') { $email_send_driver = 'Email::Send::' . $driver; } else { - warn "dumping all messages to STDERR\n"; + warn "dumping all messages to STDERR\n" if ($verbose); } my $lists = $self->{'loader'}->find_class('lists'); @@ -540,7 +535,7 @@ while (my $m = $my_q->next) { next if ($m->all_sent); - 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); my $msg = $m->message_id->message; foreach my $u ($user_list->search(list_id => $m->list_id)) { @@ -550,9 +545,9 @@ my ($from,$domain) = split(/@/, $u->list_id->email, 2); if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) { - print "SKIP $to_email message allready sent\n"; + print "SKIP $to_email message allready sent\n" if ($verbose); } else { - print "=> $to_email "; + print "=> $to_email " if ($verbose); my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id; my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} ); @@ -569,7 +564,7 @@ my $m_obj = Email::Simple->new($msg) || croak "can't parse message"; $m_obj->header_set('Return-Path', $from_email_only) || croak "can't set Return-Path: header"; - $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"; $m_obj->header_set('Errors-To', $from_email_only) || croak "can't set Errors-To: header"; $m_obj->header_set('From', $from_addr) || croak "can't set From: header"; $m_obj->header_set('To', $to) || croak "can't set To: header"; @@ -600,15 +595,15 @@ }); $sent->dbi_commit; - print " - $sent_status\n"; + print " - $sent_status\n" if ($verbose); $ok++; } else { - warn "ERROR: $sent_status\n"; + warn "ERROR: $sent_status\n" if ($verbose); } if ($sleep) { - warn "sleeping $sleep seconds\n"; + warn "sleeping $sleep seconds\n" if ($verbose); sleep($sleep); } } @@ -722,39 +717,93 @@ Returns all received messages for given list or user. - my @received = $nos->received_message( + my @received = $nos->received_messages( list => 'My list', email => "john.doe@example.com", + from_date => '2005-01-01 10:15:00', + to_date => '2005-01-01 12:00:00', + message => 0, ); +If don't specify C or C it will return all received messages. +Results will be sorted by received date, oldest first. + +Other optional parametars include: + +=over 10 + +=item from_date + +Date (in ISO format) for lower limit of dates received + +=item to_date + +Return just messages older than this date + +=item message + +Include whole received message in result. This will probably make result +array very large. Use with care. + +=back + +Date ranges are inclusive, so results will include messages sent on +particular date specified with C or C. + Each element in returned array will have following structure: - { + my $row = { id => 42, # unique ID of received message - list => 'My list', # useful only of filtering by email - ext_id => 9999, # ext_id from message user - email => 'jdoe@example.com', # e-mail of user - bounced => 0, # true value if message is bounce - date => '2005-08-24 18:57:24', # date of recival in ISO format + list => 'My list', # useful if filtering by email + ext_id => 9999, # ext_id from message sender + email => 'jdoe@example.com', # e-mail of message sender + bounced => 0, # true if message is bounce + date => '2005-08-24 18:57:24', # date of receival in ISO format } +If you specified C option, this hash will also have C key +which will contain whole received message. =cut sub received_messages { my $self = shift; - my $arg = {@_}; + my $arg = {@_} if (@_); - croak "need list name or email" unless ($arg->{'list'} || $arg->{'email'}); +# croak "need list name or email" unless ($arg->{'list'} || $arg->{'email'}); - $arg->{'list'} = lc($arg->{'list'}); - $arg->{'email'} = lc($arg->{'email'}); + my $sql = qq{ + select + received.id as id, + lists.name as list, + users.ext_id as ext_id, + users.email as email, + }; + $sql .= qq{ message,} if ($arg->{'message'}); + $sql .= qq{ + bounced,received.date as date + from received + join lists on lists.id = list_id + join users on users.id = user_id + }; - my @out; + my $order = qq{ order by date asc }; - my $sth = $self->{'loader'}->find_class('received')->sql_received; - $sth->execute(); + my $where; + + $where->{'lists.name'} = lc($arg->{'list'}) if ($arg->{'list'}); + $where->{'users.email'} = lc($arg->{'email'}) if ($arg->{'email'}); + $where->{'received.date'} = { '>=', $arg->{'date_from'} } if ($arg->{'date_from'}); + $where->{'received.date'} = { '<=', $arg->{'date_to'} } if ($arg->{'date_to'}); + + # hum, yammy one-liner + my($stmt, @bind) = SQL::Abstract->new->where($where); + + my $dbh = $self->{'loader'}->find_class('received')->db_Main; + + my $sth = $dbh->prepare($sql . $stmt . $order); + $sth->execute(@bind); return $sth->fetchall_hash; } @@ -825,7 +874,10 @@ $self_path =~ s#/[^/]+$##; $self_path =~ s#/t/*$#/#; - $target .= qq#| cd $self_path && ./sender.pl --inbox="$list"#; + $target .= qq#"| cd $self_path && ./sender.pl --inbox='$list'"#; + + # remove hostname from email to make Postfix's postalias happy + $email =~ s/@.+// if (not $self->{full_hostname_in_aliases}); if ($a->exists($email)) { $a->update($email, $target) or croak "can't update alias ".$a->error_check; @@ -833,7 +885,7 @@ $a->append($email, $target) or croak "can't add alias ".$a->error_check; } - #$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; return 1; } @@ -997,8 +1049,8 @@ =cut sub new { - my $class = shift; - my $self = {@_}; + my $class = shift; + my $self = {@_}; croak "need aliases parametar" unless ($self->{'aliases'}); @@ -1075,7 +1127,7 @@ if ($_[0] !~ m/^HASH/) { return $nos->add_member_to_list( - list => $_[0], email => $_[1], name => $_[2], ext_id => $_[4], + list => $_[0], email => $_[1], name => $_[2], ext_id => $_[3], ); } else { return $nos->add_member_to_list( %{ shift @_ } ); @@ -1151,35 +1203,75 @@ } } -=head1 UNIMPLEMENTED FUNCTIONS - -This is a stub for documentation of unimplemented functions. - =head2 MessagesReceived +Return statistics about received messages. + my @result = MessagesReceived( list => 'My list', email => 'jdoe@example.com', + from_date => '2005-01-01 10:15:00', + to_date => '2005-01-01 12:00:00', + message => 0, ); -You can specify just C or C or any combination of those. +You must specify C or C or any combination of those two. Other +parametars are optional. For format of returned array element see C. -=head2 MessagesReceivedByDate +=cut + +sub MessagesReceived { + my $self = shift; + + if ($_[0] !~ m/^HASH/) { + die "need at least list or email" unless (scalar @_ < 2); + return \@{ $nos->received_messages( + list => $_[0], email => $_[1], + from_date => $_[2], to_date => $_[3], + message => $_[4] + ) }; + } else { + my $arg = shift; + die "need list or email argument" unless ($arg->{'list'} || $arg->{'email'}); + return \@{ $nos->received_messages( %{ $arg } ) }; + } +} -=head2 MessagesReceivedByDateWithContent +=head2 SendTest -=head2 ReceivedMessasgeContent +Internal function which does e-mail sending using C driver. -Return content of received message. + my $sent = SendTest( list => 'My list' ); - my $mail_body = ReceivedMessageContent( id => 42 ); +Returns number of messages sent =cut +sub SendTest { + my $self = shift; + my $args = shift; + die "list name required" unless ($args->{list}); + + require Email::Send::Test; + my $nr_sent = $nos->send_queued_messages( + list => $args->{list}, + driver => 'Test', + sleep => 0, + verbose => 0, + ); + + my @emails = Email::Send::Test->emails; + open(my $tmp, ">/tmp/soap-debug"); + use Data::Dump qw/dump/; + print $tmp "sent $nr_sent emails\n", dump(@emails); + close($tmp); + + return $nr_sent; +} ###