/[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 71 by dpavlin, Mon Aug 22 19:25:24 2005 UTC revision 75 by dpavlin, Wed Aug 24 21:27:40 2005 UTC
# Line 16  our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all' Line 16  our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'
16  our @EXPORT = qw(  our @EXPORT = qw(
17  );  );
18    
19  our $VERSION = '0.6';  our $VERSION = '0.8';
20    
21  use Class::DBI::Loader;  use Class::DBI::Loader;
22  use Email::Valid;  use Email::Valid;
# Line 62  encoded) or anything else. Line 62  encoded) or anything else.
62  It will just queue your e-mail message to particular list (sending it to  It will just queue your e-mail message to particular list (sending it to
63  possibly remote Notice Sender SOAP server just once), send it out at  possibly remote Notice Sender SOAP server just once), send it out at
64  reasonable rate (so that it doesn't flood your e-mail infrastructure) and  reasonable rate (so that it doesn't flood your e-mail infrastructure) and
65  track replies.  keep track replies.
66    
67  It is best used to send smaller number of messages to more-or-less fixed  It is best used to send small number of messages to more-or-less fixed
68  list of recipients while allowing individual responses to be examined.  list of recipients while allowing individual responses to be examined.
69  Tipical use include replacing php e-mail sending code with SOAP call to  Tipical use include replacing php e-mail sending code with SOAP call to
70  Notice Sender. It does support additional C<ext_id> field for each member  Notice Sender. It does support additional C<ext_id> field for each member
# Line 72  which can be used to track some unique i Line 72  which can be used to track some unique i
72  particular user.  particular user.
73    
74  It comes with command-line utility C<sender.pl> which can be used to perform  It comes with command-line utility C<sender.pl> which can be used to perform
75  all available operation from scripts (see C<perldoc sender.pl>).  all available operation from scripts (see C<sender.pl --man>).
76  This command is also useful for debugging while writing client SOAP  This command is also useful for debugging while writing client SOAP
77  application.  application.
78    
# Line 116  sub new { Line 116  sub new {
116    
117          $self->{'hash_len'} ||= 8;          $self->{'hash_len'} ||= 8;
118    
119            $self->{'loader'}->find_class('received')->set_sql(
120                    'received' => qq{
121                            select
122                                    received.id as id,
123                                    lists.name as list,
124                                    users.ext_id as ext_id,
125                                    users.email as email,
126                                    bounced,received.date as date
127                            from received
128                            join lists on lists.id = list_id
129                            join users on users.id = user_id
130                    },
131            );
132    
133          $self ? return $self : return undef;          $self ? return $self : return undef;
134  }  }
135    
136    
137  =head2 new_list  =head2 create_list
138    
139  Create new list. Required arguments are name of C<list>, C<email> address  Create new list. Required arguments are name of C<list>, C<email> address
140  and path to C<aliases> file.  and path to C<aliases> file.
141    
142   $nos->new_list(   $nos->create_list(
143          list => 'My list',          list => 'My list',
144          from => 'Outgoing from comment',          from => 'Outgoing from comment',
145          email => 'my-list@example.com',          email => 'my-list@example.com',
# Line 139  Calls internally C<_add_list>, see detai Line 153  Calls internally C<_add_list>, see detai
153    
154  =cut  =cut
155    
156  sub new_list {  sub create_list {
157          my $self = shift;          my $self = shift;
158    
159          my $arg = {@_};          my $arg = {@_};
# Line 158  sub new_list { Line 172  sub new_list {
172  }  }
173    
174    
175  =head2 delete_list  =head2 drop_list
176    
177  Delete list from database.  Delete list from database.
178    
179   my $ok = delete_list(   my $ok = drop_list(
180          list => 'My list'          list => 'My list'
181          aliases => '/etc/mail/mylist',          aliases => '/etc/mail/mylist',
182   );   );
# Line 171  Returns false if list doesn't exist. Line 185  Returns false if list doesn't exist.
185    
186  =cut  =cut
187    
188  sub delete_list {  sub drop_list {
189          my $self = shift;          my $self = shift;
190    
191          my $args = {@_};          my $args = {@_};
# Line 267  List all members of some list. Line 281  List all members of some list.
281          list => 'My list',          list => 'My list',
282   );   );
283    
284  Returns array of hashes with user informations like this:  Returns array of hashes with user information like this:
285    
286   $member = {   $member = {
287          name => 'Dobrica Pavlinusic',          name => 'Dobrica Pavlinusic',
# Line 475  Send e-mail using SMTP server at 127.0.0 Line 489  Send e-mail using SMTP server at 127.0.0
489    
490  =back  =back
491    
492    Any other driver name will try to use C<Email::Send::that_driver> module.
493    
494  Default sleep wait between two messages is 3 seconds.  Default sleep wait between two messages is 3 seconds.
495    
496    This method will return number of succesfully sent messages.
497    
498  =cut  =cut
499    
500  sub send_queued_messages {  sub send_queued_messages {
# Line 489  sub send_queued_messages { Line 507  sub send_queued_messages {
507          my $sleep = $arg->{'sleep'};          my $sleep = $arg->{'sleep'};
508          $sleep ||= 3 unless defined($sleep);          $sleep ||= 3 unless defined($sleep);
509    
510            # number of messages sent o.k.
511            my $ok = 0;
512    
513          my $email_send_driver = 'Email::Send::IO';          my $email_send_driver = 'Email::Send::IO';
514          my @email_send_options;          my @email_send_options;
515    
516          if (lc($driver) eq 'smtp') {          if (lc($driver) eq 'smtp') {
517                  $email_send_driver = 'Email::Send::SMTP';                  $email_send_driver = 'Email::Send::SMTP';
518                  @email_send_options = ['127.0.0.1'];                  @email_send_options = ['127.0.0.1'];
519            } elsif ($driver && $driver ne '') {
520                    $email_send_driver = 'Email::Send::' . $driver;
521          } else {          } else {
522                  warn "dumping all messages to STDERR\n";                  warn "dumping all messages to STDERR\n";
523          }          }
# Line 564  sub send_queued_messages { Line 587  sub send_queued_messages {
587                                  }                                  }
588    
589                                  croak "can't send e-mail: $sent_status\n\nOriginal e-mail follows:\n".$m_obj->as_string unless ($sent_status);                                  croak "can't send e-mail: $sent_status\n\nOriginal e-mail follows:\n".$m_obj->as_string unless ($sent_status);
590                                  my @bad = @{ $sent_status->prop('bad') };                                  my @bad;
591                                    @bad = @{ $sent_status->prop('bad') } if (eval { $sent_status->can('prop') });
592                                  croak "failed sending to ",join(",",@bad) if (@bad);                                  croak "failed sending to ",join(",",@bad) if (@bad);
593    
594                                  if ($sent_status) {                                  if ($sent_status) {
# Line 578  sub send_queued_messages { Line 602  sub send_queued_messages {
602    
603                                          print " - $sent_status\n";                                          print " - $sent_status\n";
604    
605                                            $ok++;
606                                  } else {                                  } else {
607                                          warn "ERROR: $sent_status\n";                                          warn "ERROR: $sent_status\n";
608                                  }                                  }
# Line 593  sub send_queued_messages { Line 618  sub send_queued_messages {
618                  $m->dbi_commit;                  $m->dbi_commit;
619          }          }
620    
621            return $ok;
622    
623  }  }
624    
625  =head2 inbox_message  =head2 inbox_message
# Line 691  sub inbox_message { Line 718  sub inbox_message {
718  #       print "message_id: ",($message_id || "not found")," -- $is_bounce\n";  #       print "message_id: ",($message_id || "not found")," -- $is_bounce\n";
719  }  }
720    
721    =head2 received_messages
722    
723    Returns all received messages for given list or user.
724    
725     my @received = $nos->received_message(
726            list => 'My list',
727            email => "john.doe@example.com",
728     );
729    
730    This method is used by C<sender.pl> when receiving e-mail messages.
731    
732    =cut
733    
734    sub received_messages {
735            my $self = shift;
736    
737            my $arg = {@_};
738    
739            croak "need list name or email" unless ($arg->{'list'} || $arg->{'email'});
740    
741            $arg->{'list'} = lc($arg->{'list'});
742            $arg->{'email'} = lc($arg->{'email'});
743    
744            my $rcvd = $self->{'loader'}->find_class('received')->search_received();
745    
746            return $rcvd;
747    }
748    
749    
750  =head1 INTERNAL METHODS  =head1 INTERNAL METHODS
751    
# Line 923  Create new SOAP object Line 978  Create new SOAP object
978          aliases => '/etc/aliases',          aliases => '/etc/aliases',
979   );   );
980    
981    If you are writing SOAP server (like C<soap.cgi> example), you will need to
982    call this method once to make new instance of Nos::SOAP and specify C<dsn>
983    and options for it.
984    
985  =cut  =cut
986    
987  sub new {  sub new {
# Line 939  sub new { Line 998  sub new {
998  }  }
999    
1000    
1001  =head2 NewList  =head2 CreateList
1002    
1003   $message_id = NewList(   $message_id = CreateList(
1004          list => 'My list',          list => 'My list',
1005          from => 'Name of my list',          from => 'Name of my list',
1006          email => 'my-list@example.com'          email => 'my-list@example.com'
# Line 949  sub new { Line 1008  sub new {
1008    
1009  =cut  =cut
1010    
1011  sub NewList {  sub CreateList {
1012          my $self = shift;          my $self = shift;
1013    
1014          my $aliases = $nos->{'aliases'} || croak "need 'aliases' argument to new constructor";          my $aliases = $nos->{'aliases'} || croak "need 'aliases' argument to new constructor";
1015    
1016          if ($_[0] !~ m/^HASH/) {          if ($_[0] !~ m/^HASH/) {
1017                  return $nos->new_list(                  return $nos->create_list(
1018                          list => $_[0], from => $_[1], email => $_[2],                          list => $_[0], from => $_[1], email => $_[2],
1019                          aliases => $aliases,                          aliases => $aliases,
1020                  );                  );
1021          } else {          } else {
1022                  return $nos->new_list( %{ shift @_ }, aliases => $aliases );                  return $nos->create_list( %{ shift @_ }, aliases => $aliases );
1023          }          }
1024  }  }
1025    
1026    
1027  =head2 DeleteList  =head2 DropList
1028    
1029   $ok = DeleteList(   $ok = DropList(
1030          list => 'My list',          list => 'My list',
1031   );   );
1032    
1033  =cut  =cut
1034    
1035  sub DeleteList {  sub DropList {
1036          my $self = shift;          my $self = shift;
1037    
1038          my $aliases = $nos->{'aliases'} || croak "need 'aliases' argument to new constructor";          my $aliases = $nos->{'aliases'} || croak "need 'aliases' argument to new constructor";
1039    
1040          if ($_[0] !~ m/^HASH/) {          if ($_[0] !~ m/^HASH/) {
1041                  return $nos->delete_list(                  return $nos->drop_list(
1042                          list => $_[0],                          list => $_[0],
1043                          aliases => $aliases,                          aliases => $aliases,
1044                  );                  );
1045          } else {          } else {
1046                  return $nos->delete_list( %{ shift @_ }, aliases => $aliases );                  return $nos->drop_list( %{ shift @_ }, aliases => $aliases );
1047          }          }
1048  }  }
1049    
# Line 1020  sub AddMemberToList { Line 1079  sub AddMemberToList {
1079    
1080  Returns array of hashes with user informations, see C<list_members>.  Returns array of hashes with user informations, see C<list_members>.
1081    
 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.  
   
1082  =cut  =cut
1083    
1084  sub ListMembers {  sub ListMembers {
# Line 1084  sub AddMessageToList { Line 1139  sub AddMessageToList {
1139          }          }
1140  }  }
1141    
1142    =head1 UNIMPLEMENTED FUNCTIONS
1143    
1144    This is a stub for documentation of unimplemented functions.
1145    
1146    =head2 MessagesReceived
1147    
1148     my @result = MessagesReceived(
1149            list => 'My list',
1150            email => 'jdoe@example.com',
1151     );
1152    
1153    You can specify just C<list> or C<email> or any combination of those.
1154    
1155    It will return array of hashes with following structure:
1156    
1157     {
1158            id => 42,                       # unique ID of received message
1159            list => 'My list',              # useful only of filtering by email
1160            ext_id => 9999,                 # ext_id from message user
1161            email => 'jdoe@example.com',    # e-mail of user
1162            bounced => 0,                   # true value if message is bounce
1163            date => '2005-08-24 18:57:24',  # date of recival in ISO format
1164     }
1165    
1166    =head2 MessagesReceivedByDate
1167    
1168    =head2 MessagesReceivedByDateWithContent
1169    
1170    =head2 ReceivedMessasgeContent
1171    
1172    Return content of received message.
1173    
1174     my $mail_body = ReceivedMessageContent( id => 42 );
1175    
1176    =cut
1177    
1178    
1179    
1180    
1181  ###  ###
1182    
1183    =head1 NOTE ON ARRAYS IN SOAP
1184    
1185    Returning arrays from SOAP calls is somewhat fuzzy (at least to me). It
1186    seems that SOAP::Lite client thinks that it has array with one element which
1187    is array of hashes with data.
1188    
1189  =head1 EXPORT  =head1 EXPORT
1190    
1191  Nothing.  Nothing.
Legend:
Removed from v.71  
changed lines
  Added in v.75
  ViewVC Help
Powered by ViewVC 1.1.26