--- trunk/Nos.pm	2005/06/21 09:14:54	56
+++ trunk/Nos.pm	2005/07/08 11:46:35	66
@@ -26,6 +26,9 @@
 use Email::Simple;
 use Email::Address;
 use Mail::DeliveryStatus::BounceParser;
+use Class::DBI::AbstractSearch;
+use Mail::Alias;
+use Cwd qw(abs_path);
 
 
 =head1 NAME
@@ -39,7 +42,39 @@
 
 =head1 DESCRIPTION
 
-Core module for notice sender's functionality.
+Notice sender is mail handler. It is not MTA, since it doesn't know how to
+receive e-mails or send them directly to other hosts. It is not mail list
+manager because it requires programming to add list members and send
+messages. You can think of it as mechanisam for off-loading your e-mail
+sending to remote server using SOAP service.
+
+It's concept is based around B<lists>. Each list can have zero or more
+B<members>. Each list can have zero or more B<messages>.
+
+Here comes a twist: each outgoing message will have unique e-mail generated,
+so Notice Sender will be able to link received replies (or bounces) with
+outgoing messages.
+
+It doesn't do much more than that. It B<can't> create MIME encoded e-mail,
+send attachments, handle 8-bit characters in headers (which have to be
+encoded) or anything else.
+
+It will just queue your e-mail message to particular list (sending it to
+possibly remote Notice Sender SOAP server just once), send it out at
+reasonable rate (so that it doesn't flood your e-mail infrastructure) and
+track replies.
+
+It is best used to send smaller number of messages to more-or-less fixed
+list of recipients while allowing individual responses to be examined.
+Tipical use include replacing php e-mail sending code with SOAP call to
+Notice Sender. It does support additional C<ext_id> field for each member
+which can be used to track some unique identifier from remote system for
+particular user.
+
+It comes with command-line utility C<sender.pl> which can be used to perform
+all available operation from scripts (see C<perldoc sender.pl>).
+This command is also useful for debugging while writing client SOAP
+application.
 
 =head1 METHODS
 
@@ -74,7 +109,7 @@
 		user		=> $self->{'user'},
 		password	=> $self->{'passwd'},
 		namespace	=> "Nos",
-#		additional_classes      => qw/Class::DBI::AbstractSearch/,
+		additional_classes      => qw/Class::DBI::AbstractSearch/,
 #		additional_base_classes => qw/My::Stuff/,
 		relationships	=> 1,
 	) || croak "can't init Class::DBI::Loader";
@@ -98,7 +133,7 @@
 
 Returns ID of newly created list.
 
-Calls internally L<_add_list>, see details there.
+Calls internally C<_add_list>, see details there.
 
 =cut
 
@@ -121,6 +156,37 @@
 }
 
 
+=head2 delete_list
+
+Delete list from database.
+
+ my $ok = delete_list(
+ 	list => 'My list'
+ );
+
+Returns false if list doesn't exist.
+
+=cut
+
+sub delete_list {
+	my $self = shift;
+
+	my $args = {@_};
+
+	croak "need list to delete" unless ($args->{'list'});
+
+	$args->{'list'} = lc($args->{'list'});
+
+	my $lists = $self->{'loader'}->find_class('lists');
+
+	my $this_list = $lists->search( name => $args->{'list'} )->first || return;
+
+	$this_list->delete || croak "can't delete list\n";
+
+	return $lists->dbi_commit || croak "can't commit";
+}
+
+
 =head2 add_member_to_list
 
 Add new member to list
@@ -202,7 +268,7 @@
  }
 
 If list is not found, returns false. If there is C<ext_id> in user data,
-that will also be returned.
+it will also be returned.
 
 =cut
 
@@ -251,6 +317,9 @@
 
 Returns false if user doesn't exist.
 
+This function will delete member from all lists (by cascading delete), so it
+shouldn't be used lightly.
+
 =cut
 
 sub delete_member {
@@ -274,6 +343,46 @@
 	return $users->dbi_commit || croak "can't commit";
 }
 
+=head2 delete_member_from_list
+
+Delete member from particular list.
+
+ my $ok = delete_member_from_list(
+ 	list => 'My list',
+ 	email => 'dpavlin@rot13.org',
+ );
+
+Returns false if user doesn't exist on that particular list.
+
+It will die if list or user doesn't exist. You have been warned (you might
+want to eval this functon to prevent it from croaking).
+
+=cut
+
+sub delete_member_from_list {
+	my $self = shift;
+
+	my $args = {@_};
+
+	croak "need list name and email of user to delete" unless ($args->{'list'} && $args->{'email'});
+
+	$args->{'list'} = lc($args->{'list'});
+	$args->{'email'} = lc($args->{'email'});
+
+	my $user = $self->{'loader'}->find_class('users');
+	my $list = $self->{'loader'}->find_class('lists');
+	my $user_list = $self->{'loader'}->find_class('user_list');
+
+	my $this_user = $user->search( email => $args->{'email'} )->first || croak "can't find user: ".$args->{'email'};
+	my $this_list = $list->search( name => $args->{'list'} )->first || croak "can't find list: ".$args->{'list'};
+
+	my $this_user_list = $user_list->search_where( list_id => $this_list->id, user_id => $this_user->id )->first || return;
+
+	$this_user_list->delete || croak "can't delete user from list\n";
+
+	return $user_list->dbi_commit || croak "can't commit";
+}
+
 =head2 add_message_to_list
 
 Adds message to one list's queue for later sending.
@@ -413,7 +522,7 @@
 			if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {
 				print "SKIP $to_email message allready sent\n";
 			} else {
-				print "=> $to_email\n";
+				print "=> $to_email ";
 
 				my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id;
 				my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} );
@@ -439,18 +548,32 @@
 				$m_obj->header_set('X-Nos-Hash', $hash);
 
 				# really send e-mail
+				my $sent_status;
+
 				if (@email_send_options) {
-					send $email_send_driver => $m_obj->as_string, @email_send_options;
+					$sent_status = send $email_send_driver => $m_obj->as_string, @email_send_options;
 				} else {
-					send $email_send_driver => $m_obj->as_string;
+					$sent_status = send $email_send_driver => $m_obj->as_string;
 				}
 
-				$sent->create({
-					message_id => $m->message_id,
-					user_id => $u->user_id,
-					hash => $hash,
-				});
-				$sent->dbi_commit;
+				croak "can't send e-mail: $sent_status\n\nOriginal e-mail follows:\n".$m_obj->as_string unless ($sent_status);
+				my @bad = @{ $sent_status->prop('bad') };
+				croak "failed sending to ",join(",",@bad) if (@bad);
+
+				if ($sent_status) {
+
+					$sent->create({
+						message_id => $m->message_id,
+						user_id => $u->user_id,
+						hash => $hash,
+					});
+					$sent->dbi_commit;
+
+					print " - $sent_status\n";
+
+				} else {
+					warn "ERROR: $sent_status\n";
+				}
 
 				if ($sleep) {
 					warn "sleeping $sleep seconds\n";
@@ -474,6 +597,8 @@
 	message => $message,
  );
 
+This method is used by C<sender.pl> when receiving e-mail messages.
+
 =cut
 
 sub inbox_message {
@@ -564,6 +689,70 @@
 
 Beware of dragons! You shouldn't need to call those methods directly.
 
+
+=head2 _add_aliases
+
+Add new list to C</etc/aliases> (or equivavlent) file
+
+ my $ok = $nos->add_aliases(
+ 	list => 'My list',
+	email => 'my-list@example.com',
+	aliases => '/etc/mail/mylist',
+	archive => '/path/to/mbox/archive',
+
+ );
+
+C<archive> parametar is optional.
+
+Return false on failure.
+
+=cut
+
+sub _add_aliases {
+	my $self = shift;
+
+	my $arg = {@_};
+
+	croak "need list and email options" unless ($arg->{'list'} && $arg->{'email'});
+
+	my $aliases = $arg->{'aliases'} || croak "need aliases";
+
+	unless (-e $aliases) {
+		warn "aliases file $aliases doesn't exist, creating empty\n";
+		open(my $fh, '>', $aliases) || croak "can't create $aliases: $!";
+		close($fh);
+	}
+
+	my $a = new Mail::Alias($aliases) || croak "can't open aliases file $aliases: $!";
+
+	my $target = '';
+
+	if (my $archive = $arg->{'archive'}) {
+		$target .= "$archive, ";
+
+		if (! -e $archive) {
+			warn "please make sure that file $archive is writable for your e-mail user (defaulting to bad 777 permission for now)";
+
+			open(my $fh, '>', $archive) || croak "can't create archive file $archive: $!";
+			close($fh);
+			chmod 0777, $archive || croak "can't chmod archive file $archive to 0777: $!";
+		}
+	}
+
+	# resolve my path to absolute one
+	my $self_path = abs_path($0);
+	$self_path =~ s#/[^/]+$##;
+	$self_path =~ s#/t/*$#/#;
+
+	$target .= qq#| cd $self_path && ./sender.pl --inbox="$arg->{'list'}"#;
+
+	unless ($a->append($arg->{'email'}, $target)) {
+		croak "can't add alias ".$a->error_check;
+	}
+
+	return 1;
+}
+
 =head2 _add_list
 
 Create new list
@@ -572,6 +761,7 @@
  	list => 'My list',
 	from => 'Outgoing from comment',
 	email => 'my-list@example.com',
+	aliases => '/etc/mail/mylist',
  );
 
 Returns C<Class::DBI> object for created list.
@@ -590,10 +780,18 @@
 
 	my $name = lc($arg->{'list'}) || confess "can't add list without name";
 	my $email = lc($arg->{'email'}) || confess "can't add list without e-mail";
+	my $aliases = lc($arg->{'aliases'}) || confess "can't add list without path to aliases file";
+
 	my $from_addr = $arg->{'from'};
 
 	my $lists = $self->{'loader'}->find_class('lists');
 
+	$self->_add_aliases(
+		list => $name,
+		email => $email,
+		aliases => $aliases,
+	) || croak "can't add alias $email for list $name";
+
 	my $l = $lists->find_or_create({
 		name => $name,
 		email => $email,
@@ -613,6 +811,7 @@
 }
 
 
+
 =head2 _get_list
 
 Get list C<Class::DBI> object.
@@ -657,9 +856,29 @@
 
 my $nos;
 
+
+=head2 new
+
+Create new SOAP object
+
+ my $soap = new Nos::SOAP(
+	dsn => 'dbi:Pg:dbname=notices',
+	user => 'dpavlin',
+	passwd => '',
+	debug => 1,
+	verbose => 1,
+	hash_len => 8,
+	aliases => '/etc/aliases',
+ );
+
+=cut
+
 sub new {
         my $class = shift;
         my $self = {@_};
+
+	croak "need aliases parametar" unless ($self->{'aliases'});
+
 	bless($self, $class);
 
 	$nos = new Nos( @_ ) || die "can't create Nos object";
@@ -681,22 +900,46 @@
 sub NewList {
 	my $self = shift;
 
+	my $aliases = $self->{'aliases'} || croak "Nos::SOAP need 'aliases' argument to new constructor";
+
 	if ($_[0] !~ m/^HASH/) {
 		return $nos->new_list(
 			list => $_[0], from => $_[1], email => $_[2],
+			aliases => $aliases,
 		);
 	} else {
-		return $nos->new_list( %{ shift @_ } );
+		return $nos->new_list( %{ shift @_ }, aliases => $aliases );
 	}
 }
 
 
+=head2 DeleteList
+
+ $ok = DeleteList(
+	list => 'My list',
+ ); 
+
+=cut
+
+sub DeleteList {
+	my $self = shift;
+
+	if ($_[0] !~ m/^HASH/) {
+		return $nos->delete_list(
+			list => $_[0],
+		);
+	} else {
+		return $nos->delete_list( %{ shift @_ } );
+	}
+}
+
 =head2 AddMemberToList
 
  $member_id = AddMemberToList(
 	list => 'My list',
 	email => 'e-mail@example.com',
-	name => 'Full Name'
+	name => 'Full Name',
+	ext_id => 42,
  );
 
 =cut
@@ -706,7 +949,7 @@
 
 	if ($_[0] !~ m/^HASH/) {
 		return $nos->add_member_to_list(
-			list => $_[0], email => $_[1], name => $_[2],
+			list => $_[0], email => $_[1], name => $_[2], ext_id => $_[4],
 		);
 	} else {
 		return $nos->add_member_to_list( %{ shift @_ } );
@@ -722,6 +965,10 @@
 
 Returns array of hashes with user informations, see C<list_members>.
 
+Returning arrays from SOAP calls is somewhat fuzzy (at least to me). It
+seems that SOAP::Lite client thinks that it has array with one element which
+is array of hashes with data.
+
 =cut
 
 sub ListMembers {
@@ -735,9 +982,32 @@
 		$list_name = $_[0]->{'list'};
 	}
 
-	return $nos->list_members( list => $list_name );
+	return [ $nos->list_members( list => $list_name ) ];
 }
 
+
+=head2 DeleteMemberFromList
+
+ $member_id = DeleteMemberFromList(
+	list => 'My list',
+	email => 'e-mail@example.com',
+ );
+
+=cut
+
+sub DeleteMemberFromList {
+	my $self = shift;
+
+	if ($_[0] !~ m/^HASH/) {
+		return $nos->delete_member_from_list(
+			list => $_[0], email => $_[1],
+		);
+	} else {
+		return $nos->delete_member_from_list( %{ shift @_ } );
+	}
+}
+
+
 =head2 AddMessageToList
 
  $message_id = AddMessageToList(