--- trunk/Nos.pm 2005/05/15 22:30:54 24 +++ trunk/Nos.pm 2005/05/17 11:09:08 33 @@ -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 @@ -73,6 +76,36 @@ $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 +118,7 @@ C parametar is optional. -Return true if user is added. +Return member ID if user is added. =cut @@ -94,30 +127,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 +161,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 @@ -147,7 +181,7 @@ =cut -sub add_message_to_queue { +sub add_message_to_list { my $self = shift; my $args = {@_}; @@ -155,6 +189,13 @@ 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( @@ -218,16 +259,30 @@ 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, 10 ); + + my $hash = $auth->generate_hash( $to_email ); + + 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"; - my $hdr = "From: " . $u->list_id->name . " <" . $u->list_id->email . ">\n" . - "To: " . $u->user_id->full_name . " <". $u->user_id->email. ">\n"; + $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, @@ -243,18 +298,100 @@ } -=head2 EXPORT +=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; + + my $m = new Email::Simple->new($message); + +} -None by default. + +=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 + +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