/[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 74 by dpavlin, Wed Aug 24 17:19:16 2005 UTC revision 79 by dpavlin, Thu Aug 25 11:58:15 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 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 1080  sub AddMessageToList { Line 1155  sub AddMessageToList {
1155          }          }
1156  }  }
1157    
 =head1 UNIMPLEMENTED FUNCTIONS  
   
 This is a stub for documentation of unimplemented functions.  
   
1158  =head2 MessagesReceived  =head2 MessagesReceived
1159    
1160    Return statistics about received messages.
1161    
1162   my @result = MessagesReceived(   my @result = MessagesReceived(
1163          list => 'My list',          list => 'My list',
1164          email => 'jdoe@example.com',          email => 'jdoe@example.com',
1165   );   );
1166    
1167  You can specify just C<list> or C<email> or any combination of those.  You must specify C<list> or C<email> or any combination of those.
1168    
1169  It will return array of hashes with following structure:  For format of returned array element see C<received_messages>.
1170    
1171   {  =cut
1172          id => 42,                       # unique ID of received message  
1173          list => 'My list',              # useful only of filtering by email  sub MessagesReceived {
1174          ext_id => 9999,                 # ext_id from message user          my $self = shift;
1175          email => 'jdoe@example.com',    # e-mail of user  
1176          bounced => 0,                   # true value if message is bounce          if ($_[0] !~ m/^HASH/) {
1177          date => '2005-08-24 18:57:24',  # date of recival in ISO format                  die "need at least list or email" unless (scalar @_ < 2);
1178   }                  return $nos->received_messages(
1179                            list => $_[0], email => $_[1],
1180                    );
1181            } else {
1182                    my $arg = shift;
1183                    die "need list or email argument" 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  =head2 MessagesReceivedByDate
1195    
1196  =head2 MessagesReceivedByDateWithContent  =head2 MessagesReceivedByDateWithContent
1197    
1198  =head2 ReceivedMessasgeContent  =head2 ReceivedMessageContent
1199    
1200  Return content of received message.  Return content of received message.
1201    
1202   my $mail_body = ReceivedMessageContent( id => 42 );   my $mail_body = ReceivedMessageContent( id => 42 );
1203    
 =cut  
   
   
1204    
1205    
 ###  
1206    
1207  =head1 NOTE ON ARRAYS IN SOAP  =head1 NOTE ON ARRAYS IN SOAP
1208    
Legend:
Removed from v.74  
changed lines
  Added in v.79
  ViewVC Help
Powered by ViewVC 1.1.26