/[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 47 by dpavlin, Tue May 24 14:02:05 2005 UTC revision 52 by dpavlin, Wed May 25 15:03:10 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;
 use Data::Dumper;  
   
 my $email_send_driver = 'Email::Send::IO';  
 my @email_send_options;  
   
 #$email_send_driver = 'Sendmail';  
29    
30    
31  =head1 NAME  =head1 NAME
# Line 114  sub new_list { Line 108  sub new_list {
108          my $arg = {@_};          my $arg = {@_};
109    
110          confess "need list name" unless ($arg->{'list'});          confess "need list name" unless ($arg->{'list'});
111          confess "need list email" unless ($arg->{'list'});          confess "need list email" unless ($arg->{'email'});
112    
113            $arg->{'list'} = lc($arg->{'list'});
114            $arg->{'email'} = lc($arg->{'email'});
115    
116          my $l = $self->_get_list($arg->{'list'}) ||          my $l = $self->_get_list($arg->{'list'}) ||
117                  $self->_add_list( @_ ) ||                  $self->_add_list( @_ ) ||
# Line 145  sub add_member_to_list { Line 142  sub add_member_to_list {
142    
143          my $arg = {@_};          my $arg = {@_};
144    
145          my $email = $arg->{'email'} || croak "can't add user without e-mail";          my $email = lc($arg->{'email'}) || croak "can't add user without e-mail";
146          my $name = $arg->{'name'} || '';          my $name = $arg->{'name'} || '';
147          my $list_name = $arg->{'list'} || croak "need list name";          my $list_name = lc($arg->{'list'}) || croak "need list name";
148    
149          my $list = $self->_get_list($list_name) || croak "list $list_name doesn't exist";          my $list = $self->_get_list($list_name) || croak "list $list_name doesn't exist";
150    
# Line 206  sub list_members { Line 203  sub list_members {
203    
204          my $args = {@_};          my $args = {@_};
205    
206          my $list_name = $args->{'list'} || confess "need list name";          my $list_name = lc($args->{'list'}) || confess "need list name";
207    
208          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
209          my $user_list = $self->{'loader'}->find_class('user_list');          my $user_list = $self->{'loader'}->find_class('user_list');
# Line 252  sub delete_member { Line 249  sub delete_member {
249    
250          croak "need name or email of user to delete" unless ($args->{'name'} || $args->{'email'});          croak "need name or email of user to delete" unless ($args->{'name'} || $args->{'email'});
251    
252            $args->{'email'} = lc($args->{'email'}) if ($args->{'email'});
253    
254          my $key = 'name';          my $key = 'name';
255          $key = 'email' if ($args->{'email'});          $key = 'email' if ($args->{'email'});
256    
# Line 259  sub delete_member { Line 258  sub delete_member {
258    
259          my $this_user = $users->search( $key => $args->{$key} )->first || return;          my $this_user = $users->search( $key => $args->{$key} )->first || return;
260    
 print Dumper($this_user);  
   
261          $this_user->delete || croak "can't delete user\n";          $this_user->delete || croak "can't delete user\n";
262    
263          return $users->dbi_commit || croak "can't commit";          return $users->dbi_commit || croak "can't commit";
# Line 291  sub add_message_to_list { Line 288  sub add_message_to_list {
288    
289          my $args = {@_};          my $args = {@_};
290    
291          my $list_name = $args->{'list'} || confess "need list name";          my $list_name = lc($args->{'list'}) || confess "need list name";
292          my $message_text = $args->{'message'} || croak "need message";          my $message_text = $args->{'message'} || croak "need message";
293    
294          my $m = Email::Simple->new($message_text) || croak "can't parse message";          my $m = Email::Simple->new($message_text) || croak "can't parse message";
# Line 332  sub add_message_to_list { Line 329  sub add_message_to_list {
329    
330  Send queued messages or just ones for selected list  Send queued messages or just ones for selected list
331    
332   $nos->send_queued_messages("My list",'smtp');   $nos->send_queued_messages(
333            list => 'My list',
334            driver => 'smtp',
335            sleep => 3,
336     );
337    
338  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
339  specified, C<IO> driver will be used which will dump e-mail to C<STDERR>.  specified, C<IO> driver will be used which will dump e-mail to C<STDERR>.
# Line 347  Send e-mail using SMTP server at 127.0.0 Line 348  Send e-mail using SMTP server at 127.0.0
348    
349  =back  =back
350    
351    Default sleep wait between two messages is 3 seconds.
352    
353  =cut  =cut
354    
355  sub send_queued_messages {  sub send_queued_messages {
356          my $self = shift;          my $self = shift;
357    
358          my $list_name = shift;          my $arg = {@_};
359    
360            my $list_name = lc($arg->{'list'}) || '';
361            my $driver = $arg->{'driver'} || '';
362            my $sleep = $arg->{'sleep'};
363            $sleep ||= 3 unless defined($sleep);
364    
365          my $driver = shift || '';          my $email_send_driver = 'Email::Send::IO';
366            my @email_send_options;
367    
368          if (lc($driver) eq 'smtp') {          if (lc($driver) eq 'smtp') {
369                  $email_send_driver = 'Email::Send::SMTP';                  $email_send_driver = 'Email::Send::SMTP';
370                  @email_send_options = ['127.0.0.1'];                  @email_send_options = ['127.0.0.1'];
371            } else {
372                    warn "dumping all messages to STDERR\n";
373          }          }
         warn "using $driver [$email_send_driver]\n";  
374    
375          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
376          my $queue = $self->{'loader'}->find_class('queue');          my $queue = $self->{'loader'}->find_class('queue');
# Line 401  sub send_queued_messages { Line 411  sub send_queued_messages {
411    
412                                  my $from_addr;                                  my $from_addr;
413                                  my $from_email_only = $from . "+" . $hash . ( $domain ? '@' . $domain : '');                                  my $from_email_only = $from . "+" . $hash . ( $domain ? '@' . $domain : '');
414    
415                                  $from_addr .= '"' . $u->list_id->from_addr . '" ' if ($u->list_id->from_addr);                                  $from_addr .= '"' . $u->list_id->from_addr . '" ' if ($u->list_id->from_addr);
416                                  $from_addr .= '<' . $from_email_only . '>';                                  $from_addr .= '<' . $from_email_only . '>';
417                                  my $to = '"' . $u->user_id->name . '" <' . $to_email . '>';                                  my $to = '"' . $u->user_id->name . '" <' . $to_email . '>';
# Line 408  sub send_queued_messages { Line 419  sub send_queued_messages {
419                                  my $m_obj = Email::Simple->new($msg) || croak "can't parse message";                                  my $m_obj = Email::Simple->new($msg) || croak "can't parse message";
420    
421                                  $m_obj->header_set('Return-Path', $from_email_only) || croak "can't set Return-Path: header";                                  $m_obj->header_set('Return-Path', $from_email_only) || croak "can't set Return-Path: header";
422                                  $m_obj->header_set('Sender', $from_email_only) || croak "can't set Return-Path: header";                                  $m_obj->header_set('Sender', $from_email_only) || croak "can't set Sender: header";
423                                  $m_obj->header_set('Errors-To', $from_email_only) || croak "can't set Return-Path: header";                                  $m_obj->header_set('Errors-To', $from_email_only) || croak "can't set Errors-To: header";
424                                  $m_obj->header_set('From', $from_addr) || croak "can't set From: header";                                  $m_obj->header_set('From', $from_addr) || croak "can't set From: header";
425                                  $m_obj->header_set('To', $to) || croak "can't set To: header";                                  $m_obj->header_set('To', $to) || croak "can't set To: header";
426    
# Line 429  sub send_queued_messages { Line 440  sub send_queued_messages {
440                                          hash => $hash,                                          hash => $hash,
441                                  });                                  });
442                                  $sent->dbi_commit;                                  $sent->dbi_commit;
443    
444                                    if ($sleep) {
445                                            warn "sleeping $sleep seconds\n";
446                                            sleep($sleep);
447                                    }
448                          }                          }
449                  }                  }
450                  $m->all_sent(1);                  $m->all_sent(1);
# Line 457  sub inbox_message { Line 473  sub inbox_message {
473          return unless ($arg->{'message'});          return unless ($arg->{'message'});
474          croak "need list name" unless ($arg->{'list'});          croak "need list name" unless ($arg->{'list'});
475    
476            $arg->{'list'} = lc($arg->{'list'});
477    
478          my $this_list = $self->_get_list($arg->{'list'}) || croak "can't find list ".$arg->{'list'}."\n";          my $this_list = $self->_get_list($arg->{'list'}) || croak "can't find list ".$arg->{'list'}."\n";
479    
480          my $m = Email::Simple->new($arg->{'message'}) || croak "can't parse message";          my $m = Email::Simple->new($arg->{'message'}) || croak "can't parse message";
481    
482          my $to = $m->header('To') || die "can't find To: address in incomming message\n";          my $to = $m->header('To') || die "can't find To: address in incomming message\n";
483    
484            my $return_path = $m->header('Return-Path') || '';
485    
486          my @addrs = Email::Address->parse( $to );          my @addrs = Email::Address->parse( $to );
487    
488          die "can't parse To: $to address\n" unless (@addrs);          die "can't parse To: $to address\n" unless (@addrs);
# Line 472  sub inbox_message { Line 492  sub inbox_message {
492          my $hash;          my $hash;
493    
494          foreach my $a (@addrs) {          foreach my $a (@addrs) {
495                  if ($a->address =~ m/\+([a-f0-9]{$hl})@/) {                  if ($a->address =~ m/\+([a-f0-9]{$hl})@/i) {
496                          $hash = $1;                          $hash = $1;
497                          last;                          last;
498                  }                  }
499          }          }
500    
501          croak "can't find hash in e-mail $to\n" unless ($hash);          #warn "can't find hash in e-mail $to\n" unless ($hash);
502    
503          my $sent = $self->{'loader'}->find_class('sent');          my $sent = $self->{'loader'}->find_class('sent');
504    
505          # will use null if no matching message_id is found          # will use null if no matching message_id is found
506          my $sent_msg = $sent->search( hash => $hash )->first;          my $sent_msg;
507            $sent_msg = $sent->search( hash => $hash )->first if ($hash);
508    
509          my ($message_id, $user_id) = (undef, undef);    # init with NULL          my ($message_id, $user_id) = (undef, undef);    # init with NULL
510    
# Line 491  sub inbox_message { Line 512  sub inbox_message {
512                  $message_id = $sent_msg->message_id || carp "no message_id";                  $message_id = $sent_msg->message_id || carp "no message_id";
513                  $user_id = $sent_msg->user_id || carp "no user_id";                  $user_id = $sent_msg->user_id || carp "no user_id";
514          } else {          } else {
515                  warn "can't find sender with hash $hash\n";                  #warn "can't find sender with hash $hash\n";
516                    my $users = $self->{'loader'}->find_class('users');
517                    my $from = $m->header('From');
518                    $from = $1 if ($from =~ m/<(.*)>/);
519                    my $this_user = $users->search( email => lc($from) )->first;
520                    $user_id = $this_user->id if ($this_user);
521          }          }
522    
523    
524          my $is_bounce = 0;          my $is_bounce = 0;
525    
526          {          if ($return_path eq '<>' || $return_path eq '') {
527                  no warnings;                  no warnings;
528                  my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(                  my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(
529                          $arg->{'message'}, { report_non_bounces=>1 },                          $arg->{'message'}, { report_non_bounces=>1 },
530                  ) };                  ) };
531                  carp "can't check if this message is bounce!" if ($@);                  #warn "can't check if this message is bounce!" if ($@);
532                    
533                  $is_bounce++ if ($bounce && $bounce->is_bounce);                  $is_bounce++ if ($bounce && $bounce->is_bounce);
534          }          }
# Line 519  sub inbox_message { Line 545  sub inbox_message {
545    
546          $this_received->dbi_commit;          $this_received->dbi_commit;
547    
548          print "message_id: ",($message_id || "not found")," -- $is_bounce\n";  #       print "message_id: ",($message_id || "not found")," -- $is_bounce\n";
   
   
         warn "inbox is not yet implemented";  
549  }  }
550    
551    
# Line 554  sub _add_list { Line 577  sub _add_list {
577    
578          my $arg = {@_};          my $arg = {@_};
579    
580          my $name = $arg->{'list'} || confess "can't add list without name";          my $name = lc($arg->{'list'}) || confess "can't add list without name";
581          my $email = $arg->{'email'} || confess "can't add list without e-mail";          my $email = lc($arg->{'email'}) || confess "can't add list without e-mail";
582          my $from_addr = $arg->{'from'};          my $from_addr = $arg->{'from'};
583    
584          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
# Line 596  sub _get_list { Line 619  sub _get_list {
619    
620          my $lists = $self->{'loader'}->find_class('lists') || confess "can't find lists class";          my $lists = $self->{'loader'}->find_class('lists') || confess "can't find lists class";
621    
622          return $lists->search({ name => $name })->first;          return $lists->search({ name => lc($name) })->first;
623  }  }
624    
625  ###  ###
Legend:
Removed from v.47  
changed lines
  Added in v.52
  ViewVC Help
Powered by ViewVC 1.1.26