--- trunk/Nos.pm 2005/05/15 21:35:15 21 +++ trunk/Nos.pm 2005/05/16 21:54:41 30 @@ -16,12 +16,15 @@ our @EXPORT = qw( ); -our $VERSION = '0.1'; +our $VERSION = '0.3'; use Class::DBI::Loader; use Email::Valid; use Email::Send; use Carp; +use Email::Auth::AddressHash; +use Email::Simple; +use Data::Dumper; =head1 NAME @@ -57,6 +60,8 @@ my $self = {@_}; bless($self, $class); + croak "need at least dsn" unless ($self->{'dsn'}); + $self->{'loader'} = Class::DBI::Loader->new( debug => $self->{'debug'}, dsn => $self->{'dsn'}, @@ -66,53 +71,295 @@ # additional_classes => qw/Class::DBI::AbstractSearch/, # additional_base_classes => qw/My::Stuff/, relationships => 1, - ); + ) || croak "can't init Class::DBI::Loader"; $self ? return $self : return undef; } -=head2 update_list_email -Update list e-mail address +=head2 add_member_to_list + +Add new member to list + + $nos->add_member_to_list( + list => "My list", + email => "john.doe@example.com", + name => "John A. Doe", + ); + +C parametar is optional. - $noc->update_list_email($list, 'foobar@example.com'); +Return member ID if user is added. =cut -sub update_list_email { +sub add_member_to_list { my $self = shift; + my $arg = {@_}; + + my $email = $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 = $self->_get_list($list_name) || croak "list $list_name doesn't exist"; + + if (! Email::Valid->address($email)) { + carp "SKIPPING $name <$email>\n" if ($self->{'verbose'}); + return 0; + } + + carp "# $name <$email>\n" if ($self->{'verbose'}); + + my $users = $self->{'loader'}->find_class('users'); + my $user_list = $self->{'loader'}->find_class('user_list'); + + my $this_user = $users->find_or_create({ + email => $email, + full_name => $name, + }) || croak "can't find or create member\n"; + my $user_on_list = $user_list->find_or_create({ + user_id => $this_user->id, + list_id => $list->id, + }) || croak "can't add user to list"; + + $list->dbi_commit; + $this_user->dbi_commit; + $user_on_list->dbi_commit; + + return $this_user->id; } -=head2 send +=head2 add_message_to_list + +Adds message to one list's queue for later sending. -Send a message using configured mailer. + $nos->add_message_to_list( + list => 'My list', + message => 'From: My list + To: John A. Doe + + This is example message + ', + ); - $nos->send("message with headers"); +On success returns ID of newly created (or existing) message. =cut -sub send_email { +sub add_message_to_list { + my $self = shift; + + my $args = {@_}; + + my $list_name = $args->{'list'} || confess "need list name"; + my $message_text = $args->{'message'} || croak "need message"; + + warn Dumper($message_text); + + my $m = Email::Simple->new($message_text) || croak "can't parse message"; + + croak "message doesn't have Subject header\n" unless( $m->header('Subject') ); + + my $lists = $self->{'loader'}->find_class('lists'); + + my $this_list = $lists->search( + name => $list_name, + )->first || croak "can't find list $list_name"; + + my $messages = $self->{'loader'}->find_class('messages'); + + my $this_message = $messages->find_or_create({ + message => $message_text + }) || croak "can't insert message"; + + $this_message->dbi_commit() || croak "can't add message"; + + my $queue = $self->{'loader'}->find_class('queue'); + + $queue->find_or_create({ + message_id => $this_message->id, + list_id => $this_list->id, + }) || croak "can't add message ",$this_message->id," to list ",$this_list->id, ": ",$this_list->name; + + $queue->dbi_commit || croak "can't add message to list ",$this_list->name; + + return $this_message->id; +} + + +=head2 send_queued_messages + +Send queued messages or just ones for selected list + + $nos->send_queued_messages("My list"); + +=cut + +sub send_queued_messages { + my $self = shift; + + my $list_name = shift; + + my $lists = $self->{'loader'}->find_class('lists'); + my $queue = $self->{'loader'}->find_class('queue'); + my $user_list = $self->{'loader'}->find_class('user_list'); + my $sent = $self->{'loader'}->find_class('sent'); + + my $my_q; + if ($list_name ne '') { + my $l_id = $lists->search_like( name => $list_name )->first || + croak "can't find list $list_name"; + $my_q = $queue->search_like( list_id => $l_id ) || + croak "can't find list $list_name"; + } else { + $my_q = $queue->retrieve_all; + } + + while (my $m = $my_q->next) { + next if ($m->all_sent); + + print "sending message ",$m->message_id," enqueued on ",$m->date," to list ",$m->list_id->name,"\n"; + my $msg = $m->message_id->message; + + my $auth = Email::Auth::AddressHash->new( + $m->list_id->name, # secret + 10, # hashlen + ); + + foreach my $u ($user_list->search(list_id => $m->list_id)) { + + my $to_email = $u->user_id->email; + + if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) { + print "SKIP $to_email message allready sent\n"; + } else { + print "\t$to_email\n"; + + my $hash = $auth->generate_hash( $to_email ); + + my $from = $u->list_id->name . " <" . $u->list_id->email . "+" . $hash . ">"; + my $to = $u->user_id->full_name . " <$to_email>"; + + my $m = Email::Simple->new($msg) || croak "can't parse message"; + + print Dumper($m); + + $m->header_set('From', $from) || croak "can't set From: header"; + $m->header_set('To', $to) || croak "can't set To: header"; + + # FIXME do real sending :-) + send IO => $m->as_string; + + $sent->create({ + message_id => $m->message_id, + user_id => $u->user_id, + }); + $sent->dbi_commit; + } + } + $m->all_sent(1); + $m->update; + $m->dbi_commit; + } + +} + +=head2 inbox_message + +Receive single message for list's inbox. + + my $ok = $nos->inbox_message($message); + +=cut + +sub inbox_message { my $self = shift; my $message = shift || return; - send IO => $message; + my $m = new Email::Simple->new($message); + +} + + +=head1 INTERNAL METHODS + +Beware of dragons! You shouldn't need to call those methods directly. + +=head2 _add_list + +Create new list + + my $list_obj = $nos->_add_list( + list => 'My list', + email => 'my-list@example.com', + ); + +Returns C object for created list. + +=cut + +sub _add_list { + my $self = shift; + + 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 $lists = $self->{'loader'}->find_class('lists'); + + my $l = $lists->find_or_create({ + name => $name, + email => $email, + }); + + croak "can't add list $name\n" unless ($l); + + $l->dbi_commit; + + return $l; + } -=head2 EXPORT -None by default. +=head2 _get_list + +Get list C object. + + my $list_obj = $nos->check_list('My list'); + +Returns false on failure. + +=cut + +sub _get_list { + my $self = shift; + + my $name = shift || return; + + my $lists = $self->{'loader'}->find_class('lists'); + + return $lists->search({ name => $name }); +} + + +=head1 EXPORT + +Nothing. =head1 SEE ALSO mailman, ezmlm, sympa, L + =head1 AUTHOR Dobrica Pavlinusic, Edpavlin@rot13.orgE + =head1 COPYRIGHT AND LICENSE Copyright (C) 2005 by Dobrica Pavlinusic