--- trunk/Nos.pm 2005/05/18 13:12:54 45 +++ trunk/Nos.pm 2005/06/21 09:41:43 58 @@ -16,7 +16,7 @@ our @EXPORT = qw( ); -our $VERSION = '0.4'; +our $VERSION = '0.5'; use Class::DBI::Loader; use Email::Valid; @@ -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( @_ ) || @@ -125,9 +129,10 @@ list => "My list", email => "john.doe@example.com", name => "John A. Doe", + ext_id => 42, ); -C parametar is optional. +C and C parametars are optional. Return member ID if user is added. @@ -138,9 +143,10 @@ 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 $ext_id = $arg->{'ext_id'}; my $list = $self->_get_list($list_name) || croak "list $list_name doesn't exist"; @@ -163,6 +169,11 @@ $this_user->update; } + if (defined($ext_id) && ($this_user->ext_id || '') ne $ext_id) { + $this_user->ext_id($ext_id); + $this_user->update; + } + my $user_on_list = $user_list->find_or_create({ user_id => $this_user->id, list_id => $list->id, @@ -190,7 +201,8 @@ email => 'dpavlin@rot13.org } -If list is not found, returns false. +If list is not found, returns false. If there is C in user data, +that will also be returned. =cut @@ -199,7 +211,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'); @@ -214,6 +226,9 @@ email => $user_on_list->user_id->email, }; + my $ext_id = $user_on_list->user_id->ext_id; + $row->{'ext_id'} = $ext_id if (defined($ext_id)); + push @results, $row; } @@ -245,6 +260,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 +269,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 +299,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 +340,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 +420,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 +451,11 @@ hash => $hash, }); $sent->dbi_commit; + + if ($sleep) { + warn "sleeping $sleep seconds\n"; + sleep($sleep); + } } } $m->all_sent(1); @@ -419,12 +484,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 +503,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 +556,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 +570,7 @@ my $list_obj = $nos->_add_list( list => 'My list', + from => 'Outgoing from comment', email => 'my-list@example.com', ); @@ -510,8 +588,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 +598,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 +630,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; } ### @@ -588,6 +672,7 @@ $message_id = NewList( list => 'My list', + from => 'Name of my list', email => 'my-list@example.com' ); @@ -598,7 +683,7 @@ if ($_[0] !~ m/^HASH/) { return $nos->new_list( - list => $_[0], email => $_[1], + list => $_[0], from => $_[1], email => $_[2], ); } else { return $nos->new_list( %{ shift @_ } ); @@ -611,7 +696,8 @@ $member_id = AddMemberToList( list => 'My list', email => 'e-mail@example.com', - name => 'Full Name' + name => 'Full Name', + ext_id => 42, ); =cut @@ -621,7 +707,7 @@ if ($_[0] !~ m/^HASH/) { return $nos->add_member_to_list( - list => $_[0], email => $_[1], name => $_[2], + list => $_[0], email => $_[1], name => $_[2], ext_id => $_[4], ); } else { return $nos->add_member_to_list( %{ shift @_ } );