/[notice-sender]/trunk/Nos.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/Nos.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 56 by dpavlin, Tue Jun 21 09:14:54 2005 UTC revision 65 by dpavlin, Wed Jun 29 17:05:30 2005 UTC
# Line 26  use Email::Auth::AddressHash; Line 26  use Email::Auth::AddressHash;
26  use Email::Simple;  use Email::Simple;
27  use Email::Address;  use Email::Address;
28  use Mail::DeliveryStatus::BounceParser;  use Mail::DeliveryStatus::BounceParser;
29    use Class::DBI::AbstractSearch;
30    
31    
32  =head1 NAME  =head1 NAME
# Line 39  Nos - Notice Sender core module Line 40  Nos - Notice Sender core module
40    
41  =head1 DESCRIPTION  =head1 DESCRIPTION
42    
43  Core module for notice sender's functionality.  Notice sender is mail handler. It is not MTA, since it doesn't know how to
44    receive e-mails or send them directly to other hosts. It is not mail list
45    manager because it requires programming to add list members and send
46    messages. You can think of it as mechanisam for off-loading your e-mail
47    sending to remote server using SOAP service.
48    
49    It's concept is based around B<lists>. Each list can have zero or more
50    B<members>. Each list can have zero or more B<messages>.
51    
52    Here comes a twist: each outgoing message will have unique e-mail generated,
53    so Notice Sender will be able to link received replies (or bounces) with
54    outgoing messages.
55    
56    It doesn't do much more than that. It B<can't> create MIME encoded e-mail,
57    send attachments, handle 8-bit characters in headers (which have to be
58    encoded) or anything else.
59    
60    It will just queue your e-mail message to particular list (sending it to
61    possibly remote Notice Sender SOAP server just once), send it out at
62    reasonable rate (so that it doesn't flood your e-mail infrastructure) and
63    track replies.
64    
65    It is best used to send smaller number of messages to more-or-less fixed
66    list of recipients while allowing individual responses to be examined.
67    Tipical use include replacing php e-mail sending code with SOAP call to
68    Notice Sender. It does support additional C<ext_id> field for each member
69    which can be used to track some unique identifier from remote system for
70    particular user.
71    
72    It comes with command-line utility C<sender.pl> which can be used to perform
73    all available operation from scripts (see C<perldoc sender.pl>).
74    This command is also useful for debugging while writing client SOAP
75    application.
76    
77  =head1 METHODS  =head1 METHODS
78    
# Line 74  sub new { Line 107  sub new {
107                  user            => $self->{'user'},                  user            => $self->{'user'},
108                  password        => $self->{'passwd'},                  password        => $self->{'passwd'},
109                  namespace       => "Nos",                  namespace       => "Nos",
110  #               additional_classes      => qw/Class::DBI::AbstractSearch/,                  additional_classes      => qw/Class::DBI::AbstractSearch/,
111  #               additional_base_classes => qw/My::Stuff/,  #               additional_base_classes => qw/My::Stuff/,
112                  relationships   => 1,                  relationships   => 1,
113          ) || croak "can't init Class::DBI::Loader";          ) || croak "can't init Class::DBI::Loader";
# Line 98  C<email> address. Line 131  C<email> address.
131    
132  Returns ID of newly created list.  Returns ID of newly created list.
133    
134  Calls internally L<_add_list>, see details there.  Calls internally C<_add_list>, see details there.
135    
136  =cut  =cut
137    
# Line 121  sub new_list { Line 154  sub new_list {
154  }  }
155    
156    
157    =head2 delete_list
158    
159    Delete list from database.
160    
161     my $ok = delete_list(
162            list => 'My list'
163     );
164    
165    Returns false if list doesn't exist.
166    
167    =cut
168    
169    sub delete_list {
170            my $self = shift;
171    
172            my $args = {@_};
173    
174            croak "need list to delete" unless ($args->{'list'});
175    
176            $args->{'list'} = lc($args->{'list'});
177    
178            my $lists = $self->{'loader'}->find_class('lists');
179    
180            my $this_list = $lists->search( name => $args->{'list'} )->first || return;
181    
182            $this_list->delete || croak "can't delete list\n";
183    
184            return $lists->dbi_commit || croak "can't commit";
185    }
186    
187    
188  =head2 add_member_to_list  =head2 add_member_to_list
189    
190  Add new member to list  Add new member to list
# Line 202  Returns array of hashes with user inform Line 266  Returns array of hashes with user inform
266   }   }
267    
268  If list is not found, returns false. If there is C<ext_id> in user data,  If list is not found, returns false. If there is C<ext_id> in user data,
269  that will also be returned.  it will also be returned.
270    
271  =cut  =cut
272    
# Line 251  Delete member from database. Line 315  Delete member from database.
315    
316  Returns false if user doesn't exist.  Returns false if user doesn't exist.
317    
318    This function will delete member from all lists (by cascading delete), so it
319    shouldn't be used lightly.
320    
321  =cut  =cut
322    
323  sub delete_member {  sub delete_member {
# Line 274  sub delete_member { Line 341  sub delete_member {
341          return $users->dbi_commit || croak "can't commit";          return $users->dbi_commit || croak "can't commit";
342  }  }
343    
344    =head2 delete_member_from_list
345    
346    Delete member from particular list.
347    
348     my $ok = delete_member_from_list(
349            list => 'My list',
350            email => 'dpavlin@rot13.org',
351     );
352    
353    Returns false if user doesn't exist on that particular list.
354    
355    It will die if list or user doesn't exist. You have been warned (you might
356    want to eval this functon to prevent it from croaking).
357    
358    =cut
359    
360    sub delete_member_from_list {
361            my $self = shift;
362    
363            my $args = {@_};
364    
365            croak "need list name and email of user to delete" unless ($args->{'list'} && $args->{'email'});
366    
367            $args->{'list'} = lc($args->{'list'});
368            $args->{'email'} = lc($args->{'email'});
369    
370            my $user = $self->{'loader'}->find_class('users');
371            my $list = $self->{'loader'}->find_class('lists');
372            my $user_list = $self->{'loader'}->find_class('user_list');
373    
374            my $this_user = $user->search( email => $args->{'email'} )->first || croak "can't find user: ".$args->{'email'};
375            my $this_list = $list->search( name => $args->{'list'} )->first || croak "can't find list: ".$args->{'list'};
376    
377            my $this_user_list = $user_list->search_where( list_id => $this_list->id, user_id => $this_user->id )->first || return;
378    
379            $this_user_list->delete || croak "can't delete user from list\n";
380    
381            return $user_list->dbi_commit || croak "can't commit";
382    }
383    
384  =head2 add_message_to_list  =head2 add_message_to_list
385    
386  Adds message to one list's queue for later sending.  Adds message to one list's queue for later sending.
# Line 413  sub send_queued_messages { Line 520  sub send_queued_messages {
520                          if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {                          if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {
521                                  print "SKIP $to_email message allready sent\n";                                  print "SKIP $to_email message allready sent\n";
522                          } else {                          } else {
523                                  print "=> $to_email\n";                                  print "=> $to_email ";
524    
525                                  my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id;                                  my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id;
526                                  my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} );                                  my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} );
# Line 439  sub send_queued_messages { Line 546  sub send_queued_messages {
546                                  $m_obj->header_set('X-Nos-Hash', $hash);                                  $m_obj->header_set('X-Nos-Hash', $hash);
547    
548                                  # really send e-mail                                  # really send e-mail
549                                    my $sent_status;
550    
551                                  if (@email_send_options) {                                  if (@email_send_options) {
552                                          send $email_send_driver => $m_obj->as_string, @email_send_options;                                          $sent_status = send $email_send_driver => $m_obj->as_string, @email_send_options;
553                                  } else {                                  } else {
554                                          send $email_send_driver => $m_obj->as_string;                                          $sent_status = send $email_send_driver => $m_obj->as_string;
555                                  }                                  }
556    
557                                  $sent->create({                                  croak "can't send e-mail: $sent_status\n\nOriginal e-mail follows:\n".$m_obj->as_string unless ($sent_status);
558                                          message_id => $m->message_id,                                  my @bad = @{ $sent_status->prop('bad') };
559                                          user_id => $u->user_id,                                  croak "failed sending to ",join(",",@bad) if (@bad);
560                                          hash => $hash,  
561                                  });                                  if ($sent_status) {
562                                  $sent->dbi_commit;  
563                                            $sent->create({
564                                                    message_id => $m->message_id,
565                                                    user_id => $u->user_id,
566                                                    hash => $hash,
567                                            });
568                                            $sent->dbi_commit;
569    
570                                            print " - $sent_status\n";
571    
572                                    } else {
573                                            warn "ERROR: $sent_status\n";
574                                    }
575    
576                                  if ($sleep) {                                  if ($sleep) {
577                                          warn "sleeping $sleep seconds\n";                                          warn "sleeping $sleep seconds\n";
# Line 474  Receive single message for list's inbox. Line 595  Receive single message for list's inbox.
595          message => $message,          message => $message,
596   );   );
597    
598    This method is used by C<sender.pl> when receiving e-mail messages.
599    
600  =cut  =cut
601    
602  sub inbox_message {  sub inbox_message {
# Line 691  sub NewList { Line 814  sub NewList {
814  }  }
815    
816    
817    =head2 DeleteList
818    
819     $ok = DeleteList(
820            list => 'My list',
821     );
822    
823    =cut
824    
825    sub DeleteList {
826            my $self = shift;
827    
828            if ($_[0] !~ m/^HASH/) {
829                    return $nos->delete_list(
830                            list => $_[0],
831                    );
832            } else {
833                    return $nos->delete_list( %{ shift @_ } );
834            }
835    }
836    
837  =head2 AddMemberToList  =head2 AddMemberToList
838    
839   $member_id = AddMemberToList(   $member_id = AddMemberToList(
840          list => 'My list',          list => 'My list',
841          email => 'e-mail@example.com',          email => 'e-mail@example.com',
842          name => 'Full Name'          name => 'Full Name',
843            ext_id => 42,
844   );   );
845    
846  =cut  =cut
# Line 706  sub AddMemberToList { Line 850  sub AddMemberToList {
850    
851          if ($_[0] !~ m/^HASH/) {          if ($_[0] !~ m/^HASH/) {
852                  return $nos->add_member_to_list(                  return $nos->add_member_to_list(
853                          list => $_[0], email => $_[1], name => $_[2],                          list => $_[0], email => $_[1], name => $_[2], ext_id => $_[4],
854                  );                  );
855          } else {          } else {
856                  return $nos->add_member_to_list( %{ shift @_ } );                  return $nos->add_member_to_list( %{ shift @_ } );
# Line 722  sub AddMemberToList { Line 866  sub AddMemberToList {
866    
867  Returns array of hashes with user informations, see C<list_members>.  Returns array of hashes with user informations, see C<list_members>.
868    
869    Returning arrays from SOAP calls is somewhat fuzzy (at least to me). It
870    seems that SOAP::Lite client thinks that it has array with one element which
871    is array of hashes with data.
872    
873  =cut  =cut
874    
875  sub ListMembers {  sub ListMembers {
# Line 735  sub ListMembers { Line 883  sub ListMembers {
883                  $list_name = $_[0]->{'list'};                  $list_name = $_[0]->{'list'};
884          }          }
885    
886          return $nos->list_members( list => $list_name );          return [ $nos->list_members( list => $list_name ) ];
887    }
888    
889    
890    =head2 DeleteMemberFromList
891    
892     $member_id = DeleteMemberFromList(
893            list => 'My list',
894            email => 'e-mail@example.com',
895     );
896    
897    =cut
898    
899    sub DeleteMemberFromList {
900            my $self = shift;
901    
902            if ($_[0] !~ m/^HASH/) {
903                    return $nos->delete_member_from_list(
904                            list => $_[0], email => $_[1],
905                    );
906            } else {
907                    return $nos->delete_member_from_list( %{ shift @_ } );
908            }
909  }  }
910    
911    
912  =head2 AddMessageToList  =head2 AddMessageToList
913    
914   $message_id = AddMessageToList(   $message_id = AddMessageToList(
Legend:
Removed from v.56  
changed lines
  Added in v.65
  ViewVC Help
Powered by ViewVC 1.1.26