/[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 38 by dpavlin, Tue May 17 21:37:06 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 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    
# Line 368  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    
 print "message_id: ",($message_id || "not found"),"\n";  
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 393  print "message_id: ",($message_id || "no Line 531  print "message_id: ",($message_id || "no
531    
532          $this_received->dbi_commit;          $this_received->dbi_commit;
533    
534          warn "inbox is not yet implemented";  #       print "message_id: ",($message_id || "not found")," -- $is_bounce\n";
535  }  }
536    
537    
# Line 407  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 426  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 433  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;
# Line 463  sub _get_list { Line 608  sub _get_list {
608          return $lists->search({ name => $name })->first;          return $lists->search({ name => $name })->first;
609  }  }
610    
611    ###
612    ### SOAP
613    ###
614    
615    package Nos::SOAP;
616    
617    use Carp;
618    
619    =head1 SOAP methods
620    
621    This methods are thin wrappers to provide SOAP calls. They are grouped in
622    C<Nos::SOAP> package which is in same F<Nos.pm> module file.
623    
624    Usually, you want to use named variables in your SOAP calls if at all
625    possible.
626    
627    However, if you have broken SOAP library (like PHP SOAP class from PEAR)
628    you will want to use positional arguments (in same order as documented for
629    methods below).
630    
631    =cut
632    
633    my $nos;
634    
635    sub new {
636            my $class = shift;
637            my $self = {@_};
638            bless($self, $class);
639    
640            $nos = new Nos( @_ ) || die "can't create Nos object";
641    
642            $self ? return $self : return undef;
643    }
644    
645    
646    =head2 NewList
647    
648     $message_id = NewList(
649            list => 'My list',
650            email => 'my-list@example.com'
651     );
652    
653    =cut
654    
655    sub NewList {
656            my $self = shift;
657    
658            if ($_[0] !~ m/^HASH/) {
659                    return $nos->new_list(
660                            list => $_[0], email => $_[1],
661                    );
662            } else {
663                    return $nos->new_list( %{ shift @_ } );
664            }
665    }
666    
667    
668    =head2 AddMemberToList
669    
670     $member_id = AddMemberToList(
671            list => 'My list',
672            email => 'e-mail@example.com',
673            name => 'Full Name'
674     );
675    
676    =cut
677    
678    sub AddMemberToList {
679            my $self = shift;
680    
681            if ($_[0] !~ m/^HASH/) {
682                    return $nos->add_member_to_list(
683                            list => $_[0], email => $_[1], name => $_[2],
684                    );
685            } else {
686                    return $nos->add_member_to_list( %{ shift @_ } );
687            }
688    }
689    
690    
691    =head2 ListMembers
692    
693     my @members = ListMembers(
694            list => 'My list',
695     );
696    
697    Returns array of hashes with user informations, see C<list_members>.
698    
699    =cut
700    
701    sub ListMembers {
702            my $self = shift;
703    
704            my $list_name;
705    
706            if ($_[0] !~ m/^HASH/) {
707                    $list_name = shift;
708            } else {
709                    $list_name = $_[0]->{'list'};
710            }
711    
712            return $nos->list_members( list => $list_name );
713    }
714    
715    =head2 AddMessageToList
716    
717     $message_id = AddMessageToList(
718            list => 'My list',
719            message => 'From: My list...'
720     );
721    
722    =cut
723    
724    sub AddMessageToList {
725            my $self = shift;
726    
727            if ($_[0] !~ m/^HASH/) {
728                    return $nos->add_message_to_list(
729                            list => $_[0], message => $_[1],
730                    );
731            } else {
732                    return $nos->add_message_to_list( %{ shift @_ } );
733            }
734    }
735    
736    
737    ###
738    
739  =head1 EXPORT  =head1 EXPORT
740    
# Line 488  at your option, any later version of Per Line 760  at your option, any later version of Per
760    
761    
762  =cut  =cut
763    
764    1;

Legend:
Removed from v.38  
changed lines
  Added in v.49

  ViewVC Help
Powered by ViewVC 1.1.26