--- trunk/Nos.pm 2005/07/08 11:46:35 66 +++ trunk/Nos.pm 2005/08/24 21:27:40 75 @@ -16,7 +16,7 @@ our @EXPORT = qw( ); -our $VERSION = '0.5'; +our $VERSION = '0.8'; use Class::DBI::Loader; use Email::Valid; @@ -62,9 +62,9 @@ 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. +keep track replies. -It is best used to send smaller number of messages to more-or-less fixed +It is best used to send small 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 @@ -72,7 +72,7 @@ particular user. It comes with command-line utility C which can be used to perform -all available operation from scripts (see C). +all available operation from scripts (see C). This command is also useful for debugging while writing client SOAP application. @@ -116,19 +116,35 @@ $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; } -=head2 new_list +=head2 create_list -Create new list. Required arguments are name of C and -C address. +Create new list. Required arguments are name of C, C address +and path to C file. - $nos->new_list( + $nos->create_list( list => 'My list', from => 'Outgoing from comment', email => 'my-list@example.com', + aliases => '/etc/mail/mylist', + archive => '/path/to/mbox/archive', ); Returns ID of newly created list. @@ -137,7 +153,7 @@ =cut -sub new_list { +sub create_list { my $self = shift; my $arg = {@_}; @@ -156,19 +172,20 @@ } -=head2 delete_list +=head2 drop_list Delete list from database. - my $ok = delete_list( + my $ok = drop_list( list => 'My list' + aliases => '/etc/mail/mylist', ); Returns false if list doesn't exist. =cut -sub delete_list { +sub drop_list { my $self = shift; my $args = {@_}; @@ -177,10 +194,14 @@ $args->{'list'} = lc($args->{'list'}); + my $aliases = $args->{'aliases'} || croak "need path to aliases file"; + my $lists = $self->{'loader'}->find_class('lists'); my $this_list = $lists->search( name => $args->{'list'} )->first || return; + $self->_remove_alias( email => $this_list->email, aliases => $aliases); + $this_list->delete || croak "can't delete list\n"; return $lists->dbi_commit || croak "can't commit"; @@ -260,7 +281,7 @@ list => 'My list', ); -Returns array of hashes with user informations like this: +Returns array of hashes with user information like this: $member = { name => 'Dobrica Pavlinusic', @@ -468,8 +489,12 @@ =back +Any other driver name will try to use C module. + Default sleep wait between two messages is 3 seconds. +This method will return number of succesfully sent messages. + =cut sub send_queued_messages { @@ -482,12 +507,17 @@ my $sleep = $arg->{'sleep'}; $sleep ||= 3 unless defined($sleep); + # number of messages sent o.k. + my $ok = 0; + 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']; + } elsif ($driver && $driver ne '') { + $email_send_driver = 'Email::Send::' . $driver; } else { warn "dumping all messages to STDERR\n"; } @@ -557,7 +587,8 @@ } croak "can't send e-mail: $sent_status\n\nOriginal e-mail follows:\n".$m_obj->as_string unless ($sent_status); - my @bad = @{ $sent_status->prop('bad') }; + my @bad; + @bad = @{ $sent_status->prop('bad') } if (eval { $sent_status->can('prop') }); croak "failed sending to ",join(",",@bad) if (@bad); if ($sent_status) { @@ -571,6 +602,7 @@ print " - $sent_status\n"; + $ok++; } else { warn "ERROR: $sent_status\n"; } @@ -586,6 +618,8 @@ $m->dbi_commit; } + return $ok; + } =head2 inbox_message @@ -684,6 +718,34 @@ # print "message_id: ",($message_id || "not found")," -- $is_bounce\n"; } +=head2 received_messages + +Returns all received messages for given list or user. + + my @received = $nos->received_message( + list => 'My list', + email => "john.doe@example.com", + ); + +This method is used by C when receiving e-mail messages. + +=cut + +sub received_messages { + my $self = shift; + + my $arg = {@_}; + + croak "need list name or email" unless ($arg->{'list'} || $arg->{'email'}); + + $arg->{'list'} = lc($arg->{'list'}); + $arg->{'email'} = lc($arg->{'email'}); + + my $rcvd = $self->{'loader'}->find_class('received')->search_received(); + + return $rcvd; +} + =head1 INTERNAL METHODS @@ -692,7 +754,7 @@ =head2 _add_aliases -Add new list to C (or equivavlent) file +Add or update alias in C (or equivalent) file for selected list my $ok = $nos->add_aliases( list => 'My list', @@ -713,16 +775,23 @@ my $arg = {@_}; - croak "need list and email options" unless ($arg->{'list'} && $arg->{'email'}); + foreach my $o (qw/list email aliases/) { + croak "need $o option" unless ($arg->{$o}); + } - my $aliases = $arg->{'aliases'} || croak "need aliases"; + my $aliases = $arg->{'aliases'}; + my $email = $arg->{'email'}; + my $list = $arg->{'list'}; unless (-e $aliases) { warn "aliases file $aliases doesn't exist, creating empty\n"; open(my $fh, '>', $aliases) || croak "can't create $aliases: $!"; close($fh); + chmod 0777, $aliases || warn "can't change permission to 0777"; } + die "FATAL: aliases file $aliases is not writable\n" unless (-w $aliases); + my $a = new Mail::Alias($aliases) || croak "can't open aliases file $aliases: $!"; my $target = ''; @@ -744,12 +813,16 @@ $self_path =~ s#/[^/]+$##; $self_path =~ s#/t/*$#/#; - $target .= qq#| cd $self_path && ./sender.pl --inbox="$arg->{'list'}"#; + $target .= qq#| cd $self_path && ./sender.pl --inbox="$list"#; - unless ($a->append($arg->{'email'}, $target)) { - croak "can't add alias ".$a->error_check; + if ($a->exists($email)) { + $a->update($email, $target) or croak "can't update alias ".$a->error_check; + } else { + $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; + return 1; } @@ -790,7 +863,7 @@ list => $name, email => $email, aliases => $aliases, - ) || croak "can't add alias $email for list $name"; + ) || warn "can't add alias $email for list $name"; my $l = $lists->find_or_create({ name => $name, @@ -832,6 +905,40 @@ return $lists->search({ name => lc($name) })->first; } + +=head2 _remove_alias + +Remove list alias + + my $ok = $nos->_remove_alias( + email => 'mylist@example.com', + aliases => '/etc/mail/mylist', + ); + +Returns true if list is removed or false if list doesn't exist. Dies in case of error. + +=cut + +sub _remove_alias { + my $self = shift; + + my $arg = {@_}; + + my $email = lc($arg->{'email'}) || confess "can't remove alias without email"; + my $aliases = lc($arg->{'aliases'}) || confess "can't remove alias without list"; + + my $a = new Mail::Alias($aliases) || croak "can't open aliases file $aliases: $!"; + + if ($a->exists($email)) { + $a->delete($email) || croak "can't remove alias $email"; + } else { + return 0; + } + + return 1; + +} + ### ### SOAP ### @@ -871,6 +978,10 @@ aliases => '/etc/aliases', ); +If you are writing SOAP server (like C example), you will need to +call this method once to make new instance of Nos::SOAP and specify C +and options for it. + =cut sub new { @@ -887,9 +998,9 @@ } -=head2 NewList +=head2 CreateList - $message_id = NewList( + $message_id = CreateList( list => 'My list', from => 'Name of my list', email => 'my-list@example.com' @@ -897,39 +1008,42 @@ =cut -sub NewList { +sub CreateList { my $self = shift; - my $aliases = $self->{'aliases'} || croak "Nos::SOAP need 'aliases' argument to new constructor"; + my $aliases = $nos->{'aliases'} || croak "need 'aliases' argument to new constructor"; if ($_[0] !~ m/^HASH/) { - return $nos->new_list( + return $nos->create_list( list => $_[0], from => $_[1], email => $_[2], aliases => $aliases, ); } else { - return $nos->new_list( %{ shift @_ }, aliases => $aliases ); + return $nos->create_list( %{ shift @_ }, aliases => $aliases ); } } -=head2 DeleteList +=head2 DropList - $ok = DeleteList( + $ok = DropList( list => 'My list', ); =cut -sub DeleteList { +sub DropList { my $self = shift; + my $aliases = $nos->{'aliases'} || croak "need 'aliases' argument to new constructor"; + if ($_[0] !~ m/^HASH/) { - return $nos->delete_list( + return $nos->drop_list( list => $_[0], + aliases => $aliases, ); } else { - return $nos->delete_list( %{ shift @_ } ); + return $nos->drop_list( %{ shift @_ }, aliases => $aliases ); } } @@ -965,10 +1079,6 @@ Returns array of hashes with user informations, see C. -Returning arrays from SOAP calls is somewhat fuzzy (at least to me). It -seems that SOAP::Lite client thinks that it has array with one element which -is array of hashes with data. - =cut sub ListMembers { @@ -1029,9 +1139,53 @@ } } +=head1 UNIMPLEMENTED FUNCTIONS + +This is a stub for documentation of unimplemented functions. + +=head2 MessagesReceived + + my @result = MessagesReceived( + list => 'My list', + email => 'jdoe@example.com', + ); + +You can specify just C or C or any combination of those. + +It will return array of hashes with following structure: + + { + 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 + } + +=head2 MessagesReceivedByDate + +=head2 MessagesReceivedByDateWithContent + +=head2 ReceivedMessasgeContent + +Return content of received message. + + my $mail_body = ReceivedMessageContent( id => 42 ); + +=cut + + + ### +=head1 NOTE ON ARRAYS IN SOAP + +Returning arrays from SOAP calls is somewhat fuzzy (at least to me). It +seems that SOAP::Lite client thinks that it has array with one element which +is array of hashes with data. + =head1 EXPORT Nothing.