/[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 47 by dpavlin, Tue May 24 14:02:05 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 28  use Email::Address; Line 28  use Email::Address;
28  use Mail::DeliveryStatus::BounceParser;  use Mail::DeliveryStatus::BounceParser;
29  use Data::Dumper;  use Data::Dumper;
30    
31    my $email_send_driver = 'Email::Send::IO';
32    my @email_send_options;
33    
34    #$email_send_driver = 'Sendmail';
35    
36    
37  =head1 NAME  =head1 NAME
38    
39  Nos - Notice Sender core module  Nos - Notice Sender core module
# Line 92  C<email> address. Line 98  C<email> address.
98    
99   $nos->new_list(   $nos->new_list(
100          list => 'My list',          list => 'My list',
101            from => 'Outgoing from comment',
102          email => 'my-list@example.com',          email => 'my-list@example.com',
103   );   );
104    
# Line 158  sub add_member_to_list { Line 165  sub add_member_to_list {
165                  email => $email,                  email => $email,
166          }) || croak "can't find or create member\n";          }) || croak "can't find or create member\n";
167    
168          if ($name && $this_user->full_name ne $name) {          if ($name && $this_user->name ne $name) {
169                  $this_user->full_name($name || '');                  $this_user->name($name || '');
170                  $this_user->update;                  $this_user->update;
171          }          }
172    
# Line 175  sub add_member_to_list { Line 182  sub add_member_to_list {
182          return $this_user->id;          return $this_user->id;
183  }  }
184    
185    =head2 list_members
186    
187    List all members of some list.
188    
189     my @members = list_members(
190            list => 'My list',
191     );
192    
193    Returns array of hashes with user informations like this:
194    
195     $member = {
196            name => 'Dobrica Pavlinusic',
197            email => 'dpavlin@rot13.org
198     }
199    
200    If list is not found, returns false.
201    
202    =cut
203    
204    sub list_members {
205            my $self = shift;
206    
207            my $args = {@_};
208    
209            my $list_name = $args->{'list'} || confess "need list name";
210    
211            my $lists = $self->{'loader'}->find_class('lists');
212            my $user_list = $self->{'loader'}->find_class('user_list');
213    
214            my $this_list = $lists->search( name => $list_name )->first || return;
215    
216            my @results;
217    
218            foreach my $user_on_list ($user_list->search(list_id => $this_list->id)) {
219                    my $row = {
220                            name => $user_on_list->user_id->name,
221                            email => $user_on_list->user_id->email,
222                    };
223    
224                    push @results, $row;
225            }
226    
227            return @results;
228    
229    }
230    
231    
232    =head2 delete_member
233    
234    Delete member from database.
235    
236     my $ok = delete_member(
237            name => 'Dobrica Pavlinusic'
238     );
239    
240     my $ok = delete_member(
241            email => 'dpavlin@rot13.org'
242     );
243    
244    Returns false if user doesn't exist.
245    
246    =cut
247    
248    sub delete_member {
249            my $self = shift;
250    
251            my $args = {@_};
252    
253            croak "need name or email of user to delete" unless ($args->{'name'} || $args->{'email'});
254    
255            my $key = 'name';
256            $key = 'email' if ($args->{'email'});
257    
258            my $users = $self->{'loader'}->find_class('users');
259    
260            my $this_user = $users->search( $key => $args->{$key} )->first || return;
261    
262    print Dumper($this_user);
263    
264            $this_user->delete || croak "can't delete user\n";
265    
266            return $users->dbi_commit || croak "can't commit";
267    }
268    
269  =head2 add_message_to_list  =head2 add_message_to_list
270    
271  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 332  sub add_message_to_list {
332    
333  Send queued messages or just ones for selected list  Send queued messages or just ones for selected list
334    
335   $nos->send_queued_messages("My list");   $nos->send_queued_messages("My list",'smtp');
336    
337    Second option is driver which will be used for e-mail delivery. If not
338    specified, C<IO> driver will be used which will dump e-mail to C<STDERR>.
339    
340    Other valid drivers are:
341    
342    =over 10
343    
344    =item smtp
345    
346    Send e-mail using SMTP server at 127.0.0.1
347    
348    =back
349    
350  =cut  =cut
351    
# Line 250  sub send_queued_messages { Line 354  sub send_queued_messages {
354    
355          my $list_name = shift;          my $list_name = shift;
356    
357            my $driver = shift || '';
358    
359            if (lc($driver) eq 'smtp') {
360                    $email_send_driver = 'Email::Send::SMTP';
361                    @email_send_options = ['127.0.0.1'];
362            }
363            warn "using $driver [$email_send_driver]\n";
364    
365          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
366          my $queue = $self->{'loader'}->find_class('queue');          my $queue = $self->{'loader'}->find_class('queue');
367          my $user_list = $self->{'loader'}->find_class('user_list');          my $user_list = $self->{'loader'}->find_class('user_list');
# Line 287  sub send_queued_messages { Line 399  sub send_queued_messages {
399    
400                                  my $hash = $auth->generate_hash( $to_email );                                  my $hash = $auth->generate_hash( $to_email );
401    
402                                  my $from = $u->list_id->name . " <" . $from . "+" . $hash . ( $domain ? "@" . $domain : '' ). ">";                                  my $from_addr;
403                                  my $to = $u->user_id->full_name . " <$to_email>";                                  my $from_email_only = $from . "+" . $hash . ( $domain ? '@' . $domain : '');
404                                    $from_addr .= '"' . $u->list_id->from_addr . '" ' if ($u->list_id->from_addr);
405                                    $from_addr .= '<' . $from_email_only . '>';
406                                    my $to = '"' . $u->user_id->name . '" <' . $to_email . '>';
407    
408                                  my $m_obj = Email::Simple->new($msg) || croak "can't parse message";                                  my $m_obj = Email::Simple->new($msg) || croak "can't parse message";
409    
410                                  $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";
411                                    $m_obj->header_set('Sender', $from_email_only) || croak "can't set Return-Path: header";
412                                    $m_obj->header_set('Errors-To', $from_email_only) || croak "can't set Return-Path: header";
413                                    $m_obj->header_set('From', $from_addr) || croak "can't set From: header";
414                                  $m_obj->header_set('To', $to) || croak "can't set To: header";                                  $m_obj->header_set('To', $to) || croak "can't set To: header";
415    
416                                  $m_obj->header_set('X-Nos-Version', $VERSION);                                  $m_obj->header_set('X-Nos-Version', $VERSION);
417                                  $m_obj->header_set('X-Nos-Hash', $hash);                                  $m_obj->header_set('X-Nos-Hash', $hash);
418    
419                                  # FIXME do real sending :-)                                  # really send e-mail
420                                  send IO => $m_obj->as_string;                                  if (@email_send_options) {
421                                            send $email_send_driver => $m_obj->as_string, @email_send_options;
422                                    } else {
423                                            send $email_send_driver => $m_obj->as_string;
424                                    }
425    
426                                  $sent->create({                                  $sent->create({
427                                          message_id => $m->message_id,                                          message_id => $m->message_id,
# Line 368  sub inbox_message { Line 490  sub inbox_message {
490          if ($sent_msg) {          if ($sent_msg) {
491                  $message_id = $sent_msg->message_id || carp "no message_id";                  $message_id = $sent_msg->message_id || carp "no message_id";
492                  $user_id = $sent_msg->user_id || carp "no user_id";                  $user_id = $sent_msg->user_id || carp "no user_id";
493            } else {
494                    warn "can't find sender with hash $hash\n";
495          }          }
496    
 print "message_id: ",($message_id || "not found"),"\n";  
497    
498          my $is_bounce = 0;          my $is_bounce = 0;
499    
500          my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(          {
501                  $arg->{'message'}, { report_non_bounces=>1 },                  no warnings;
502          ) };                  my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(
503          carp "can't check if this message is bounce!" if ($@);                          $arg->{'message'}, { report_non_bounces=>1 },
504                    ) };
505          $is_bounce++ if ($bounce && $bounce->is_bounce);                  carp "can't check if this message is bounce!" if ($@);
506            
507                    $is_bounce++ if ($bounce && $bounce->is_bounce);
508            }
509    
510          my $received = $self->{'loader'}->find_class('received');          my $received = $self->{'loader'}->find_class('received');
511    
# Line 393  print "message_id: ",($message_id || "no Line 519  print "message_id: ",($message_id || "no
519    
520          $this_received->dbi_commit;          $this_received->dbi_commit;
521    
522            print "message_id: ",($message_id || "not found")," -- $is_bounce\n";
523    
524    
525          warn "inbox is not yet implemented";          warn "inbox is not yet implemented";
526  }  }
527    
# Line 407  Create new list Line 536  Create new list
536    
537   my $list_obj = $nos->_add_list(   my $list_obj = $nos->_add_list(
538          list => 'My list',          list => 'My list',
539            from => 'Outgoing from comment',
540          email => 'my-list@example.com',          email => 'my-list@example.com',
541   );   );
542    
# Line 426  sub _add_list { Line 556  sub _add_list {
556    
557          my $name = $arg->{'list'} || confess "can't add list without name";          my $name = $arg->{'list'} || confess "can't add list without name";
558          my $email = $arg->{'email'} || confess "can't add list without e-mail";          my $email = $arg->{'email'} || confess "can't add list without e-mail";
559            my $from_addr = $arg->{'from'};
560    
561          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
562    
# Line 433  sub _add_list { Line 564  sub _add_list {
564                  name => $name,                  name => $name,
565                  email => $email,                  email => $email,
566          });          });
567            
568          croak "can't add list $name\n" unless ($l);          croak "can't add list $name\n" unless ($l);
569    
570            if ($from_addr && $l->from_addr ne $from_addr) {
571                    $l->from_addr($from_addr);
572                    $l->update;
573            }
574    
575          $l->dbi_commit;          $l->dbi_commit;
576    
577          return $l;          return $l;
# Line 469  sub _get_list { Line 605  sub _get_list {
605    
606  package Nos::SOAP;  package Nos::SOAP;
607    
608    use Carp;
609    
610  =head1 SOAP methods  =head1 SOAP methods
611    
612  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 655  sub NewList {
655          }          }
656  }  }
657    
658    
659  =head2 AddMemberToList  =head2 AddMemberToList
660    
661   $member_id = AddMemberToList(   $member_id = AddMemberToList(
662          list => "My list",          list => 'My list',
663          email => "e-mail@example.com",          email => 'e-mail@example.com',
664          name => "Full Name"          name => 'Full Name'
665   );   );
666    
667  =cut  =cut
# Line 539  sub AddMemberToList { Line 678  sub AddMemberToList {
678          }          }
679  }  }
680    
681    
682    =head2 ListMembers
683    
684     my @members = ListMembers(
685            list => 'My list',
686     );
687    
688    Returns array of hashes with user informations, see C<list_members>.
689    
690    =cut
691    
692    sub ListMembers {
693            my $self = shift;
694    
695            my $list_name;
696    
697            if ($_[0] !~ m/^HASH/) {
698                    $list_name = shift;
699            } else {
700                    $list_name = $_[0]->{'list'};
701            }
702    
703            return $nos->list_members( list => $list_name );
704    }
705    
706  =head2 AddMessageToList  =head2 AddMessageToList
707    
708   $message_id = AddMessageToList(   $message_id = AddMessageToList(
Legend:
Removed from v.39  
changed lines
  Added in v.47
  ViewVC Help
Powered by ViewVC 1.1.26