/[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 31 by dpavlin, Mon May 16 22:04: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 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";
   
                                 my $hash = $auth->generate_hash( $to_email );  
   
                                 my $from = $u->list_id->name . " <" . $u->list_id->email . "+" . $hash . ">";  
                                 my $to = $u->user_id->full_name . " <$to_email>";  
396    
397                                  my $m = Email::Simple->new($msg) || croak "can't parse message";                                  my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id;
398                                    my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} );
399    
400                                  print Dumper($m);                                  my $hash = $auth->generate_hash( $to_email );
   
                                 $m->header_set('From', $from) || croak "can't set From: header";  
                                 $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 $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";
409    
410                                    $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";
415    
416                                    $m_obj->header_set('X-Nos-Version', $VERSION);
417                                    $m_obj->header_set('X-Nos-Hash', $hash);
418    
419                                    # really send e-mail
420                                    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,
428                                          user_id => $u->user_id,                                          user_id => $u->user_id,
429                                            hash => $hash,
430                                  });                                  });
431                                  $sent->dbi_commit;                                  $sent->dbi_commit;
432                          }                          }
# Line 270  sub send_queued_messages { Line 442  sub send_queued_messages {
442    
443  Receive single message for list's inbox.  Receive single message for list's inbox.
444    
445   my $ok = $nos->inbox_message($message);   my $ok = $nos->inbox_message(
446            list => 'My list',
447            message => $message,
448     );
449    
450  =cut  =cut
451    
452  sub inbox_message {  sub inbox_message {
453          my $self = shift;          my $self = shift;
454    
455          my $message = shift || return;          my $arg = {@_};
456    
457            return unless ($arg->{'message'});
458            croak "need list name" unless ($arg->{'list'});
459    
460            my $this_list = $self->_get_list($arg->{'list'}) || croak "can't find list ".$arg->{'list'}."\n";
461    
462            my $m = Email::Simple->new($arg->{'message'}) || croak "can't parse message";
463    
464            my $to = $m->header('To') || die "can't find To: address in incomming message\n";
465    
466          my $m = new Email::Simple->new($message);          my @addrs = Email::Address->parse( $to );
467    
468            die "can't parse To: $to address\n" unless (@addrs);
469    
470            my $hl = $self->{'hash_len'} || confess "no hash_len?";
471    
472            my $hash;
473    
474            foreach my $a (@addrs) {
475                    if ($a->address =~ m/\+([a-f0-9]{$hl})@/) {
476                            $hash = $1;
477                            last;
478                    }
479            }
480    
481            croak "can't find hash in e-mail $to\n" unless ($hash);
482    
483            my $sent = $self->{'loader'}->find_class('sent');
484    
485            # will use null if no matching message_id is found
486            my $sent_msg = $sent->search( hash => $hash )->first;
487    
488            my ($message_id, $user_id) = (undef, undef);    # init with NULL
489    
490            if ($sent_msg) {
491                    $message_id = $sent_msg->message_id || carp "no message_id";
492                    $user_id = $sent_msg->user_id || carp "no user_id";
493            } else {
494                    warn "can't find sender with hash $hash\n";
495            }
496    
497    
498            my $is_bounce = 0;
499    
500            {
501                    no warnings;
502                    my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(
503                            $arg->{'message'}, { report_non_bounces=>1 },
504                    ) };
505                    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');
511    
512            my $this_received = $received->find_or_create({
513                    user_id => $user_id,
514                    list_id => $this_list->id,
515                    message_id => $message_id,
516                    message => $arg->{'message'},
517                    bounced => $is_bounce,
518            }) || croak "can't insert received message";
519    
520            $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";
526  }  }
527    
528    
# Line 294  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    
543  Returns C<Class::DBI> object for created list.  Returns C<Class::DBI> object for created list.
544    
545    C<email> address can be with domain or without it if your
546    MTA appends it. There is no checking for validity of your
547    list e-mail. Flexibility comes with resposibility, so please
548    feed correct (and configured) return addresses.
549    
550  =cut  =cut
551    
552  sub _add_list {  sub _add_list {
# Line 308  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 315  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 345  sub _get_list { Line 599  sub _get_list {
599          return $lists->search({ name => $name })->first;          return $lists->search({ name => $name })->first;
600  }  }
601    
602    ###
603    ### SOAP
604    ###
605    
606    package Nos::SOAP;
607    
608    use Carp;
609    
610    =head1 SOAP methods
611    
612    This methods are thin wrappers to provide SOAP calls. They are grouped in
613    C<Nos::SOAP> package which is in same F<Nos.pm> module file.
614    
615    Usually, you want to use named variables in your SOAP calls if at all
616    possible.
617    
618    However, if you have broken SOAP library (like PHP SOAP class from PEAR)
619    you will want to use positional arguments (in same order as documented for
620    methods below).
621    
622    =cut
623    
624    my $nos;
625    
626    sub new {
627            my $class = shift;
628            my $self = {@_};
629            bless($self, $class);
630    
631            $nos = new Nos( @_ ) || die "can't create Nos object";
632    
633            $self ? return $self : return undef;
634    }
635    
636    
637    =head2 NewList
638    
639     $message_id = NewList(
640            list => 'My list',
641            email => 'my-list@example.com'
642     );
643    
644    =cut
645    
646    sub NewList {
647            my $self = shift;
648    
649            if ($_[0] !~ m/^HASH/) {
650                    return $nos->new_list(
651                            list => $_[0], email => $_[1],
652                    );
653            } else {
654                    return $nos->new_list( %{ shift @_ } );
655            }
656    }
657    
658    
659    =head2 AddMemberToList
660    
661     $member_id = AddMemberToList(
662            list => 'My list',
663            email => 'e-mail@example.com',
664            name => 'Full Name'
665     );
666    
667    =cut
668    
669    sub AddMemberToList {
670            my $self = shift;
671    
672            if ($_[0] !~ m/^HASH/) {
673                    return $nos->add_member_to_list(
674                            list => $_[0], email => $_[1], name => $_[2],
675                    );
676            } else {
677                    return $nos->add_member_to_list( %{ shift @_ } );
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
707    
708     $message_id = AddMessageToList(
709            list => 'My list',
710            message => 'From: My list...'
711     );
712    
713    =cut
714    
715    sub AddMessageToList {
716            my $self = shift;
717    
718            if ($_[0] !~ m/^HASH/) {
719                    return $nos->add_message_to_list(
720                            list => $_[0], message => $_[1],
721                    );
722            } else {
723                    return $nos->add_message_to_list( %{ shift @_ } );
724            }
725    }
726    
727    
728    ###
729    
730  =head1 EXPORT  =head1 EXPORT
731    
# Line 370  at your option, any later version of Per Line 751  at your option, any later version of Per
751    
752    
753  =cut  =cut
754    
755    1;
Legend:
Removed from v.31  
changed lines
  Added in v.47
  ViewVC Help
Powered by ViewVC 1.1.26