/[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 56 by dpavlin, Tue Jun 21 09:14:54 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.4';  our $VERSION = '0.5';
20    
21  use Class::DBI::Loader;  use Class::DBI::Loader;
22  use Email::Valid;  use Email::Valid;
# 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 132  Add new member to list Line 129  Add new member to list
129          list => "My list",          list => "My list",
130          email => "john.doe@example.com",          email => "john.doe@example.com",
131          name => "John A. Doe",          name => "John A. Doe",
132            ext_id => 42,
133   );   );
134    
135  C<name> parametar is optional.  C<name> and C<ext_id> parametars are optional.
136    
137  Return member ID if user is added.  Return member ID if user is added.
138    
# Line 145  sub add_member_to_list { Line 143  sub add_member_to_list {
143    
144          my $arg = {@_};          my $arg = {@_};
145    
146          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";
147          my $name = $arg->{'name'} || '';          my $name = $arg->{'name'} || '';
148          my $list_name = $arg->{'list'} || croak "need list name";          my $list_name = lc($arg->{'list'}) || croak "need list name";
149            my $ext_id = $arg->{'ext_id'};
150    
151          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";
152    
# Line 170  sub add_member_to_list { Line 169  sub add_member_to_list {
169                  $this_user->update;                  $this_user->update;
170          }          }
171    
172            if (defined($ext_id) && ($this_user->ext_id || '') ne $ext_id) {
173                    $this_user->ext_id($ext_id);
174                    $this_user->update;
175            }
176    
177          my $user_on_list = $user_list->find_or_create({          my $user_on_list = $user_list->find_or_create({
178                  user_id => $this_user->id,                  user_id => $this_user->id,
179                  list_id => $list->id,                  list_id => $list->id,
# Line 197  Returns array of hashes with user inform Line 201  Returns array of hashes with user inform
201          email => 'dpavlin@rot13.org          email => 'dpavlin@rot13.org
202   }   }
203    
204  If list is not found, returns false.  If list is not found, returns false. If there is C<ext_id> in user data,
205    that will also be returned.
206    
207  =cut  =cut
208    
# Line 206  sub list_members { Line 211  sub list_members {
211    
212          my $args = {@_};          my $args = {@_};
213    
214          my $list_name = $args->{'list'} || confess "need list name";          my $list_name = lc($args->{'list'}) || confess "need list name";
215    
216          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
217          my $user_list = $self->{'loader'}->find_class('user_list');          my $user_list = $self->{'loader'}->find_class('user_list');
# Line 221  sub list_members { Line 226  sub list_members {
226                          email => $user_on_list->user_id->email,                          email => $user_on_list->user_id->email,
227                  };                  };
228    
229                    my $ext_id = $user_on_list->user_id->ext_id;
230                    $row->{'ext_id'} = $ext_id if (defined($ext_id));
231    
232                  push @results, $row;                  push @results, $row;
233          }          }
234    
# Line 252  sub delete_member { Line 260  sub delete_member {
260    
261          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'});
262    
263            $args->{'email'} = lc($args->{'email'}) if ($args->{'email'});
264    
265          my $key = 'name';          my $key = 'name';
266          $key = 'email' if ($args->{'email'});          $key = 'email' if ($args->{'email'});
267    
# Line 259  sub delete_member { Line 269  sub delete_member {
269    
270          my $this_user = $users->search( $key => $args->{$key} )->first || return;          my $this_user = $users->search( $key => $args->{$key} )->first || return;
271    
 print Dumper($this_user);  
   
272          $this_user->delete || croak "can't delete user\n";          $this_user->delete || croak "can't delete user\n";
273    
274          return $users->dbi_commit || croak "can't commit";          return $users->dbi_commit || croak "can't commit";
# Line 291  sub add_message_to_list { Line 299  sub add_message_to_list {
299    
300          my $args = {@_};          my $args = {@_};
301    
302          my $list_name = $args->{'list'} || confess "need list name";          my $list_name = lc($args->{'list'}) || confess "need list name";
303          my $message_text = $args->{'message'} || croak "need message";          my $message_text = $args->{'message'} || croak "need message";
304    
305          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 340  sub add_message_to_list {
340    
341  Send queued messages or just ones for selected list  Send queued messages or just ones for selected list
342    
343   $nos->send_queued_messages("My list",'smtp');   $nos->send_queued_messages(
344            list => 'My list',
345            driver => 'smtp',
346            sleep => 3,
347     );
348    
349  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
350  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 359  Send e-mail using SMTP server at 127.0.0
359    
360  =back  =back
361    
362    Default sleep wait between two messages is 3 seconds.
363    
364  =cut  =cut
365    
366  sub send_queued_messages {  sub send_queued_messages {
367          my $self = shift;          my $self = shift;
368    
369          my $list_name = shift;          my $arg = {@_};
370    
371            my $list_name = lc($arg->{'list'}) || '';
372            my $driver = $arg->{'driver'} || '';
373            my $sleep = $arg->{'sleep'};
374            $sleep ||= 3 unless defined($sleep);
375    
376          my $driver = shift || '';          my $email_send_driver = 'Email::Send::IO';
377            my @email_send_options;
378    
379          if (lc($driver) eq 'smtp') {          if (lc($driver) eq 'smtp') {
380                  $email_send_driver = 'Email::Send::SMTP';                  $email_send_driver = 'Email::Send::SMTP';
381                  @email_send_options = ['127.0.0.1'];                  @email_send_options = ['127.0.0.1'];
382            } else {
383                    warn "dumping all messages to STDERR\n";
384          }          }
         warn "using $driver [$email_send_driver]\n";  
385    
386          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
387          my $queue = $self->{'loader'}->find_class('queue');          my $queue = $self->{'loader'}->find_class('queue');
# Line 401  sub send_queued_messages { Line 422  sub send_queued_messages {
422    
423                                  my $from_addr;                                  my $from_addr;
424                                  my $from_email_only = $from . "+" . $hash . ( $domain ? '@' . $domain : '');                                  my $from_email_only = $from . "+" . $hash . ( $domain ? '@' . $domain : '');
425    
426                                  $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);
427                                  $from_addr .= '<' . $from_email_only . '>';                                  $from_addr .= '<' . $from_email_only . '>';
428                                  my $to = '"' . $u->user_id->name . '" <' . $to_email . '>';                                  my $to = '"' . $u->user_id->name . '" <' . $to_email . '>';
# Line 408  sub send_queued_messages { Line 430  sub send_queued_messages {
430                                  my $m_obj = Email::Simple->new($msg) || croak "can't parse message";                                  my $m_obj = Email::Simple->new($msg) || croak "can't parse message";
431    
432                                  $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";
433                                  $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";
434                                  $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";
435                                  $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";
436                                  $m_obj->header_set('To', $to) || croak "can't set To: header";                                  $m_obj->header_set('To', $to) || croak "can't set To: header";
437    
# Line 429  sub send_queued_messages { Line 451  sub send_queued_messages {
451                                          hash => $hash,                                          hash => $hash,
452                                  });                                  });
453                                  $sent->dbi_commit;                                  $sent->dbi_commit;
454    
455                                    if ($sleep) {
456                                            warn "sleeping $sleep seconds\n";
457                                            sleep($sleep);
458                                    }
459                          }                          }
460                  }                  }
461                  $m->all_sent(1);                  $m->all_sent(1);
# Line 457  sub inbox_message { Line 484  sub inbox_message {
484          return unless ($arg->{'message'});          return unless ($arg->{'message'});
485          croak "need list name" unless ($arg->{'list'});          croak "need list name" unless ($arg->{'list'});
486    
487            $arg->{'list'} = lc($arg->{'list'});
488    
489          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";
490    
491          my $m = Email::Simple->new($arg->{'message'}) || croak "can't parse message";          my $m = Email::Simple->new($arg->{'message'}) || croak "can't parse message";
492    
493          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";
494    
495            my $return_path = $m->header('Return-Path') || '';
496    
497          my @addrs = Email::Address->parse( $to );          my @addrs = Email::Address->parse( $to );
498    
499          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 503  sub inbox_message {
503          my $hash;          my $hash;
504    
505          foreach my $a (@addrs) {          foreach my $a (@addrs) {
506                  if ($a->address =~ m/\+([a-f0-9]{$hl})@/) {                  if ($a->address =~ m/\+([a-f0-9]{$hl})@/i) {
507                          $hash = $1;                          $hash = $1;
508                          last;                          last;
509                  }                  }
510          }          }
511    
512          croak "can't find hash in e-mail $to\n" unless ($hash);          #warn "can't find hash in e-mail $to\n" unless ($hash);
513    
514          my $sent = $self->{'loader'}->find_class('sent');          my $sent = $self->{'loader'}->find_class('sent');
515    
516          # will use null if no matching message_id is found          # will use null if no matching message_id is found
517          my $sent_msg = $sent->search( hash => $hash )->first;          my $sent_msg;
518            $sent_msg = $sent->search( hash => $hash )->first if ($hash);
519    
520          my ($message_id, $user_id) = (undef, undef);    # init with NULL          my ($message_id, $user_id) = (undef, undef);    # init with NULL
521    
# Line 491  sub inbox_message { Line 523  sub inbox_message {
523                  $message_id = $sent_msg->message_id || carp "no message_id";                  $message_id = $sent_msg->message_id || carp "no message_id";
524                  $user_id = $sent_msg->user_id || carp "no user_id";                  $user_id = $sent_msg->user_id || carp "no user_id";
525          } else {          } else {
526                  warn "can't find sender with hash $hash\n";                  #warn "can't find sender with hash $hash\n";
527                    my $users = $self->{'loader'}->find_class('users');
528                    my $from = $m->header('From');
529                    $from = $1 if ($from =~ m/<(.*)>/);
530                    my $this_user = $users->search( email => lc($from) )->first;
531                    $user_id = $this_user->id if ($this_user);
532          }          }
533    
534    
535          my $is_bounce = 0;          my $is_bounce = 0;
536    
537          {          if ($return_path eq '<>' || $return_path eq '') {
538                  no warnings;                  no warnings;
539                  my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(                  my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(
540                          $arg->{'message'}, { report_non_bounces=>1 },                          $arg->{'message'}, { report_non_bounces=>1 },
541                  ) };                  ) };
542                  carp "can't check if this message is bounce!" if ($@);                  #warn "can't check if this message is bounce!" if ($@);
543                    
544                  $is_bounce++ if ($bounce && $bounce->is_bounce);                  $is_bounce++ if ($bounce && $bounce->is_bounce);
545          }          }
# Line 519  sub inbox_message { Line 556  sub inbox_message {
556    
557          $this_received->dbi_commit;          $this_received->dbi_commit;
558    
559          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";  
560  }  }
561    
562    
# Line 554  sub _add_list { Line 588  sub _add_list {
588    
589          my $arg = {@_};          my $arg = {@_};
590    
591          my $name = $arg->{'list'} || confess "can't add list without name";          my $name = lc($arg->{'list'}) || confess "can't add list without name";
592          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";
593          my $from_addr = $arg->{'from'};          my $from_addr = $arg->{'from'};
594    
595          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
# Line 596  sub _get_list { Line 630  sub _get_list {
630    
631          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";
632    
633          return $lists->search({ name => $name })->first;          return $lists->search({ name => lc($name) })->first;
634  }  }
635    
636  ###  ###
# Line 638  sub new { Line 672  sub new {
672    
673   $message_id = NewList(   $message_id = NewList(
674          list => 'My list',          list => 'My list',
675            from => 'Name of my list',
676          email => 'my-list@example.com'          email => 'my-list@example.com'
677   );   );
678    
# Line 648  sub NewList { Line 683  sub NewList {
683    
684          if ($_[0] !~ m/^HASH/) {          if ($_[0] !~ m/^HASH/) {
685                  return $nos->new_list(                  return $nos->new_list(
686                          list => $_[0], email => $_[1],                          list => $_[0], from => $_[1], email => $_[2],
687                  );                  );
688          } else {          } else {
689                  return $nos->new_list( %{ shift @_ } );                  return $nos->new_list( %{ shift @_ } );
Legend:
Removed from v.47  
changed lines
  Added in v.56
  ViewVC Help
Powered by ViewVC 1.1.26