--- trunk/Nos.pm	2005/05/16 22:32:58	32
+++ trunk/Nos.pm	2005/05/18 13:12:54	45
@@ -16,7 +16,7 @@
 our @EXPORT = qw( 
 );
 
-our $VERSION = '0.3';
+our $VERSION = '0.4';
 
 use Class::DBI::Loader;
 use Email::Valid;
@@ -24,6 +24,8 @@
 use Carp;
 use Email::Auth::AddressHash;
 use Email::Simple;
+use Email::Address;
+use Mail::DeliveryStatus::BounceParser;
 use Data::Dumper;
 
 =head1 NAME
@@ -51,8 +53,12 @@
 	passwd => '',
 	debug => 1,
 	verbose => 1,
+	hash_len => 8,
  );
 
+Parametar C<hash_len> defines length of hash which will be added to each
+outgoing e-mail message to ensure that replies can be linked with sent e-mails.
+
 =cut
 
 sub new {
@@ -73,10 +79,44 @@
 		relationships	=> 1,
 	) || croak "can't init Class::DBI::Loader";
 
+	$self->{'hash_len'} ||= 8;
+
 	$self ? return $self : return undef;
 }
 
 
+=head2 new_list
+
+Create new list. Required arguments are name of C<list> and
+C<email> address.
+
+ $nos->new_list(
+ 	list => 'My list',
+	email => 'my-list@example.com',
+ );
+
+Returns ID of newly created list.
+
+Calls internally L<_add_list>, see details there.
+
+=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
@@ -105,7 +145,7 @@
 	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'});
+		carp "SKIPPING $name <$email>\n";
 		return 0;
 	}
 
@@ -116,9 +156,13 @@
 
 	my $this_user = $users->find_or_create({
 		email => $email,
-		full_name => $name,
 	}) || croak "can't find or create member\n";
 
+	if ($name && $this_user->name ne $name) {
+		$this_user->name($name || '');
+		$this_user->update;
+	}
+
 	my $user_on_list = $user_list->find_or_create({
 		user_id => $this_user->id,
 		list_id => $list->id,
@@ -131,21 +175,108 @@
 	return $this_user->id;
 }
 
+=head2 list_members
+
+List all members of some list.
+
+ my @members = list_members(
+ 	list => 'My list',
+ );
+
+Returns array of hashes with user informations like this:
+
+ $member = {
+ 	name => 'Dobrica Pavlinusic',
+	email => 'dpavlin@rot13.org
+ }
+
+If list is not found, returns false.
+
+=cut
+
+sub list_members {
+	my $self = shift;
+
+	my $args = {@_};
+
+	my $list_name = $args->{'list'} || confess "need list name";
+
+	my $lists = $self->{'loader'}->find_class('lists');
+	my $user_list = $self->{'loader'}->find_class('user_list');
+
+	my $this_list = $lists->search( name => $list_name )->first || return;
+
+	my @results;
+
+	foreach my $user_on_list ($user_list->search(list_id => $this_list->id)) {
+		my $row = {
+			name => $user_on_list->user_id->name,
+			email => $user_on_list->user_id->email,
+		};
+
+		push @results, $row;
+	}
+
+	return @results;
+
+}
+
+
+=head2 delete_member
+
+Delete member from database.
+
+ my $ok = delete_member(
+ 	name => 'Dobrica Pavlinusic'
+ );
+
+ my $ok = delete_member(
+ 	email => 'dpavlin@rot13.org'
+ );
+
+Returns false if user doesn't exist.
+
+=cut
+
+sub delete_member {
+	my $self = shift;
+
+	my $args = {@_};
+
+	croak "need name or email of user to delete" unless ($args->{'name'} || $args->{'email'});
+
+	my $key = 'name';
+	$key = 'email' if ($args->{'email'});
+
+	my $users = $self->{'loader'}->find_class('users');
+
+	my $this_user = $users->search( $key => $args->{$key} )->first || return;
+
+print Dumper($this_user);
+
+	$this_user->delete || croak "can't delete user\n";
+
+	return $users->dbi_commit || croak "can't commit";
+}
+
 =head2 add_message_to_list
 
 Adds message to one list's queue for later sending.
 
  $nos->add_message_to_list(
  	list => 'My list',
- 	message => 'From: My list <mylist@example.com>
- To: John A. Doe <john.doe@example.com>
- 
+ 	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<Subject:>. C<From:> and C<To:> headers
+will be automatically generated, but if you want to use own headers, just
+include them in messages.
+
 =cut
 
 sub add_message_to_list {
@@ -236,24 +367,28 @@
 				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 $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} );
 
 				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 $to = $u->user_id->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";
 
+				$m_obj->header_set('X-Nos-Version', $VERSION);
+				$m_obj->header_set('X-Nos-Hash', $hash);
+
 				# FIXME do real sending :-)
 				send IO => $m_obj->as_string;
 
 				$sent->create({
 					message_id => $m->message_id,
 					user_id => $u->user_id,
+					hash => $hash,
 				});
 				$sent->dbi_commit;
 			}
@@ -269,17 +404,82 @@
 
 Receive single message for list's inbox.
 
- my $ok = $nos->inbox_message($message);
+ my $ok = $nos->inbox_message(
+ 	list => 'My list',
+	message => $message,
+ );
 
 =cut
 
 sub inbox_message {
 	my $self = shift;
 
-	my $message = shift || return;
+	my $arg = {@_};
+
+	return unless ($arg->{'message'});
+	croak "need list name" unless ($arg->{'list'});
+
+	my $this_list = $self->_get_list($arg->{'list'}) || croak "can't find list ".$arg->{'list'}."\n";
+
+	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 $sent_msg = $sent->search( hash => $hash )->first;
+
+	my ($message_id, $user_id) = (undef, undef);	# init with NULL
+
+	if ($sent_msg) {
+		$message_id = $sent_msg->message_id || carp "no message_id";
+		$user_id = $sent_msg->user_id || carp "no user_id";
+	}
+
+
+	my $is_bounce = 0;
+
+	my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(
+		$arg->{'message'}, { report_non_bounces=>1 },
+	) };
+	carp "can't check if this message is bounce!" if ($@);
+
+	$is_bounce++ if ($bounce && $bounce->is_bounce);
 
-	my $m = new Email::Simple->new($message);
+	my $received = $self->{'loader'}->find_class('received');
 
+	my $this_received = $received->find_or_create({
+		user_id => $user_id,
+		list_id => $this_list->id,
+		message_id => $message_id,
+		message => $arg->{'message'},
+		bounced => $is_bounce,
+	}) || croak "can't insert received message";
+
+	$this_received->dbi_commit;
+
+	print "message_id: ",($message_id || "not found")," -- $is_bounce\n";
+
+
+	warn "inbox is not yet implemented";
 }
 
 
@@ -298,6 +498,11 @@
 
 Returns C<Class::DBI> object for created list.
 
+C<email> address can be with domain or without it if your
+MTA appends it. There is no checking for validity of your
+list e-mail. Flexibility comes with resposibility, so please
+feed correct (and configured) return addresses.
+
 =cut
 
 sub _add_list {
@@ -344,6 +549,133 @@
 	return $lists->search({ name => $name })->first;
 }
 
+###
+### SOAP
+###
+
+package Nos::SOAP;
+
+use Carp;
+
+=head1 SOAP methods
+
+This methods are thin wrappers to provide SOAP calls. They are grouped in
+C<Nos::SOAP> package which is in same F<Nos.pm> module file.
+
+Usually, you want to use named variables in your SOAP calls if at all
+possible.
+
+However, if you have broken SOAP library (like PHP SOAP class from PEAR)
+you will want to use positional arguments (in same order as documented for
+methods below).
+
+=cut
+
+my $nos;
+
+sub new {
+        my $class = shift;
+        my $self = {@_};
+	bless($self, $class);
+
+	$nos = new Nos( @_ ) || die "can't create Nos object";
+
+	$self ? return $self : return undef;
+}
+
+
+=head2 NewList
+
+ $message_id = NewList(
+	list => 'My list',
+	email => 'my-list@example.com'
+ ); 
+
+=cut
+
+sub NewList {
+	my $self = shift;
+
+	if ($_[0] !~ m/^HASH/) {
+		return $nos->new_list(
+			list => $_[0], email => $_[1],
+		);
+	} else {
+		return $nos->new_list( %{ shift @_ } );
+	}
+}
+
+
+=head2 AddMemberToList
+
+ $member_id = AddMemberToList(
+	list => 'My list',
+	email => 'e-mail@example.com',
+	name => 'Full Name'
+ );
+
+=cut
+
+sub AddMemberToList {
+	my $self = shift;
+
+	if ($_[0] !~ m/^HASH/) {
+		return $nos->add_member_to_list(
+			list => $_[0], email => $_[1], name => $_[2],
+		);
+	} else {
+		return $nos->add_member_to_list( %{ shift @_ } );
+	}
+}
+
+
+=head2 ListMembers
+
+ my @members = ListMembers(
+ 	list => 'My list',
+ );
+
+Returns array of hashes with user informations, see C<list_members>.
+
+=cut
+
+sub ListMembers {
+	my $self = shift;
+
+	my $list_name;
+
+	if ($_[0] !~ m/^HASH/) {
+		$list_name = shift;
+	} else {
+		$list_name = $_[0]->{'list'};
+	}
+
+	return $nos->list_members( list => $list_name );
+}
+
+=head2 AddMessageToList
+
+ $message_id = AddMessageToList(
+	list => 'My list',
+	message => 'From: My list...'
+ ); 
+
+=cut
+
+sub AddMessageToList {
+	my $self = shift;
+
+	if ($_[0] !~ m/^HASH/) {
+		return $nos->add_message_to_list(
+			list => $_[0], message => $_[1],
+		);
+	} else {
+		return $nos->add_message_to_list( %{ shift @_ } );
+	}
+}
+
+
+###
 
 =head1 EXPORT
 
@@ -369,3 +701,5 @@
 
 
 =cut
+
+1;