--- trunk/Nos.pm 2005/05/18 13:12:54 45 +++ trunk/Nos.pm 2005/05/25 15:03:10 52 @@ -26,7 +26,7 @@ use Email::Simple; use Email::Address; use Mail::DeliveryStatus::BounceParser; -use Data::Dumper; + =head1 NAME @@ -92,6 +92,7 @@ $nos->new_list( list => 'My list', + from => 'Outgoing from comment', email => 'my-list@example.com', ); @@ -107,7 +108,10 @@ my $arg = {@_}; confess "need list name" unless ($arg->{'list'}); - confess "need list email" unless ($arg->{'list'}); + confess "need list email" unless ($arg->{'email'}); + + $arg->{'list'} = lc($arg->{'list'}); + $arg->{'email'} = lc($arg->{'email'}); my $l = $self->_get_list($arg->{'list'}) || $self->_add_list( @_ ) || @@ -138,9 +142,9 @@ my $arg = {@_}; - my $email = $arg->{'email'} || croak "can't add user without e-mail"; + my $email = lc($arg->{'email'}) || croak "can't add user without e-mail"; my $name = $arg->{'name'} || ''; - my $list_name = $arg->{'list'} || croak "need list name"; + my $list_name = lc($arg->{'list'}) || croak "need list name"; my $list = $self->_get_list($list_name) || croak "list $list_name doesn't exist"; @@ -199,7 +203,7 @@ my $args = {@_}; - my $list_name = $args->{'list'} || confess "need list name"; + my $list_name = lc($args->{'list'}) || confess "need list name"; my $lists = $self->{'loader'}->find_class('lists'); my $user_list = $self->{'loader'}->find_class('user_list'); @@ -245,6 +249,8 @@ croak "need name or email of user to delete" unless ($args->{'name'} || $args->{'email'}); + $args->{'email'} = lc($args->{'email'}) if ($args->{'email'}); + my $key = 'name'; $key = 'email' if ($args->{'email'}); @@ -252,8 +258,6 @@ my $this_user = $users->search( $key => $args->{$key} )->first || return; -print Dumper($this_user); - $this_user->delete || croak "can't delete user\n"; return $users->dbi_commit || croak "can't commit"; @@ -284,7 +288,7 @@ my $args = {@_}; - my $list_name = $args->{'list'} || confess "need list name"; + my $list_name = lc($args->{'list'}) || confess "need list name"; my $message_text = $args->{'message'} || croak "need message"; my $m = Email::Simple->new($message_text) || croak "can't parse message"; @@ -325,14 +329,48 @@ Send queued messages or just ones for selected list - $nos->send_queued_messages("My list"); + $nos->send_queued_messages( + list => 'My list', + driver => 'smtp', + sleep => 3, + ); + +Second option is driver which will be used for e-mail delivery. If not +specified, C driver will be used which will dump e-mail to C. + +Other valid drivers are: + +=over 10 + +=item smtp + +Send e-mail using SMTP server at 127.0.0.1 + +=back + +Default sleep wait between two messages is 3 seconds. =cut sub send_queued_messages { my $self = shift; - my $list_name = shift; + my $arg = {@_}; + + my $list_name = lc($arg->{'list'}) || ''; + my $driver = $arg->{'driver'} || ''; + my $sleep = $arg->{'sleep'}; + $sleep ||= 3 unless defined($sleep); + + my $email_send_driver = 'Email::Send::IO'; + my @email_send_options; + + if (lc($driver) eq 'smtp') { + $email_send_driver = 'Email::Send::SMTP'; + @email_send_options = ['127.0.0.1']; + } else { + warn "dumping all messages to STDERR\n"; + } my $lists = $self->{'loader'}->find_class('lists'); my $queue = $self->{'loader'}->find_class('queue'); @@ -371,19 +409,30 @@ my $hash = $auth->generate_hash( $to_email ); - my $from = $u->list_id->name . " <" . $from . "+" . $hash . ( $domain ? "@" . $domain : '' ). ">"; - my $to = $u->user_id->name . " <$to_email>"; + my $from_addr; + my $from_email_only = $from . "+" . $hash . ( $domain ? '@' . $domain : ''); + + $from_addr .= '"' . $u->list_id->from_addr . '" ' if ($u->list_id->from_addr); + $from_addr .= '<' . $from_email_only . '>'; + my $to = '"' . $u->user_id->name . '" <' . $to_email . '>'; my $m_obj = Email::Simple->new($msg) || croak "can't parse message"; - $m_obj->header_set('From', $from) || croak "can't set From: header"; + $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('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"; $m_obj->header_set('X-Nos-Version', $VERSION); $m_obj->header_set('X-Nos-Hash', $hash); - # FIXME do real sending :-) - send IO => $m_obj->as_string; + # really send e-mail + if (@email_send_options) { + send $email_send_driver => $m_obj->as_string, @email_send_options; + } else { + send $email_send_driver => $m_obj->as_string; + } $sent->create({ message_id => $m->message_id, @@ -391,6 +440,11 @@ hash => $hash, }); $sent->dbi_commit; + + if ($sleep) { + warn "sleeping $sleep seconds\n"; + sleep($sleep); + } } } $m->all_sent(1); @@ -419,12 +473,16 @@ return unless ($arg->{'message'}); croak "need list name" unless ($arg->{'list'}); + $arg->{'list'} = lc($arg->{'list'}); + my $this_list = $self->_get_list($arg->{'list'}) || croak "can't find list ".$arg->{'list'}."\n"; my $m = Email::Simple->new($arg->{'message'}) || croak "can't parse message"; my $to = $m->header('To') || die "can't find To: address in incomming message\n"; + my $return_path = $m->header('Return-Path') || ''; + my @addrs = Email::Address->parse( $to ); die "can't parse To: $to address\n" unless (@addrs); @@ -434,35 +492,46 @@ my $hash; foreach my $a (@addrs) { - if ($a->address =~ m/\+([a-f0-9]{$hl})@/) { + if ($a->address =~ m/\+([a-f0-9]{$hl})@/i) { $hash = $1; last; } } - croak "can't find hash in e-mail $to\n" unless ($hash); + #warn "can't find hash in e-mail $to\n" unless ($hash); my $sent = $self->{'loader'}->find_class('sent'); # will use null if no matching message_id is found - my $sent_msg = $sent->search( hash => $hash )->first; + my $sent_msg; + $sent_msg = $sent->search( hash => $hash )->first if ($hash); my ($message_id, $user_id) = (undef, undef); # init with NULL if ($sent_msg) { $message_id = $sent_msg->message_id || carp "no message_id"; $user_id = $sent_msg->user_id || carp "no user_id"; + } else { + #warn "can't find sender with hash $hash\n"; + my $users = $self->{'loader'}->find_class('users'); + my $from = $m->header('From'); + $from = $1 if ($from =~ m/<(.*)>/); + my $this_user = $users->search( email => lc($from) )->first; + $user_id = $this_user->id if ($this_user); } my $is_bounce = 0; - my $bounce = eval { Mail::DeliveryStatus::BounceParser->new( - $arg->{'message'}, { report_non_bounces=>1 }, - ) }; - carp "can't check if this message is bounce!" if ($@); - - $is_bounce++ if ($bounce && $bounce->is_bounce); + if ($return_path eq '<>' || $return_path eq '') { + no warnings; + my $bounce = eval { Mail::DeliveryStatus::BounceParser->new( + $arg->{'message'}, { report_non_bounces=>1 }, + ) }; + #warn "can't check if this message is bounce!" if ($@); + + $is_bounce++ if ($bounce && $bounce->is_bounce); + } my $received = $self->{'loader'}->find_class('received'); @@ -476,10 +545,7 @@ $this_received->dbi_commit; - print "message_id: ",($message_id || "not found")," -- $is_bounce\n"; - - - warn "inbox is not yet implemented"; +# print "message_id: ",($message_id || "not found")," -- $is_bounce\n"; } @@ -493,6 +559,7 @@ my $list_obj = $nos->_add_list( list => 'My list', + from => 'Outgoing from comment', email => 'my-list@example.com', ); @@ -510,8 +577,9 @@ my $arg = {@_}; - my $name = $arg->{'list'} || confess "can't add list without name"; - my $email = $arg->{'email'} || confess "can't add list without e-mail"; + my $name = lc($arg->{'list'}) || confess "can't add list without name"; + my $email = lc($arg->{'email'}) || confess "can't add list without e-mail"; + my $from_addr = $arg->{'from'}; my $lists = $self->{'loader'}->find_class('lists'); @@ -519,9 +587,14 @@ name => $name, email => $email, }); - + croak "can't add list $name\n" unless ($l); + if ($from_addr && $l->from_addr ne $from_addr) { + $l->from_addr($from_addr); + $l->update; + } + $l->dbi_commit; return $l; @@ -546,7 +619,7 @@ my $lists = $self->{'loader'}->find_class('lists') || confess "can't find lists class"; - return $lists->search({ name => $name })->first; + return $lists->search({ name => lc($name) })->first; } ###