/[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 30 by dpavlin, Mon May 16 21:54:41 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 24  use Email::Send; Line 24  use Email::Send;
24  use Carp;  use Carp;
25  use Email::Auth::AddressHash;  use Email::Auth::AddressHash;
26  use Email::Simple;  use Email::Simple;
27    use Email::Address;
28    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 51  Create new instance specifing database, Line 59  Create new instance specifing database,
59          passwd => '',          passwd => '',
60          debug => 1,          debug => 1,
61          verbose => 1,          verbose => 1,
62            hash_len => 8,
63   );   );
64    
65    Parametar C<hash_len> defines length of hash which will be added to each
66    outgoing e-mail message to ensure that replies can be linked with sent e-mails.
67    
68  =cut  =cut
69    
70  sub new {  sub new {
# Line 73  sub new { Line 85  sub new {
85                  relationships   => 1,                  relationships   => 1,
86          ) || croak "can't init Class::DBI::Loader";          ) || croak "can't init Class::DBI::Loader";
87    
88            $self->{'hash_len'} ||= 8;
89    
90          $self ? return $self : return undef;          $self ? return $self : return undef;
91  }  }
92    
93    
94    =head2 new_list
95    
96    Create new list. Required arguments are name of C<list> and
97    C<email> address.
98    
99     $nos->new_list(
100            list => 'My list',
101            from => 'Outgoing from comment',
102            email => 'my-list@example.com',
103     );
104    
105    Returns ID of newly created list.
106    
107    Calls internally L<_add_list>, see details there.
108    
109    =cut
110    
111    sub new_list {
112            my $self = shift;
113    
114            my $arg = {@_};
115    
116            confess "need list name" unless ($arg->{'list'});
117            confess "need list email" unless ($arg->{'list'});
118    
119            my $l = $self->_get_list($arg->{'list'}) ||
120                    $self->_add_list( @_ ) ||
121                    return undef;
122    
123            return $l->id;
124    }
125    
126    
127  =head2 add_member_to_list  =head2 add_member_to_list
128    
129  Add new member to list  Add new member to list
# Line 105  sub add_member_to_list { Line 152  sub add_member_to_list {
152          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";
153    
154          if (! Email::Valid->address($email)) {          if (! Email::Valid->address($email)) {
155                  carp "SKIPPING $name <$email>\n" if ($self->{'verbose'});                  carp "SKIPPING $name <$email>\n";
156                  return 0;                  return 0;
157          }          }
158    
# Line 116  sub add_member_to_list { Line 163  sub add_member_to_list {
163    
164          my $this_user = $users->find_or_create({          my $this_user = $users->find_or_create({
165                  email => $email,                  email => $email,
                 full_name => $name,  
166          }) || croak "can't find or create member\n";          }) || croak "can't find or create member\n";
167    
168            if ($name && $this_user->name ne $name) {
169                    $this_user->name($name || '');
170                    $this_user->update;
171            }
172    
173          my $user_on_list = $user_list->find_or_create({          my $user_on_list = $user_list->find_or_create({
174                  user_id => $this_user->id,                  user_id => $this_user->id,
175                  list_id => $list->id,                  list_id => $list->id,
# Line 131  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.
272    
273   $nos->add_message_to_list(   $nos->add_message_to_list(
274          list => 'My list',          list => 'My list',
275          message => 'From: My list <mylist@example.com>          message => 'Subject: welcome to list
276   To: John A. Doe <john.doe@example.com>  
   
277   This is example message   This is example message
278   ',   ',
279   );       );    
280    
281  On success returns ID of newly created (or existing) message.  On success returns ID of newly created (or existing) message.
282    
283    Only required header in e-mail is C<Subject:>. C<From:> and C<To:> headers
284    will be automatically generated, but if you want to use own headers, just
285    include them in messages.
286    
287  =cut  =cut
288    
289  sub add_message_to_list {  sub add_message_to_list {
# Line 156  sub add_message_to_list { Line 294  sub add_message_to_list {
294          my $list_name = $args->{'list'} || confess "need list name";          my $list_name = $args->{'list'} || confess "need list name";
295          my $message_text = $args->{'message'} || croak "need message";          my $message_text = $args->{'message'} || croak "need message";
296    
         warn Dumper($message_text);  
   
297          my $m = Email::Simple->new($message_text) || croak "can't parse message";          my $m = Email::Simple->new($message_text) || croak "can't parse message";
298    
299          croak "message doesn't have Subject header\n" unless( $m->header('Subject') );          unless( $m->header('Subject') ) {
300                    warn "message doesn't have Subject header\n";
301                    return;
302            }
303    
304          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
305    
# Line 193  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 202  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 223  sub send_queued_messages { Line 383  sub send_queued_messages {
383                  print "sending message ",$m->message_id," enqueued on ",$m->date," to list ",$m->list_id->name,"\n";                  print "sending message ",$m->message_id," enqueued on ",$m->date," to list ",$m->list_id->name,"\n";
384                  my $msg = $m->message_id->message;                  my $msg = $m->message_id->message;
385    
                 my $auth = Email::Auth::AddressHash->new(  
                         $m->list_id->name,      # secret  
                         10,                     # hashlen  
                 );  
   
386                  foreach my $u ($user_list->search(list_id => $m->list_id)) {                  foreach my $u ($user_list->search(list_id => $m->list_id)) {
387    
388                          my $to_email = $u->user_id->email;                          my $to_email = $u->user_id->email;
389    
390                            my ($from,$domain) = split(/@/, $u->list_id->email, 2);
391    
392                          if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {                          if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {
393                                  print "SKIP $to_email message allready sent\n";                                  print "SKIP $to_email message allready sent\n";
394                          } else {                          } else {
395                                  print "\t$to_email\n";                                  print "=> $to_email\n";
396    
397                                  my $hash = $auth->generate_hash( $to_email );                                  my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id;
398                                    my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} );
                                 my $from = $u->list_id->name . " <" . $u->list_id->email . "+" . $hash . ">";  
                                 my $to = $u->user_id->full_name . " <$to_email>";  
   
                                 my $m = Email::Simple->new($msg) || croak "can't parse message";  
   
                                 print Dumper($m);  
399    
400                                  $m->header_set('From', $from) || croak "can't set From: header";                                  my $hash = $auth->generate_hash( $to_email );
                                 $m->header_set('To', $to) || croak "can't set To: header";  
401    
402                                  # FIXME do real sending :-)                                  my $from_addr;
403                                  send IO => $m->as_string;                                  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";
412    
413                                    $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";
418    
419                                    $m_obj->header_set('X-Nos-Version', $VERSION);
420                                    $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,
431                                          user_id => $u->user_id,                                          user_id => $u->user_id,
432                                            hash => $hash,
433                                  });                                  });
434                                  $sent->dbi_commit;                                  $sent->dbi_commit;
435                          }                          }
# Line 270  sub send_queued_messages { Line 445  sub send_queued_messages {
445    
446  Receive single message for list's inbox.  Receive single message for list's inbox.
447    
448   my $ok = $nos->inbox_message($message);   my $ok = $nos->inbox_message(
449            list => 'My list',
450            message => $message,
451     );
452    
453  =cut  =cut
454    
455  sub inbox_message {  sub inbox_message {
456          my $self = shift;          my $self = shift;
457    
458          my $message = shift || return;          my $arg = {@_};
459    
460            return unless ($arg->{'message'});
461            croak "need list name" unless ($arg->{'list'});
462    
463            my $this_list = $self->_get_list($arg->{'list'}) || croak "can't find list ".$arg->{'list'}."\n";
464    
465            my $m = Email::Simple->new($arg->{'message'}) || croak "can't parse message";
466    
467            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 $m = new Email::Simple->new($message);          my @addrs = Email::Address->parse( $to );
472    
473            die "can't parse To: $to address\n" unless (@addrs);
474    
475            my $hl = $self->{'hash_len'} || confess "no hash_len?";
476    
477            my $hash;
478    
479            foreach my $a (@addrs) {
480                    if ($a->address =~ m/\+([a-f0-9]{$hl})@/) {
481                            $hash = $1;
482                            last;
483                    }
484            }
485    
486            warn "can't find hash in e-mail $to\n" unless ($hash);
487    
488            my $sent = $self->{'loader'}->find_class('sent');
489    
490            # will use null if no matching message_id is found
491            my $sent_msg = $sent->search( hash => $hash )->first;
492    
493            my ($message_id, $user_id) = (undef, undef);    # init with NULL
494    
495            if ($sent_msg) {
496                    $message_id = $sent_msg->message_id || carp "no message_id";
497                    $user_id = $sent_msg->user_id || carp "no user_id";
498            } else {
499                    warn "can't find sender with hash $hash\n";
500            }
501    
502    
503            my $is_bounce = 0;
504    
505            if ($arg->{'bounce'} || $return_path eq '<>' || $return_path eq '') {
506                    no warnings;
507                    my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(
508                            $arg->{'message'}, { report_non_bounces=>1 },
509                    ) };
510                    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');
516    
517            my $this_received = $received->find_or_create({
518                    user_id => $user_id,
519                    list_id => $this_list->id,
520                    message_id => $message_id,
521                    message => $arg->{'message'},
522                    bounced => $is_bounce,
523            }) || croak "can't insert received message";
524    
525            $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";
531  }  }
532    
533    
# Line 294  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 308  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 315  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 340  sub _get_list { Line 599  sub _get_list {
599    
600          my $name = shift || return;          my $name = shift || return;
601    
602          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists') || confess "can't find lists class";
603    
604            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          return $lists->search({ name => $name });  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    
737  Nothing.  Nothing.
# Line 370  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.30  
changed lines
  Added in v.48
  ViewVC Help
Powered by ViewVC 1.1.26