/[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 43 by dpavlin, Wed May 18 12:29:35 2005 UTC revision 49 by dpavlin, Tue May 24 16:44:34 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.3';  our $VERSION = '0.4';
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;
29  use Data::Dumper;  
30    
31  =head1 NAME  =head1 NAME
32    
# Line 92  C<email> address. Line 92  C<email> address.
92    
93   $nos->new_list(   $nos->new_list(
94          list => 'My list',          list => 'My list',
95            from => 'Outgoing from comment',
96          email => 'my-list@example.com',          email => 'my-list@example.com',
97   );   );
98    
# Line 158  sub add_member_to_list { Line 159  sub add_member_to_list {
159                  email => $email,                  email => $email,
160          }) || croak "can't find or create member\n";          }) || croak "can't find or create member\n";
161    
162          if ($name && $this_user->full_name ne $name) {          if ($name && $this_user->name ne $name) {
163                  $this_user->full_name($name || '');                  $this_user->name($name || '');
164                  $this_user->update;                  $this_user->update;
165          }          }
166    
# Line 177  sub add_member_to_list { Line 178  sub add_member_to_list {
178    
179  =head2 list_members  =head2 list_members
180    
181    List all members of some list.
182    
183   my @members = list_members(   my @members = list_members(
184          list => 'My list',          list => 'My list',
185   );   );
# Line 184  sub add_member_to_list { Line 187  sub add_member_to_list {
187  Returns array of hashes with user informations like this:  Returns array of hashes with user informations like this:
188    
189   $member = {   $member = {
190          full_name => 'Dobrica Pavlinusic',          name => 'Dobrica Pavlinusic',
191          email => 'dpavlin@rot13.org          email => 'dpavlin@rot13.org
192   }   }
193    
194    If list is not found, returns false.
195    
196  =cut  =cut
197    
198  sub list_members {  sub list_members {
# Line 200  sub list_members { Line 205  sub list_members {
205          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
206          my $user_list = $self->{'loader'}->find_class('user_list');          my $user_list = $self->{'loader'}->find_class('user_list');
207    
208          my $this_list = $lists->search( name => $list_name )->first || croak "can't find list $list_name\n";          my $this_list = $lists->search( name => $list_name )->first || return;
209    
210          my @results;          my @results;
211    
212          foreach my $user_on_list ($user_list->search(list_id => $this_list->id)) {          foreach my $user_on_list ($user_list->search(list_id => $this_list->id)) {
213                  my $row = {                  my $row = {
214                          full_name => $user_on_list->user_id->full_name,                          name => $user_on_list->user_id->name,
215                          email => $user_on_list->user_id->email,                          email => $user_on_list->user_id->email,
216                  };                  };
217    
# Line 218  sub list_members { Line 223  sub list_members {
223  }  }
224    
225    
226    =head2 delete_member
227    
228    Delete member from database.
229    
230     my $ok = delete_member(
231            name => 'Dobrica Pavlinusic'
232     );
233    
234     my $ok = delete_member(
235            email => 'dpavlin@rot13.org'
236     );
237    
238    Returns false if user doesn't exist.
239    
240    =cut
241    
242    sub delete_member {
243            my $self = shift;
244    
245            my $args = {@_};
246    
247            croak "need name or email of user to delete" unless ($args->{'name'} || $args->{'email'});
248    
249            my $key = 'name';
250            $key = 'email' if ($args->{'email'});
251    
252            my $users = $self->{'loader'}->find_class('users');
253    
254            my $this_user = $users->search( $key => $args->{$key} )->first || return;
255    
256            $this_user->delete || croak "can't delete user\n";
257    
258            return $users->dbi_commit || croak "can't commit";
259    }
260    
261  =head2 add_message_to_list  =head2 add_message_to_list
262    
263  Adds message to one list's queue for later sending.  Adds message to one list's queue for later sending.
# Line 284  sub add_message_to_list { Line 324  sub add_message_to_list {
324    
325  Send queued messages or just ones for selected list  Send queued messages or just ones for selected list
326    
327   $nos->send_queued_messages("My list");   $nos->send_queued_messages(
328            list => 'My list',
329            driver => 'smtp',
330            sleep => 3,
331     );
332    
333    Second option is driver which will be used for e-mail delivery. If not
334    specified, C<IO> driver will be used which will dump e-mail to C<STDERR>.
335    
336    Other valid drivers are:
337    
338    =over 10
339    
340    =item smtp
341    
342    Send e-mail using SMTP server at 127.0.0.1
343    
344    =back
345    
346    Default sleep wait between two messages is 3 seconds.
347    
348  =cut  =cut
349    
350  sub send_queued_messages {  sub send_queued_messages {
351          my $self = shift;          my $self = shift;
352    
353          my $list_name = shift;          my $arg = {@_};
354    
355            my $list_name = $arg->{'list'} || '';
356            my $driver = $arg->{'driver'} || '';
357            my $sleep = $arg->{'sleep'};
358            $sleep ||= 3 unless defined($sleep);
359    
360            my $email_send_driver = 'Email::Send::IO';
361            my @email_send_options;
362    
363            if (lc($driver) eq 'smtp') {
364                    $email_send_driver = 'Email::Send::SMTP';
365                    @email_send_options = ['127.0.0.1'];
366            }
367            warn "using $driver [$email_send_driver]\n";
368    
369          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
370          my $queue = $self->{'loader'}->find_class('queue');          my $queue = $self->{'loader'}->find_class('queue');
# Line 330  sub send_queued_messages { Line 403  sub send_queued_messages {
403    
404                                  my $hash = $auth->generate_hash( $to_email );                                  my $hash = $auth->generate_hash( $to_email );
405    
406                                  my $from = $u->list_id->name . " <" . $from . "+" . $hash . ( $domain ? "@" . $domain : '' ). ">";                                  my $from_addr;
407                                  my $to = $u->user_id->full_name . " <$to_email>";                                  my $from_email_only = $from . "+" . $hash . ( $domain ? '@' . $domain : '');
408    
409                                    $from_addr .= '"' . $u->list_id->from_addr . '" ' if ($u->list_id->from_addr);
410                                    $from_addr .= '<' . $from_email_only . '>';
411                                    my $to = '"' . $u->user_id->name . '" <' . $to_email . '>';
412    
413                                  my $m_obj = Email::Simple->new($msg) || croak "can't parse message";                                  my $m_obj = Email::Simple->new($msg) || croak "can't parse message";
414    
415                                  $m_obj->header_set('From', $from) || croak "can't set From: header";                                  $m_obj->header_set('Return-Path', $from_email_only) || croak "can't set Return-Path: header";
416                                    $m_obj->header_set('Sender', $from_email_only) || croak "can't set Sender: header";
417                                    $m_obj->header_set('Errors-To', $from_email_only) || croak "can't set Errors-To: header";
418                                    $m_obj->header_set('From', $from_addr) || croak "can't set From: header";
419                                  $m_obj->header_set('To', $to) || croak "can't set To: header";                                  $m_obj->header_set('To', $to) || croak "can't set To: header";
420    
421                                  $m_obj->header_set('X-Nos-Version', $VERSION);                                  $m_obj->header_set('X-Nos-Version', $VERSION);
422                                  $m_obj->header_set('X-Nos-Hash', $hash);                                  $m_obj->header_set('X-Nos-Hash', $hash);
423    
424                                  # FIXME do real sending :-)                                  # really send e-mail
425                                  send IO => $m_obj->as_string;                                  if (@email_send_options) {
426                                            send $email_send_driver => $m_obj->as_string, @email_send_options;
427                                    } else {
428                                            send $email_send_driver => $m_obj->as_string;
429                                    }
430    
431                                  $sent->create({                                  $sent->create({
432                                          message_id => $m->message_id,                                          message_id => $m->message_id,
# Line 350  sub send_queued_messages { Line 434  sub send_queued_messages {
434                                          hash => $hash,                                          hash => $hash,
435                                  });                                  });
436                                  $sent->dbi_commit;                                  $sent->dbi_commit;
437    
438                                    if ($sleep) {
439                                            warn "sleeping $sleep seconds\n";
440                                            sleep($sleep);
441                                    }
442                          }                          }
443                  }                  }
444                  $m->all_sent(1);                  $m->all_sent(1);
# Line 384  sub inbox_message { Line 473  sub inbox_message {
473    
474          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";
475    
476            my $return_path = $m->header('Return-Path') || '';
477    
478          my @addrs = Email::Address->parse( $to );          my @addrs = Email::Address->parse( $to );
479    
480          die "can't parse To: $to address\n" unless (@addrs);          die "can't parse To: $to address\n" unless (@addrs);
# Line 399  sub inbox_message { Line 490  sub inbox_message {
490                  }                  }
491          }          }
492    
493          croak "can't find hash in e-mail $to\n" unless ($hash);          warn "can't find hash in e-mail $to\n" unless ($hash);
494    
495          my $sent = $self->{'loader'}->find_class('sent');          my $sent = $self->{'loader'}->find_class('sent');
496    
# Line 411  sub inbox_message { Line 502  sub inbox_message {
502          if ($sent_msg) {          if ($sent_msg) {
503                  $message_id = $sent_msg->message_id || carp "no message_id";                  $message_id = $sent_msg->message_id || carp "no message_id";
504                  $user_id = $sent_msg->user_id || carp "no user_id";                  $user_id = $sent_msg->user_id || carp "no user_id";
505            } else {
506                    warn "can't find sender with hash $hash\n";
507          }          }
508    
509    
510          my $is_bounce = 0;          my $is_bounce = 0;
511    
512          my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(          if ($return_path eq '<>' || $return_path eq '') {
513                  $arg->{'message'}, { report_non_bounces=>1 },                  no warnings;
514          ) };                  my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(
515          carp "can't check if this message is bounce!" if ($@);                          $arg->{'message'}, { report_non_bounces=>1 },
516                    ) };
517          $is_bounce++ if ($bounce && $bounce->is_bounce);                  warn "can't check if this message is bounce!" if ($@);
518            
519                    $is_bounce++ if ($bounce && $bounce->is_bounce);
520            }
521    
522          my $received = $self->{'loader'}->find_class('received');          my $received = $self->{'loader'}->find_class('received');
523    
# Line 435  sub inbox_message { Line 531  sub inbox_message {
531    
532          $this_received->dbi_commit;          $this_received->dbi_commit;
533    
534          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";  
535  }  }
536    
537    
# Line 452  Create new list Line 545  Create new list
545    
546   my $list_obj = $nos->_add_list(   my $list_obj = $nos->_add_list(
547          list => 'My list',          list => 'My list',
548            from => 'Outgoing from comment',
549          email => 'my-list@example.com',          email => 'my-list@example.com',
550   );   );
551    
# Line 471  sub _add_list { Line 565  sub _add_list {
565    
566          my $name = $arg->{'list'} || confess "can't add list without name";          my $name = $arg->{'list'} || confess "can't add list without name";
567          my $email = $arg->{'email'} || confess "can't add list without e-mail";          my $email = $arg->{'email'} || confess "can't add list without e-mail";
568            my $from_addr = $arg->{'from'};
569    
570          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
571    
# Line 478  sub _add_list { Line 573  sub _add_list {
573                  name => $name,                  name => $name,
574                  email => $email,                  email => $email,
575          });          });
576            
577          croak "can't add list $name\n" unless ($l);          croak "can't add list $name\n" unless ($l);
578    
579            if ($from_addr && $l->from_addr ne $from_addr) {
580                    $l->from_addr($from_addr);
581                    $l->update;
582            }
583    
584          $l->dbi_commit;          $l->dbi_commit;
585    
586          return $l;          return $l;
Legend:
Removed from v.43  
changed lines
  Added in v.49
  ViewVC Help
Powered by ViewVC 1.1.26