/[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 37 by dpavlin, Tue May 17 19:15:27 2005 UTC revision 48 by dpavlin, Tue May 24 15:19:44 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 56  Create new instance specifing database, Line 62  Create new instance specifing database,
62          hash_len => 8,          hash_len => 8,
63   );   );
64    
65  Parametar C<hash_len> defined length of hash which will be added to each  Parametar C<hash_len> defines length of hash which will be added to each
66  outgoing e-mail message.  outgoing e-mail message to ensure that replies can be linked with sent e-mails.
67    
68  =cut  =cut
69    
# Line 87  sub new { Line 93  sub new {
93    
94  =head2 new_list  =head2 new_list
95    
96  Create new list  Create new list. Required arguments are name of C<list> and
97    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    
105  Returns ID of newly created list.  Returns ID of newly created list.
106    
107    Calls internally L<_add_list>, see details there.
108    
109  =cut  =cut
110    
111  sub new_list {  sub new_list {
# Line 155  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 172  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 179  Adds message to one list's queue for lat Line 273  Adds message to one list's queue for lat
273   $nos->add_message_to_list(   $nos->add_message_to_list(
274          list => 'My list',          list => 'My list',
275          message => 'Subject: welcome to list          message => 'Subject: welcome to list
276    
277   This is example message   This is example message
278   ',   ',
279   );       );    
# Line 238  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 247  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 284  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 $email_hash = "+" . $hash . ( $domain ? '@' . $domain : '');
404                                    my $from_email_only = $from . $email_hash;
405                                    my $from_bounce = $from . '-bounce' . $email_hash;
406    
407                                    $from_addr .= '"' . $u->list_id->from_addr . '" ' if ($u->list_id->from_addr);
408                                    $from_addr .= '<' . $from_email_only . '>';
409                                    my $to = '"' . $u->user_id->name . '" <' . $to_email . '>';
410    
411                                  my $m_obj = Email::Simple->new($msg) || croak "can't parse message";                                  my $m_obj = Email::Simple->new($msg) || croak "can't parse message";
412    
413                                  $m_obj->header_set('From', $from) || croak "can't set From: header";                                  $m_obj->header_set('Return-Path', $from_bounce) || croak "can't set Return-Path: header";
414                                    $m_obj->header_set('Sender', $from_bounce) || croak "can't set Sender: header";
415                                    $m_obj->header_set('Errors-To', $from_bounce) || croak "can't set Errors-To: header";
416                                    $m_obj->header_set('From', $from_addr) || croak "can't set From: header";
417                                  $m_obj->header_set('To', $to) || croak "can't set To: header";                                  $m_obj->header_set('To', $to) || croak "can't set To: header";
418    
419                                  # FIXME do real sending :-)                                  $m_obj->header_set('X-Nos-Version', $VERSION);
420                                  send IO => $m_obj->as_string;                                  $m_obj->header_set('X-Nos-Hash', $hash);
421    
422                                    # really send e-mail
423                                    if (@email_send_options) {
424                                            send $email_send_driver => $m_obj->as_string, @email_send_options;
425                                    } else {
426                                            send $email_send_driver => $m_obj->as_string;
427                                    }
428    
429                                  $sent->create({                                  $sent->create({
430                                          message_id => $m->message_id,                                          message_id => $m->message_id,
# Line 335  sub inbox_message { Line 466  sub inbox_message {
466    
467          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";
468    
469            my $return_path = $m->header('Return-Path') || '';
470    
471          my @addrs = Email::Address->parse( $to );          my @addrs = Email::Address->parse( $to );
472    
473          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 483  sub inbox_message {
483                  }                  }
484          }          }
485    
486          croak "can't find hash in e-mail $to\n" unless ($hash);          warn "can't find hash in e-mail $to\n" unless ($hash);
487    
488          my $sent = $self->{'loader'}->find_class('sent');          my $sent = $self->{'loader'}->find_class('sent');
489    
# Line 362  sub inbox_message { Line 495  sub inbox_message {
495          if ($sent_msg) {          if ($sent_msg) {
496                  $message_id = $sent_msg->message_id || carp "no message_id";                  $message_id = $sent_msg->message_id || carp "no message_id";
497                  $user_id = $sent_msg->user_id || carp "no user_id";                  $user_id = $sent_msg->user_id || carp "no user_id";
498            } else {
499                    warn "can't find sender with hash $hash\n";
500          }          }
501    
 print "message_id: ",($message_id || "not found"),"\n";  
502    
503          my $is_bounce = 0;          my $is_bounce = 0;
504    
505          my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(          if ($arg->{'bounce'} || $return_path eq '<>' || $return_path eq '') {
506                  $arg->{'message'}, { report_non_bounces=>1 },                  no warnings;
507          ) };                  my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(
508          carp "can't check if this message is bounce!" if ($@);                          $arg->{'message'}, { report_non_bounces=>1 },
509                    ) };
510          $is_bounce++ if ($bounce && $bounce->is_bounce);                  carp "can't check if this message is bounce!" if ($@);
511            
512                    $is_bounce++ if ($bounce && $bounce->is_bounce);
513            }
514    
515          my $received = $self->{'loader'}->find_class('received');          my $received = $self->{'loader'}->find_class('received');
516    
# Line 387  print "message_id: ",($message_id || "no Line 524  print "message_id: ",($message_id || "no
524    
525          $this_received->dbi_commit;          $this_received->dbi_commit;
526    
527            print "message_id: ",($message_id || "not found")," -- $is_bounce\n";
528    
529    
530          warn "inbox is not yet implemented";          warn "inbox is not yet implemented";
531  }  }
532    
# Line 401  Create new list Line 541  Create new list
541    
542   my $list_obj = $nos->_add_list(   my $list_obj = $nos->_add_list(
543          list => 'My list',          list => 'My list',
544            from => 'Outgoing from comment',
545          email => 'my-list@example.com',          email => 'my-list@example.com',
546   );   );
547    
548  Returns C<Class::DBI> object for created list.  Returns C<Class::DBI> object for created list.
549    
550    C<email> address can be with domain or without it if your
551    MTA appends it. There is no checking for validity of your
552    list e-mail. Flexibility comes with resposibility, so please
553    feed correct (and configured) return addresses.
554    
555  =cut  =cut
556    
557  sub _add_list {  sub _add_list {
# Line 415  sub _add_list { Line 561  sub _add_list {
561    
562          my $name = $arg->{'list'} || confess "can't add list without name";          my $name = $arg->{'list'} || confess "can't add list without name";
563          my $email = $arg->{'email'} || confess "can't add list without e-mail";          my $email = $arg->{'email'} || confess "can't add list without e-mail";
564            my $from_addr = $arg->{'from'};
565    
566          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
567    
# Line 422  sub _add_list { Line 569  sub _add_list {
569                  name => $name,                  name => $name,
570                  email => $email,                  email => $email,
571          });          });
572            
573          croak "can't add list $name\n" unless ($l);          croak "can't add list $name\n" unless ($l);
574    
575            if ($from_addr && $l->from_addr ne $from_addr) {
576                    $l->from_addr($from_addr);
577                    $l->update;
578            }
579    
580          $l->dbi_commit;          $l->dbi_commit;
581    
582          return $l;          return $l;
# Line 452  sub _get_list { Line 604  sub _get_list {
604          return $lists->search({ name => $name })->first;          return $lists->search({ name => $name })->first;
605  }  }
606    
607    ###
608    ### SOAP
609    ###
610    
611    package Nos::SOAP;
612    
613    use Carp;
614    
615    =head1 SOAP methods
616    
617    This methods are thin wrappers to provide SOAP calls. They are grouped in
618    C<Nos::SOAP> package which is in same F<Nos.pm> module file.
619    
620    Usually, you want to use named variables in your SOAP calls if at all
621    possible.
622    
623    However, if you have broken SOAP library (like PHP SOAP class from PEAR)
624    you will want to use positional arguments (in same order as documented for
625    methods below).
626    
627    =cut
628    
629    my $nos;
630    
631    sub new {
632            my $class = shift;
633            my $self = {@_};
634            bless($self, $class);
635    
636            $nos = new Nos( @_ ) || die "can't create Nos object";
637    
638            $self ? return $self : return undef;
639    }
640    
641    
642    =head2 NewList
643    
644     $message_id = NewList(
645            list => 'My list',
646            email => 'my-list@example.com'
647     );
648    
649    =cut
650    
651    sub NewList {
652            my $self = shift;
653    
654            if ($_[0] !~ m/^HASH/) {
655                    return $nos->new_list(
656                            list => $_[0], email => $_[1],
657                    );
658            } else {
659                    return $nos->new_list( %{ shift @_ } );
660            }
661    }
662    
663    
664    =head2 AddMemberToList
665    
666     $member_id = AddMemberToList(
667            list => 'My list',
668            email => 'e-mail@example.com',
669            name => 'Full Name'
670     );
671    
672    =cut
673    
674    sub AddMemberToList {
675            my $self = shift;
676    
677            if ($_[0] !~ m/^HASH/) {
678                    return $nos->add_member_to_list(
679                            list => $_[0], email => $_[1], name => $_[2],
680                    );
681            } else {
682                    return $nos->add_member_to_list( %{ shift @_ } );
683            }
684    }
685    
686    
687    =head2 ListMembers
688    
689     my @members = ListMembers(
690            list => 'My list',
691     );
692    
693    Returns array of hashes with user informations, see C<list_members>.
694    
695    =cut
696    
697    sub ListMembers {
698            my $self = shift;
699    
700            my $list_name;
701    
702            if ($_[0] !~ m/^HASH/) {
703                    $list_name = shift;
704            } else {
705                    $list_name = $_[0]->{'list'};
706            }
707    
708            return $nos->list_members( list => $list_name );
709    }
710    
711    =head2 AddMessageToList
712    
713     $message_id = AddMessageToList(
714            list => 'My list',
715            message => 'From: My list...'
716     );
717    
718    =cut
719    
720    sub AddMessageToList {
721            my $self = shift;
722    
723            if ($_[0] !~ m/^HASH/) {
724                    return $nos->add_message_to_list(
725                            list => $_[0], message => $_[1],
726                    );
727            } else {
728                    return $nos->add_message_to_list( %{ shift @_ } );
729            }
730    }
731    
732    
733    ###
734    
735  =head1 EXPORT  =head1 EXPORT
736    
# Line 477  at your option, any later version of Per Line 756  at your option, any later version of Per
756    
757    
758  =cut  =cut
759    
760    1;
Legend:
Removed from v.37  
changed lines
  Added in v.48
  ViewVC Help
Powered by ViewVC 1.1.26