--- trunk/Nos.pm 2005/05/16 13:52:43 25 +++ trunk/Nos.pm 2005/05/16 21:54:41 30 @@ -9,8 +9,6 @@ our @ISA = qw(Exporter); our %EXPORT_TAGS = ( 'all' => [ qw( - add_member_to_list - add_message_to_queue ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); @@ -18,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 @@ -75,6 +76,7 @@ $self ? return $self : return undef; } + =head2 add_member_to_list Add new member to list @@ -87,7 +89,7 @@ C parametar is optional. -Return true if user is added. +Return member ID if user is added. =cut @@ -96,25 +98,22 @@ my $arg = {@_}; - my $email = $arg->{'email'} || confess "can't add user without e-mail"; + my $email = $arg->{'email'} || croak "can't add user without e-mail"; my $name = $arg->{'name'} || ''; - confess "need list name" unless ($arg->{'list'}); + 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)) { - warn "SKIPPING $name <$email>"; + carp "SKIPPING $name <$email>\n" if ($self->{'verbose'}); return 0; } - print "# $name <$email>\n"; + carp "# $name <$email>\n" if ($self->{'verbose'}); - my $lists = $self->{'loader'}->find_class('lists'); my $users = $self->{'loader'}->find_class('users'); my $user_list = $self->{'loader'}->find_class('user_list'); - my $list = $lists->find_or_create({ - name => $arg->{'list'}, - }) || croak "can't add list ",$arg->{'list'},"\n"; - my $this_user = $users->find_or_create({ email => $email, full_name => $name, @@ -129,14 +128,14 @@ $this_user->dbi_commit; $user_on_list->dbi_commit; - return 1; + return $this_user->id; } -=head2 add_message_to_queue +=head2 add_message_to_list Adds message to one list's queue for later sending. - $nos->add_message_to_queue( + $nos->add_message_to_list( list => 'My list', message => 'From: My list To: John A. Doe @@ -149,7 +148,7 @@ =cut -sub add_message_to_queue { +sub add_message_to_list { my $self = shift; my $args = {@_}; @@ -157,6 +156,12 @@ 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( @@ -218,18 +223,34 @@ 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 ",$u->user_id->email," message allready sent\n"; + print "SKIP $to_email message allready sent\n"; } else { - print "\t",$u->user_id->email,"\n"; + 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"; - my $hdr = "From: " . $u->list_id->name . " <" . $u->list_id->email . ">\n" . - "To: " . $u->user_id->full_name . " <". $u->user_id->email. ">\n"; + 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 => "$hdr\n$msg"; + send IO => $m->as_string; $sent->create({ message_id => $m->message_id, @@ -245,18 +266,89 @@ } -=head1 EXPORT +=head2 inbox_message -Exported methods are also available using SOAP interface. For now, those are: +Receive single message for list's inbox. -=over 4 + my $ok = $nos->inbox_message($message); -=item add_member_to_list +=cut -=item add_message_to_queue +sub inbox_message { + my $self = shift; + + my $message = shift || return; + + 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 -=back +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 _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