/[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 72 by dpavlin, Mon Aug 22 20:24:04 2005 UTC revision 78 by dpavlin, Thu Aug 25 00:56:06 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.7';  our $VERSION = '0.8';
20    
21  use Class::DBI::Loader;  use Class::DBI::Loader;
22  use Email::Valid;  use Email::Valid;
# Line 27  use Email::Simple; Line 27  use Email::Simple;
27  use Email::Address;  use Email::Address;
28  use Mail::DeliveryStatus::BounceParser;  use Mail::DeliveryStatus::BounceParser;
29  use Class::DBI::AbstractSearch;  use Class::DBI::AbstractSearch;
30    use SQL::Abstract;
31  use Mail::Alias;  use Mail::Alias;
32  use Cwd qw(abs_path);  use Cwd qw(abs_path);
33    
# Line 62  encoded) or anything else. Line 63  encoded) or anything else.
63  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
64  possibly remote Notice Sender SOAP server just once), send it out at  possibly remote Notice Sender SOAP server just once), send it out at
65  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
66  track replies.  keep track replies.
67    
68  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
69  list of recipients while allowing individual responses to be examined.  list of recipients while allowing individual responses to be examined.
70  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
71  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 73  which can be used to track some unique i
73  particular user.  particular user.
74    
75  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
76  all available operation from scripts (see C<perldoc sender.pl>).  all available operation from scripts (see C<sender.pl --man>).
77  This command is also useful for debugging while writing client SOAP  This command is also useful for debugging while writing client SOAP
78  application.  application.
79    
# Line 267  List all members of some list. Line 268  List all members of some list.
268          list => 'My list',          list => 'My list',
269   );   );
270    
271  Returns array of hashes with user informations like this:  Returns array of hashes with user information like this:
272    
273   $member = {   $member = {
274          name => 'Dobrica Pavlinusic',          name => 'Dobrica Pavlinusic',
# Line 475  Send e-mail using SMTP server at 127.0.0 Line 476  Send e-mail using SMTP server at 127.0.0
476    
477  =back  =back
478    
479    Any other driver name will try to use C<Email::Send::that_driver> module.
480    
481  Default sleep wait between two messages is 3 seconds.  Default sleep wait between two messages is 3 seconds.
482    
483    This method will return number of succesfully sent messages.
484    
485  =cut  =cut
486    
487  sub send_queued_messages {  sub send_queued_messages {
# Line 489  sub send_queued_messages { Line 494  sub send_queued_messages {
494          my $sleep = $arg->{'sleep'};          my $sleep = $arg->{'sleep'};
495          $sleep ||= 3 unless defined($sleep);          $sleep ||= 3 unless defined($sleep);
496    
497            # number of messages sent o.k.
498            my $ok = 0;
499    
500          my $email_send_driver = 'Email::Send::IO';          my $email_send_driver = 'Email::Send::IO';
501          my @email_send_options;          my @email_send_options;
502    
503          if (lc($driver) eq 'smtp') {          if (lc($driver) eq 'smtp') {
504                  $email_send_driver = 'Email::Send::SMTP';                  $email_send_driver = 'Email::Send::SMTP';
505                  @email_send_options = ['127.0.0.1'];                  @email_send_options = ['127.0.0.1'];
506            } elsif ($driver && $driver ne '') {
507                    $email_send_driver = 'Email::Send::' . $driver;
508          } else {          } else {
509                  warn "dumping all messages to STDERR\n";                  warn "dumping all messages to STDERR\n";
510          }          }
# Line 564  sub send_queued_messages { Line 574  sub send_queued_messages {
574                                  }                                  }
575    
576                                  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);
577                                  my @bad = @{ $sent_status->prop('bad') };                                  my @bad;
578                                    @bad = @{ $sent_status->prop('bad') } if (eval { $sent_status->can('prop') });
579                                  croak "failed sending to ",join(",",@bad) if (@bad);                                  croak "failed sending to ",join(",",@bad) if (@bad);
580    
581                                  if ($sent_status) {                                  if ($sent_status) {
# Line 578  sub send_queued_messages { Line 589  sub send_queued_messages {
589    
590                                          print " - $sent_status\n";                                          print " - $sent_status\n";
591    
592                                            $ok++;
593                                  } else {                                  } else {
594                                          warn "ERROR: $sent_status\n";                                          warn "ERROR: $sent_status\n";
595                                  }                                  }
# Line 593  sub send_queued_messages { Line 605  sub send_queued_messages {
605                  $m->dbi_commit;                  $m->dbi_commit;
606          }          }
607    
608            return $ok;
609    
610  }  }
611    
612  =head2 inbox_message  =head2 inbox_message
# Line 691  sub inbox_message { Line 705  sub inbox_message {
705  #       print "message_id: ",($message_id || "not found")," -- $is_bounce\n";  #       print "message_id: ",($message_id || "not found")," -- $is_bounce\n";
706  }  }
707    
708    =head2 received_messages
709    
710    Returns all received messages for given list or user.
711    
712     my @received = $nos->received_message(
713            list => 'My list',
714            email => "john.doe@example.com",
715     );
716    
717    Each element in returned array will have following structure:
718    
719     {
720            id => 42,                       # unique ID of received message
721            list => 'My list',              # useful if filtering by email
722            ext_id => 9999,                 # ext_id from message sender
723            email => 'jdoe@example.com',    # e-mail of message sender
724            bounced => 0,                   # true if message is bounce
725            date => '2005-08-24 18:57:24',  # date of receival in ISO format
726     }
727    
728    
729    =cut
730    
731    sub received_messages {
732            my $self = shift;
733    
734            my $arg = {@_} if (@_);
735    
736    #       croak "need list name or email" unless ($arg->{'list'} || $arg->{'email'});
737    
738            my $sql = qq{
739                            select
740                                    received.id as id,
741                                    lists.name as list,
742                                    users.ext_id as ext_id,
743                                    users.email as email,
744                                    bounced,received.date as date
745                            from received
746                            join lists on lists.id = list_id
747                            join users on users.id = user_id
748            };
749    
750            my $where;
751    
752            $where->{'lists.name'} = lc($arg->{'list'}) if ($arg->{'list'});
753            $where->{'users.email'} = lc($arg->{'email'}) if ($arg->{'email'});
754    
755            # hum, yammy one-liner
756            my($stmt, @bind)  = SQL::Abstract->new->where($where);
757    
758            my $dbh = $self->{'loader'}->find_class('received')->db_Main;
759    
760            my $sth = $dbh->prepare($sql . $stmt);
761            $sth->execute(@bind);
762            return $sth->fetchall_hash;
763    }
764    
765    
766  =head1 INTERNAL METHODS  =head1 INTERNAL METHODS
767    
# Line 923  Create new SOAP object Line 994  Create new SOAP object
994          aliases => '/etc/aliases',          aliases => '/etc/aliases',
995   );   );
996    
997    If you are writing SOAP server (like C<soap.cgi> example), you will need to
998    call this method once to make new instance of Nos::SOAP and specify C<dsn>
999    and options for it.
1000    
1001  =cut  =cut
1002    
1003  sub new {  sub new {
# Line 1020  sub AddMemberToList { Line 1095  sub AddMemberToList {
1095    
1096  Returns array of hashes with user informations, see C<list_members>.  Returns array of hashes with user informations, see C<list_members>.
1097    
 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.  
   
1098  =cut  =cut
1099    
1100  sub ListMembers {  sub ListMembers {
# Line 1084  sub AddMessageToList { Line 1155  sub AddMessageToList {
1155          }          }
1156  }  }
1157    
1158    =head2 MessagesReceived
1159    
1160    Return statistics about received messages.
1161    
1162     my @result = MessagesReceived(
1163            list => 'My list',
1164            email => 'jdoe@example.com',
1165     );
1166    
1167    You must specify C<list> or C<email> or any combination of those.
1168    
1169    For format of returned array element see C<received_messages>.
1170    
1171    =cut
1172    
1173    sub MessagesReceived {
1174            my $self = shift;
1175    
1176            if ($_[0] !~ m/^HASH/) {
1177                    die "need both list and email" unless (scalar @_ < 2);
1178                    return $nos->received_messages(
1179                            list => $_[0], email => $_[1],
1180                    );
1181            } else {
1182                    my $arg = {@_};
1183                    die "need both list and email" unless ($arg->{'list'} && $arg->{'email'});
1184                    return $nos->received_messages( $arg );
1185            }
1186    }
1187    
1188  ###  ###
1189    
1190    =head1 UNIMPLEMENTED SOAP FUNCTIONS
1191    
1192    This is a stub for documentation of unimplemented functions.
1193    
1194    =head2 MessagesReceivedByDate
1195    
1196    =head2 MessagesReceivedByDateWithContent
1197    
1198    =head2 ReceivedMessageContent
1199    
1200    Return content of received message.
1201    
1202     my $mail_body = ReceivedMessageContent( id => 42 );
1203    
1204    
1205    
1206    
1207    =head1 NOTE ON ARRAYS IN SOAP
1208    
1209    Returning arrays from SOAP calls is somewhat fuzzy (at least to me). It
1210    seems that SOAP::Lite client thinks that it has array with one element which
1211    is array of hashes with data.
1212    
1213  =head1 EXPORT  =head1 EXPORT
1214    
1215  Nothing.  Nothing.
Legend:
Removed from v.72  
changed lines
  Added in v.78
  ViewVC Help
Powered by ViewVC 1.1.26