--- trunk/Nos.pm 2005/05/15 22:12:31 23 +++ trunk/Nos.pm 2005/05/17 17:49:14 36 @@ -16,12 +16,16 @@ 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 Email::Address; +use Data::Dumper; =head1 NAME @@ -48,8 +52,12 @@ passwd => '', debug => 1, verbose => 1, + hash_len => 8, ); +Parametar C defined length of hash which will be added to each +outgoing e-mail message. + =cut sub new { @@ -70,9 +78,41 @@ relationships => 1, ) || croak "can't init Class::DBI::Loader"; + $self->{'hash_len'} ||= 8; + $self ? return $self : return undef; } + +=head2 new_list + +Create new list + + $nos->new_list( + list => 'My list", + email => 'my-list@example.com', + ); + +Returns ID of newly created list. + +=cut + +sub new_list { + my $self = shift; + + my $arg = {@_}; + + confess "need list name" unless ($arg->{'list'}); + confess "need list email" unless ($arg->{'list'}); + + my $l = $self->_get_list($arg->{'list'}) || + $self->_add_list( @_ ) || + return undef; + + return $l->id; +} + + =head2 add_member_to_list Add new member to list @@ -85,7 +125,7 @@ C parametar is optional. -Return true if user is added. +Return member ID if user is added. =cut @@ -94,30 +134,31 @@ 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"; 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, }) || croak "can't find or create member\n"; + if ($name && $this_user->full_name ne $name) { + $this_user->full_name($name || ''); + $this_user->update; + } + my $user_on_list = $user_list->find_or_create({ user_id => $this_user->id, list_id => $list->id, @@ -127,14 +168,76 @@ $this_user->dbi_commit; $user_on_list->dbi_commit; - return 1; + return $this_user->id; +} + +=head2 add_message_to_list + +Adds message to one list's queue for later sending. + + $nos->add_message_to_list( + list => 'My list', + message => 'Subject: welcome to list + + This is example message + ', + ); + +On success returns ID of newly created (or existing) message. + +Only required header in e-mail is C. C and C headers +will be automatically generated, but if you want to use own headers, just +include them in messages. + +=cut + +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"; + + my $m = Email::Simple->new($message_text) || croak "can't parse message"; + + unless( $m->header('Subject') ) { + warn "message doesn't have Subject header\n"; + return; + } + + 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 - $noc->send_queued_messages("my list"); + $nos->send_queued_messages("My list"); =cut @@ -166,20 +269,35 @@ foreach my $u ($user_list->search(list_id => $m->list_id)) { + my $to_email = $u->user_id->email; + + my ($from,$domain) = split(/@/, $u->list_id->email, 2); + 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 "=> $to_email\n"; + + my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id; + my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} ); + + my $hash = $auth->generate_hash( $to_email ); - my $hdr = "From: " . $u->list_id->name . " <" . $u->list_id->email . ">\n" . - "To: " . $u->user_id->full_name . " <". $u->user_id->email. ">\n"; + my $from = $u->list_id->name . " <" . $from . "+" . $hash . ( $domain ? "@" . $domain : '' ). ">"; + my $to = $u->user_id->full_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('To', $to) || croak "can't set To: header"; # FIXME do real sending :-) - send IO => "$hdr\n$msg"; + send IO => $m_obj->as_string; $sent->create({ message_id => $m->message_id, user_id => $u->user_id, + hash => $hash, }); $sent->dbi_commit; } @@ -191,18 +309,133 @@ } -=head2 EXPORT +=head2 inbox_message + +Receive single message for list's inbox. + + my $ok = $nos->inbox_message( + list => 'My list', + message => $message, + ); + +=cut + +sub inbox_message { + my $self = shift; + + my $arg = {@_}; + + return unless ($arg->{'message'}); + croak "need list name" unless ($arg->{'list'}); + + 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 @addrs = Email::Address->parse( $to ); + + die "can't parse To: $to address\n" unless (@addrs); + + my $hl = $self->{'hash_len'} || confess "no hash_len?"; + + my $hash; + + foreach my $a (@addrs) { + if ($a->address =~ m/\+([a-f0-9]{$hl})@/) { + $hash = $1; + last; + } + } + + croak "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 $message_id = $sent->search( hash => $hash )->first->message_id; + +print "message_id: $message_id\n"; + + warn "inbox is not yet implemented"; +} + + +=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 _get_list -None by default. +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') || confess "can't find lists class"; + + return $lists->search({ name => $name })->first; +} + + +=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