/[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 90 by dpavlin, Mon Dec 18 19:35:04 2006 UTC revision 93 by dpavlin, Tue Dec 19 15:04:05 2006 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.8';  our $VERSION = '0.9';
20    
21  use Class::DBI::Loader;  use Class::DBI::Loader;
22  use Email::Valid;  use Email::Valid;
# Line 463  Send queued messages or just ones for se Line 463  Send queued messages or just ones for se
463          list => 'My list',          list => 'My list',
464          driver => 'smtp',          driver => 'smtp',
465          sleep => 3,          sleep => 3,
466            verbose => 1,
467   );   );
468    
469  Second option is driver which will be used for e-mail delivery. If not  Second option is driver which will be used for e-mail delivery. If not
# Line 476  Other valid drivers are: Line 477  Other valid drivers are:
477    
478  Send e-mail using SMTP server at 127.0.0.1  Send e-mail using SMTP server at 127.0.0.1
479    
480    =item verbose
481    
482    Display diagnostic output to C<STDOUT> and C<STDERR>.
483    
484  =back  =back
485    
486  Any other driver name will try to use C<Email::Send::that_driver> module.  Any other driver name will try to use C<Email::Send::that_driver> module.
# Line 494  sub send_queued_messages { Line 499  sub send_queued_messages {
499          my $list_name = lc($arg->{'list'}) || '';          my $list_name = lc($arg->{'list'}) || '';
500          my $driver = $arg->{'driver'} || '';          my $driver = $arg->{'driver'} || '';
501          my $sleep = $arg->{'sleep'};          my $sleep = $arg->{'sleep'};
502            my $verbose = $arg->{verbose};
503          $sleep ||= 3 unless defined($sleep);          $sleep ||= 3 unless defined($sleep);
504    
505          # number of messages sent o.k.          # number of messages sent o.k.
# Line 508  sub send_queued_messages { Line 514  sub send_queued_messages {
514          } elsif ($driver && $driver ne '') {          } elsif ($driver && $driver ne '') {
515                  $email_send_driver = 'Email::Send::' . $driver;                  $email_send_driver = 'Email::Send::' . $driver;
516          } else {          } else {
517                  warn "dumping all messages to STDERR\n";                  warn "dumping all messages to STDERR\n" if ($verbose);
518          }          }
519    
520          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
# Line 529  sub send_queued_messages { Line 535  sub send_queued_messages {
535          while (my $m = $my_q->next) {          while (my $m = $my_q->next) {
536                  next if ($m->all_sent);                  next if ($m->all_sent);
537    
538                  print "sending message ",$m->message_id," enqueued on ",$m->date," to list ",$m->list_id->name,"\n";                  print "sending message ",$m->message_id," enqueued on ",$m->date," to list ",$m->list_id->name,"\n" if ($verbose);
539                  my $msg = $m->message_id->message;                  my $msg = $m->message_id->message;
540    
541                  foreach my $u ($user_list->search(list_id => $m->list_id)) {                  foreach my $u ($user_list->search(list_id => $m->list_id)) {
# Line 539  sub send_queued_messages { Line 545  sub send_queued_messages {
545                          my ($from,$domain) = split(/@/, $u->list_id->email, 2);                          my ($from,$domain) = split(/@/, $u->list_id->email, 2);
546    
547                          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 )) {
548                                  print "SKIP $to_email message allready sent\n";                                  print "SKIP $to_email message allready sent\n" if ($verbose);
549                          } else {                          } else {
550                                  print "=> $to_email ";                                  print "=> $to_email " if ($verbose);
551    
552                                  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;
553                                  my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} );                                  my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} );
# Line 589  sub send_queued_messages { Line 595  sub send_queued_messages {
595                                          });                                          });
596                                          $sent->dbi_commit;                                          $sent->dbi_commit;
597    
598                                          print " - $sent_status\n";                                          print " - $sent_status\n" if ($verbose);
599    
600                                          $ok++;                                          $ok++;
601                                  } else {                                  } else {
602                                          warn "ERROR: $sent_status\n";                                          warn "ERROR: $sent_status\n" if ($verbose);
603                                  }                                  }
604    
605                                  if ($sleep) {                                  if ($sleep) {
606                                          warn "sleeping $sleep seconds\n";                                          warn "sleeping $sleep seconds\n" if ($verbose);
607                                          sleep($sleep);                                          sleep($sleep);
608                                  }                                  }
609                          }                          }
# Line 1233  sub MessagesReceived { Line 1239  sub MessagesReceived {
1239          }          }
1240  }  }
1241    
1242  ###  =head2 SendTest
1243    
1244  =head1 NOTE ON ARRAYS IN SOAP  Internal function which does e-mail sending using C<Email::Send::Test> driver.
1245    
1246  Returning arrays from SOAP calls is somewhat fuzzy (at least to me). It    my $sent = SendTest( list => 'My list' );
 seems that SOAP::Lite client thinks that it has array with one element which  
 is array of hashes with data.  
1247    
1248  =head1 PRIVATE METHODS  Returns number of messages sent
1249    
1250  Documented here because tests use them  =cut
1251    
1252  =head2 _nos_object  sub SendTest {
1253            my $self = shift;
1254            my $args = shift;
1255            die "list name required" unless ($args->{list});
1256    
1257    my $nos = $nos->_nos_object;          require Email::Send::Test;
1258    
1259  =cut          my $nr_sent = $nos->send_queued_messages(
1260                    list => $args->{list},
1261                    driver => 'Test',
1262                    sleep => 0,
1263                    verbose => 0,
1264            );
1265    
1266  sub _nos_object {          my @emails = Email::Send::Test->emails;
1267          return $nos;  
1268            open(my $tmp, ">/tmp/soap-debug");
1269            use Data::Dump qw/dump/;
1270            print $tmp "sent $nr_sent emails\n", dump(@emails);
1271            close($tmp);
1272    
1273            return $nr_sent;
1274  }  }
1275    
1276    ###
1277    
1278    =head1 NOTE ON ARRAYS IN SOAP
1279    
1280    Returning arrays from SOAP calls is somewhat fuzzy (at least to me). It
1281    seems that SOAP::Lite client thinks that it has array with one element which
1282    is array of hashes with data.
1283    
1284  =head1 EXPORT  =head1 EXPORT
1285    
1286  Nothing.  Nothing.
Legend:
Removed from v.90  
changed lines
  Added in v.93
  ViewVC Help
Powered by ViewVC 1.1.26