/[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 50 by dpavlin, Tue May 24 17:04:01 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 175  sub add_member_to_list { Line 176  sub add_member_to_list {
176          return $this_user->id;          return $this_user->id;
177  }  }
178    
179    =head2 list_members
180    
181    List all members of some list.
182    
183     my @members = list_members(
184            list => 'My list',
185     );
186    
187    Returns array of hashes with user informations like this:
188    
189     $member = {
190            name => 'Dobrica Pavlinusic',
191            email => 'dpavlin@rot13.org
192     }
193    
194    If list is not found, returns false.
195    
196    =cut
197    
198    sub list_members {
199            my $self = shift;
200    
201            my $args = {@_};
202    
203            my $list_name = $args->{'list'} || confess "need list name";
204    
205            my $lists = $self->{'loader'}->find_class('lists');
206            my $user_list = $self->{'loader'}->find_class('user_list');
207    
208            my $this_list = $lists->search( name => $list_name )->first || return;
209    
210            my @results;
211    
212            foreach my $user_on_list ($user_list->search(list_id => $this_list->id)) {
213                    my $row = {
214                            name => $user_on_list->user_id->name,
215                            email => $user_on_list->user_id->email,
216                    };
217    
218                    push @results, $row;
219            }
220    
221            return @results;
222    
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 241  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 287  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 307  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 341  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 356  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    
497          # will use null if no matching message_id is found          # will use null if no matching message_id is found
498          my $sent_msg = $sent->search( hash => $hash )->first;          my $sent_msg;
499            $sent_msg = $sent->search( hash => $hash )->first if ($hash);
500    
501          my ($message_id, $user_id) = (undef, undef);    # init with NULL          my ($message_id, $user_id) = (undef, undef);    # init with NULL
502    
503          if ($sent_msg) {          if ($sent_msg) {
504                  $message_id = $sent_msg->message_id || carp "no message_id";                  $message_id = $sent_msg->message_id || carp "no message_id";
505                  $user_id = $sent_msg->user_id || carp "no user_id";                  $user_id = $sent_msg->user_id || carp "no user_id";
506            } else {
507                    #warn "can't find sender with hash $hash\n";
508                    my $users = $self->{'loader'}->find_class('users');
509                    my $from = $m->header('From');
510                    $from = $1 if ($from =~ m/<(.*)>/);
511                    my $this_user = $users->search( email => $from )->first;
512                    $user_id = $this_user->id if ($this_user);
513          }          }
514    
 print "message_id: ",($message_id || "not found"),"\n";  
515    
516          my $is_bounce = 0;          my $is_bounce = 0;
517    
518          my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(          if ($return_path eq '<>' || $return_path eq '') {
519                  $arg->{'message'}, { report_non_bounces=>1 },                  no warnings;
520          ) };                  my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(
521          carp "can't check if this message is bounce!" if ($@);                          $arg->{'message'}, { report_non_bounces=>1 },
522                    ) };
523          $is_bounce++ if ($bounce && $bounce->is_bounce);                  #warn "can't check if this message is bounce!" if ($@);
524            
525                    $is_bounce++ if ($bounce && $bounce->is_bounce);
526            }
527    
528          my $received = $self->{'loader'}->find_class('received');          my $received = $self->{'loader'}->find_class('received');
529    
# Line 393  print "message_id: ",($message_id || "no Line 537  print "message_id: ",($message_id || "no
537    
538          $this_received->dbi_commit;          $this_received->dbi_commit;
539    
540          warn "inbox is not yet implemented";  #       print "message_id: ",($message_id || "not found")," -- $is_bounce\n";
541  }  }
542    
543    
# Line 407  Create new list Line 551  Create new list
551    
552   my $list_obj = $nos->_add_list(   my $list_obj = $nos->_add_list(
553          list => 'My list',          list => 'My list',
554            from => 'Outgoing from comment',
555          email => 'my-list@example.com',          email => 'my-list@example.com',
556   );   );
557    
# Line 426  sub _add_list { Line 571  sub _add_list {
571    
572          my $name = $arg->{'list'} || confess "can't add list without name";          my $name = $arg->{'list'} || confess "can't add list without name";
573          my $email = $arg->{'email'} || confess "can't add list without e-mail";          my $email = $arg->{'email'} || confess "can't add list without e-mail";
574            my $from_addr = $arg->{'from'};
575    
576          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
577    
# Line 433  sub _add_list { Line 579  sub _add_list {
579                  name => $name,                  name => $name,
580                  email => $email,                  email => $email,
581          });          });
582            
583          croak "can't add list $name\n" unless ($l);          croak "can't add list $name\n" unless ($l);
584    
585            if ($from_addr && $l->from_addr ne $from_addr) {
586                    $l->from_addr($from_addr);
587                    $l->update;
588            }
589    
590          $l->dbi_commit;          $l->dbi_commit;
591    
592          return $l;          return $l;
# Line 469  sub _get_list { Line 620  sub _get_list {
620    
621  package Nos::SOAP;  package Nos::SOAP;
622    
623    use Carp;
624    
625  =head1 SOAP methods  =head1 SOAP methods
626    
627  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 670  sub NewList {
670          }          }
671  }  }
672    
673    
674  =head2 AddMemberToList  =head2 AddMemberToList
675    
676   $member_id = AddMemberToList(   $member_id = AddMemberToList(
677          list => "My list",          list => 'My list',
678          email => "e-mail@example.com",          email => 'e-mail@example.com',
679          name => "Full Name"          name => 'Full Name'
680   );   );
681    
682  =cut  =cut
# Line 539  sub AddMemberToList { Line 693  sub AddMemberToList {
693          }          }
694  }  }
695    
696    
697    =head2 ListMembers
698    
699     my @members = ListMembers(
700            list => 'My list',
701     );
702    
703    Returns array of hashes with user informations, see C<list_members>.
704    
705    =cut
706    
707    sub ListMembers {
708            my $self = shift;
709    
710            my $list_name;
711    
712            if ($_[0] !~ m/^HASH/) {
713                    $list_name = shift;
714            } else {
715                    $list_name = $_[0]->{'list'};
716            }
717    
718            return $nos->list_members( list => $list_name );
719    }
720    
721  =head2 AddMessageToList  =head2 AddMessageToList
722    
723   $message_id = AddMessageToList(   $message_id = AddMessageToList(
Legend:
Removed from v.39  
changed lines
  Added in v.50
  ViewVC Help
Powered by ViewVC 1.1.26