--- trunk/Nos.pm 2005/05/24 15:19:44 48 +++ trunk/Nos.pm 2005/06/21 20:49:27 59 @@ -16,7 +16,7 @@ our @EXPORT = qw( ); -our $VERSION = '0.4'; +our $VERSION = '0.5'; use Class::DBI::Loader; use Email::Valid; @@ -26,12 +26,7 @@ use Email::Simple; use Email::Address; use Mail::DeliveryStatus::BounceParser; -use Data::Dumper; - -my $email_send_driver = 'Email::Send::IO'; -my @email_send_options; - -#$email_send_driver = 'Sendmail'; +use Class::DBI::AbstractSearch; =head1 NAME @@ -80,7 +75,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"; @@ -114,7 +109,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( @_ ) || @@ -132,9 +130,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. @@ -145,9 +144,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"; @@ -170,6 +170,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, @@ -197,7 +202,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 @@ -206,7 +212,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'); @@ -221,6 +227,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; } @@ -252,6 +261,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'}); @@ -259,13 +270,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. @@ -291,7 +340,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"; @@ -332,7 +381,11 @@ Send queued messages or just ones for selected list - $nos->send_queued_messages("My list",'smtp'); + $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. @@ -347,20 +400,29 @@ =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 $driver = shift || ''; + 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"; } - warn "using $driver [$email_send_driver]\n"; my $lists = $self->{'loader'}->find_class('lists'); my $queue = $self->{'loader'}->find_class('queue'); @@ -400,9 +462,7 @@ my $hash = $auth->generate_hash( $to_email ); my $from_addr; - my $email_hash = "+" . $hash . ( $domain ? '@' . $domain : ''); - my $from_email_only = $from . $email_hash; - my $from_bounce = $from . '-bounce' . $email_hash; + 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 . '>'; @@ -410,9 +470,9 @@ my $m_obj = Email::Simple->new($msg) || croak "can't parse message"; - $m_obj->header_set('Return-Path', $from_bounce) || croak "can't set Return-Path: header"; - $m_obj->header_set('Sender', $from_bounce) || croak "can't set Sender: header"; - $m_obj->header_set('Errors-To', $from_bounce) || croak "can't set Errors-To: 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"; @@ -432,6 +492,11 @@ hash => $hash, }); $sent->dbi_commit; + + if ($sleep) { + warn "sleeping $sleep seconds\n"; + sleep($sleep); + } } } $m->all_sent(1); @@ -460,6 +525,8 @@ 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"; @@ -477,18 +544,19 @@ 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; } } - warn "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 @@ -496,18 +564,23 @@ $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"; + #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; - if ($arg->{'bounce'} || $return_path eq '<>' || $return_path eq '') { + if ($return_path eq '<>' || $return_path eq '') { no warnings; my $bounce = eval { Mail::DeliveryStatus::BounceParser->new( $arg->{'message'}, { report_non_bounces=>1 }, ) }; - carp "can't check if this message is bounce!" if ($@); + #warn "can't check if this message is bounce!" if ($@); $is_bounce++ if ($bounce && $bounce->is_bounce); } @@ -524,10 +597,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"; } @@ -559,8 +629,8 @@ 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'); @@ -601,7 +671,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; } ### @@ -643,6 +713,7 @@ $message_id = NewList( list => 'My list', + from => 'Name of my list', email => 'my-list@example.com' ); @@ -653,7 +724,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 @_ } ); @@ -666,7 +737,8 @@ $member_id = AddMemberToList( list => 'My list', email => 'e-mail@example.com', - name => 'Full Name' + name => 'Full Name', + ext_id => 42, ); =cut @@ -676,7 +748,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 @_ } );