/[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 39 by dpavlin, Tue May 17 22:23:40 2005 UTC revision 52 by dpavlin, Wed May 25 15:03:10 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 107  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 138  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 158  sub add_member_to_list { Line 162  sub add_member_to_list {
162                  email => $email,                  email => $email,
163          }) || croak "can't find or create member\n";          }) || croak "can't find or create member\n";
164    
165          if ($name && $this_user->full_name ne $name) {          if ($name && $this_user->name ne $name) {
166                  $this_user->full_name($name || '');                  $this_user->name($name || '');
167                  $this_user->update;                  $this_user->update;
168          }          }
169    
# Line 175  sub add_member_to_list { Line 179  sub add_member_to_list {
179          return $this_user->id;          return $this_user->id;
180  }  }
181    
182    =head2 list_members
183    
184    List all members of some list.
185    
186     my @members = list_members(
187            list => 'My list',
188     );
189    
190    Returns array of hashes with user informations like this:
191    
192     $member = {
193            name => 'Dobrica Pavlinusic',
194            email => 'dpavlin@rot13.org
195     }
196    
197    If list is not found, returns false.
198    
199    =cut
200    
201    sub list_members {
202            my $self = shift;
203    
204            my $args = {@_};
205    
206            my $list_name = lc($args->{'list'}) || confess "need list name";
207    
208            my $lists = $self->{'loader'}->find_class('lists');
209            my $user_list = $self->{'loader'}->find_class('user_list');
210    
211            my $this_list = $lists->search( name => $list_name )->first || return;
212    
213            my @results;
214    
215            foreach my $user_on_list ($user_list->search(list_id => $this_list->id)) {
216                    my $row = {
217                            name => $user_on_list->user_id->name,
218                            email => $user_on_list->user_id->email,
219                    };
220    
221                    push @results, $row;
222            }
223    
224            return @results;
225    
226    }
227    
228    
229    =head2 delete_member
230    
231    Delete member from database.
232    
233     my $ok = delete_member(
234            name => 'Dobrica Pavlinusic'
235     );
236    
237     my $ok = delete_member(
238            email => 'dpavlin@rot13.org'
239     );
240    
241    Returns false if user doesn't exist.
242    
243    =cut
244    
245    sub delete_member {
246            my $self = shift;
247    
248            my $args = {@_};
249    
250            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';
255            $key = 'email' if ($args->{'email'});
256    
257            my $users = $self->{'loader'}->find_class('users');
258    
259            my $this_user = $users->search( $key => $args->{$key} )->first || return;
260    
261            $this_user->delete || croak "can't delete user\n";
262    
263            return $users->dbi_commit || croak "can't commit";
264    }
265    
266  =head2 add_message_to_list  =head2 add_message_to_list
267    
268  Adds message to one list's queue for later sending.  Adds message to one list's queue for later sending.
# Line 200  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 241  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");   $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
339    specified, C<IO> driver will be used which will dump e-mail to C<STDERR>.
340    
341    Other valid drivers are:
342    
343    =over 10
344    
345    =item smtp
346    
347    Send e-mail using SMTP server at 127.0.0.1
348    
349    =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 $email_send_driver = 'Email::Send::IO';
366            my @email_send_options;
367    
368            if (lc($driver) eq 'smtp') {
369                    $email_send_driver = 'Email::Send::SMTP';
370                    @email_send_options = ['127.0.0.1'];
371            } else {
372                    warn "dumping all messages to STDERR\n";
373            }
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 287  sub send_queued_messages { Line 409  sub send_queued_messages {
409    
410                                  my $hash = $auth->generate_hash( $to_email );                                  my $hash = $auth->generate_hash( $to_email );
411    
412                                  my $from = $u->list_id->name . " <" . $from . "+" . $hash . ( $domain ? "@" . $domain : '' ). ">";                                  my $from_addr;
413                                  my $to = $u->user_id->full_name . " <$to_email>";                                  my $from_email_only = $from . "+" . $hash . ( $domain ? '@' . $domain : '');
414    
415                                    $from_addr .= '"' . $u->list_id->from_addr . '" ' if ($u->list_id->from_addr);
416                                    $from_addr .= '<' . $from_email_only . '>';
417                                    my $to = '"' . $u->user_id->name . '" <' . $to_email . '>';
418    
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('From', $from) || croak "can't set From: 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 Sender: header";
423                                    $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";
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    
427                                  $m_obj->header_set('X-Nos-Version', $VERSION);                                  $m_obj->header_set('X-Nos-Version', $VERSION);
428                                  $m_obj->header_set('X-Nos-Hash', $hash);                                  $m_obj->header_set('X-Nos-Hash', $hash);
429    
430                                  # FIXME do real sending :-)                                  # really send e-mail
431                                  send IO => $m_obj->as_string;                                  if (@email_send_options) {
432                                            send $email_send_driver => $m_obj->as_string, @email_send_options;
433                                    } else {
434                                            send $email_send_driver => $m_obj->as_string;
435                                    }
436    
437                                  $sent->create({                                  $sent->create({
438                                          message_id => $m->message_id,                                          message_id => $m->message_id,
# Line 307  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 335  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 350  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    
511          if ($sent_msg) {          if ($sent_msg) {
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 {
515                    #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    
 print "message_id: ",($message_id || "not found"),"\n";  
523    
524          my $is_bounce = 0;          my $is_bounce = 0;
525    
526          my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(          if ($return_path eq '<>' || $return_path eq '') {
527                  $arg->{'message'}, { report_non_bounces=>1 },                  no warnings;
528          ) };                  my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(
529          carp "can't check if this message is bounce!" if ($@);                          $arg->{'message'}, { report_non_bounces=>1 },
530                    ) };
531          $is_bounce++ if ($bounce && $bounce->is_bounce);                  #warn "can't check if this message is bounce!" if ($@);
532            
533                    $is_bounce++ if ($bounce && $bounce->is_bounce);
534            }
535    
536          my $received = $self->{'loader'}->find_class('received');          my $received = $self->{'loader'}->find_class('received');
537    
# Line 393  print "message_id: ",($message_id || "no Line 545  print "message_id: ",($message_id || "no
545    
546          $this_received->dbi_commit;          $this_received->dbi_commit;
547    
548          warn "inbox is not yet implemented";  #       print "message_id: ",($message_id || "not found")," -- $is_bounce\n";
549  }  }
550    
551    
# Line 407  Create new list Line 559  Create new list
559    
560   my $list_obj = $nos->_add_list(   my $list_obj = $nos->_add_list(
561          list => 'My list',          list => 'My list',
562            from => 'Outgoing from comment',
563          email => 'my-list@example.com',          email => 'my-list@example.com',
564   );   );
565    
# Line 424  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'};
583    
584          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
585    
# Line 433  sub _add_list { Line 587  sub _add_list {
587                  name => $name,                  name => $name,
588                  email => $email,                  email => $email,
589          });          });
590            
591          croak "can't add list $name\n" unless ($l);          croak "can't add list $name\n" unless ($l);
592    
593            if ($from_addr && $l->from_addr ne $from_addr) {
594                    $l->from_addr($from_addr);
595                    $l->update;
596            }
597    
598          $l->dbi_commit;          $l->dbi_commit;
599    
600          return $l;          return $l;
# Line 460  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  ###  ###
# Line 469  sub _get_list { Line 628  sub _get_list {
628    
629  package Nos::SOAP;  package Nos::SOAP;
630    
631    use Carp;
632    
633  =head1 SOAP methods  =head1 SOAP methods
634    
635  This methods are thin wrappers to provide SOAP calls. They are grouped in  This methods are thin wrappers to provide SOAP calls. They are grouped in
# Line 517  sub NewList { Line 678  sub NewList {
678          }          }
679  }  }
680    
681    
682  =head2 AddMemberToList  =head2 AddMemberToList
683    
684   $member_id = AddMemberToList(   $member_id = AddMemberToList(
685          list => "My list",          list => 'My list',
686          email => "e-mail@example.com",          email => 'e-mail@example.com',
687          name => "Full Name"          name => 'Full Name'
688   );   );
689    
690  =cut  =cut
# Line 539  sub AddMemberToList { Line 701  sub AddMemberToList {
701          }          }
702  }  }
703    
704    
705    =head2 ListMembers
706    
707     my @members = ListMembers(
708            list => 'My list',
709     );
710    
711    Returns array of hashes with user informations, see C<list_members>.
712    
713    =cut
714    
715    sub ListMembers {
716            my $self = shift;
717    
718            my $list_name;
719    
720            if ($_[0] !~ m/^HASH/) {
721                    $list_name = shift;
722            } else {
723                    $list_name = $_[0]->{'list'};
724            }
725    
726            return $nos->list_members( list => $list_name );
727    }
728    
729  =head2 AddMessageToList  =head2 AddMessageToList
730    
731   $message_id = AddMessageToList(   $message_id = AddMessageToList(
Legend:
Removed from v.39  
changed lines
  Added in v.52
  ViewVC Help
Powered by ViewVC 1.1.26