--- trunk/Nos.pm 2005/05/18 13:12:54 45 +++ trunk/Nos.pm 2005/06/21 21:24:10 60 @@ -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,8 @@ use Email::Simple; use Email::Address; use Mail::DeliveryStatus::BounceParser; -use Data::Dumper; +use Class::DBI::AbstractSearch; + =head1 NAME @@ -39,7 +40,39 @@ =head1 DESCRIPTION -Core module for notice sender's functionality. +Notice sender is mail handler. It is not MTA, since it doesn't know how to +receive e-mails or send them directly to other hosts. It is not mail list +manager because it requires programming to add list members and send +messages. You can think of it as mechanisam for off-loading your e-mail +sending to remote server using SOAP service. + +It's concept is based around B. Each list can have zero or more +B. Each list can have zero or more B. + +Here comes a twist: each outgoing message will have unique e-mail generated, +so Notice Sender will be able to link received replies (or bounces) with +outgoing messages. + +It doesn't do much more than that. It B create MIME encoded e-mail, +send attachments, handle 8-bit characters in headers (which have to be +encoded) or anything else. + +It will just queue your e-mail message to particular list (sending it to +possibly remote Notice Sender SOAP server just once), send it out at +reasonable rate (so that it doesn't flood your e-mail infrastructure) and +track replies. + +It is best used to send smaller number of messages to more-or-less fixed +list of recipients while allowing individual responses to be examined. +Tipical use include replacing php e-mail sending code with SOAP call to +Notice Sender. It does support additional C field for each member +which can be used to track some unique identifier from remote system for +particular user. + +It comes with command-line utility C which can be used to perform +all available operation from scripts (see C). +This command is also useful for debugging while writing client SOAP +application. =head1 METHODS @@ -74,7 +107,7 @@ user => $self->{'user'}, password => $self->{'passwd'}, namespace => "Nos", -# additional_classes => qw/Class::DBI::AbstractSearch/, + additional_classes => qw/Class::DBI::AbstractSearch/, # additional_base_classes => qw/My::Stuff/, relationships => 1, ) || croak "can't init Class::DBI::Loader"; @@ -92,12 +125,13 @@ $nos->new_list( list => 'My list', + from => 'Outgoing from comment', email => 'my-list@example.com', ); Returns ID of newly created list. -Calls internally L<_add_list>, see details there. +Calls internally C<_add_list>, see details there. =cut @@ -107,7 +141,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 +162,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 +176,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 +202,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 +234,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, +it will also be returned. =cut @@ -199,7 +244,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 +259,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; } @@ -236,6 +284,9 @@ Returns false if user doesn't exist. +This function will delete member from all lists (by cascading delete), so it +shouldn't be used lightly. + =cut sub delete_member { @@ -245,6 +296,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,13 +305,51 @@ 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"; } +=head2 delete_member_from_list + +Delete member from particular list. + + my $ok = delete_member_from_list( + list => 'My list', + email => 'dpavlin@rot13.org', + ); + +Returns false if user doesn't exist on that particular list. + +It will die if list or user doesn't exist. You have been warned (you might +want to eval this functon to prevent it from croaking). + +=cut + +sub delete_member_from_list { + my $self = shift; + + my $args = {@_}; + + croak "need list name and email of user to delete" unless ($args->{'list'} && $args->{'email'}); + + $args->{'list'} = lc($args->{'list'}); + $args->{'email'} = lc($args->{'email'}); + + my $user = $self->{'loader'}->find_class('users'); + my $list = $self->{'loader'}->find_class('lists'); + my $user_list = $self->{'loader'}->find_class('user_list'); + + my $this_user = $user->search( email => $args->{'email'} )->first || croak "can't find user: ".$args->{'email'}; + my $this_list = $list->search( name => $args->{'list'} )->first || croak "can't find list: ".$args->{'list'}; + + my $this_user_list = $user_list->search_where( list_id => $this_list->id, user_id => $this_list->id )->first || return; + + $this_user_list->delete || croak "can't delete user from list\n"; + + return $user_list->dbi_commit || croak "can't commit"; +} + =head2 add_message_to_list Adds message to one list's queue for later sending. @@ -284,7 +375,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 +416,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 +496,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 +527,11 @@ hash => $hash, }); $sent->dbi_commit; + + if ($sleep) { + warn "sleeping $sleep seconds\n"; + sleep($sleep); + } } } $m->all_sent(1); @@ -409,6 +550,8 @@ message => $message, ); +This method is used by C when receiving e-mail messages. + =cut sub inbox_message { @@ -419,12 +562,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 +581,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 +634,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 +648,7 @@ my $list_obj = $nos->_add_list( list => 'My list', + from => 'Outgoing from comment', email => 'my-list@example.com', ); @@ -510,8 +666,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 +676,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 +708,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 +750,7 @@ $message_id = NewList( list => 'My list', + from => 'Name of my list', email => 'my-list@example.com' ); @@ -598,7 +761,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 +774,8 @@ $member_id = AddMemberToList( list => 'My list', email => 'e-mail@example.com', - name => 'Full Name' + name => 'Full Name', + ext_id => 42, ); =cut @@ -621,7 +785,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 @_ } );