/[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 32 by dpavlin, Mon May 16 22:32:58 2005 UTC revision 39 by dpavlin, Tue May 17 22:23:40 2005 UTC
# 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  =head1 NAME  =head1 NAME
# Line 51  Create new instance specifing database, Line 53  Create new instance specifing database,
53          passwd => '',          passwd => '',
54          debug => 1,          debug => 1,
55          verbose => 1,          verbose => 1,
56            hash_len => 8,
57   );   );
58    
59    Parametar C<hash_len> defines length of hash which will be added to each
60    outgoing e-mail message to ensure that replies can be linked with sent e-mails.
61    
62  =cut  =cut
63    
64  sub new {  sub new {
# Line 73  sub new { Line 79  sub new {
79                  relationships   => 1,                  relationships   => 1,
80          ) || croak "can't init Class::DBI::Loader";          ) || croak "can't init Class::DBI::Loader";
81    
82            $self->{'hash_len'} ||= 8;
83    
84          $self ? return $self : return undef;          $self ? return $self : return undef;
85  }  }
86    
87    
88    =head2 new_list
89    
90    Create new list. Required arguments are name of C<list> and
91    C<email> address.
92    
93     $nos->new_list(
94            list => 'My list',
95            email => 'my-list@example.com',
96     );
97    
98    Returns ID of newly created list.
99    
100    Calls internally L<_add_list>, see details there.
101    
102    =cut
103    
104    sub new_list {
105            my $self = shift;
106    
107            my $arg = {@_};
108    
109            confess "need list name" unless ($arg->{'list'});
110            confess "need list email" unless ($arg->{'list'});
111    
112            my $l = $self->_get_list($arg->{'list'}) ||
113                    $self->_add_list( @_ ) ||
114                    return undef;
115    
116            return $l->id;
117    }
118    
119    
120  =head2 add_member_to_list  =head2 add_member_to_list
121    
122  Add new member to list  Add new member to list
# Line 105  sub add_member_to_list { Line 145  sub add_member_to_list {
145          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";
146    
147          if (! Email::Valid->address($email)) {          if (! Email::Valid->address($email)) {
148                  carp "SKIPPING $name <$email>\n" if ($self->{'verbose'});                  carp "SKIPPING $name <$email>\n";
149                  return 0;                  return 0;
150          }          }
151    
# Line 116  sub add_member_to_list { Line 156  sub add_member_to_list {
156    
157          my $this_user = $users->find_or_create({          my $this_user = $users->find_or_create({
158                  email => $email,                  email => $email,
                 full_name => $name,  
159          }) || croak "can't find or create member\n";          }) || croak "can't find or create member\n";
160    
161            if ($name && $this_user->full_name ne $name) {
162                    $this_user->full_name($name || '');
163                    $this_user->update;
164            }
165    
166          my $user_on_list = $user_list->find_or_create({          my $user_on_list = $user_list->find_or_create({
167                  user_id => $this_user->id,                  user_id => $this_user->id,
168                  list_id => $list->id,                  list_id => $list->id,
# Line 137  Adds message to one list's queue for lat Line 181  Adds message to one list's queue for lat
181    
182   $nos->add_message_to_list(   $nos->add_message_to_list(
183          list => 'My list',          list => 'My list',
184          message => 'From: My list <mylist@example.com>          message => 'Subject: welcome to list
185   To: John A. Doe <john.doe@example.com>  
   
186   This is example message   This is example message
187   ',   ',
188   );       );    
189    
190  On success returns ID of newly created (or existing) message.  On success returns ID of newly created (or existing) message.
191    
192    Only required header in e-mail is C<Subject:>. C<From:> and C<To:> headers
193    will be automatically generated, but if you want to use own headers, just
194    include them in messages.
195    
196  =cut  =cut
197    
198  sub add_message_to_list {  sub add_message_to_list {
# Line 236  sub send_queued_messages { Line 283  sub send_queued_messages {
283                                  print "=> $to_email\n";                                  print "=> $to_email\n";
284    
285                                  my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id;                                  my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id;
286                                  my $auth = Email::Auth::AddressHash->new( $secret, 10 );                                  my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} );
287    
288                                  my $hash = $auth->generate_hash( $to_email );                                  my $hash = $auth->generate_hash( $to_email );
289    
# Line 248  sub send_queued_messages { Line 295  sub send_queued_messages {
295                                  $m_obj->header_set('From', $from) || croak "can't set From: header";                                  $m_obj->header_set('From', $from) || croak "can't set From: header";
296                                  $m_obj->header_set('To', $to) || croak "can't set To: header";                                  $m_obj->header_set('To', $to) || croak "can't set To: header";
297    
298                                    $m_obj->header_set('X-Nos-Version', $VERSION);
299                                    $m_obj->header_set('X-Nos-Hash', $hash);
300    
301                                  # FIXME do real sending :-)                                  # FIXME do real sending :-)
302                                  send IO => $m_obj->as_string;                                  send IO => $m_obj->as_string;
303    
304                                  $sent->create({                                  $sent->create({
305                                          message_id => $m->message_id,                                          message_id => $m->message_id,
306                                          user_id => $u->user_id,                                          user_id => $u->user_id,
307                                            hash => $hash,
308                                  });                                  });
309                                  $sent->dbi_commit;                                  $sent->dbi_commit;
310                          }                          }
# Line 269  sub send_queued_messages { Line 320  sub send_queued_messages {
320    
321  Receive single message for list's inbox.  Receive single message for list's inbox.
322    
323   my $ok = $nos->inbox_message($message);   my $ok = $nos->inbox_message(
324            list => 'My list',
325            message => $message,
326     );
327    
328  =cut  =cut
329    
330  sub inbox_message {  sub inbox_message {
331          my $self = shift;          my $self = shift;
332    
333          my $message = shift || return;          my $arg = {@_};
334    
335            return unless ($arg->{'message'});
336            croak "need list name" unless ($arg->{'list'});
337    
338            my $this_list = $self->_get_list($arg->{'list'}) || croak "can't find list ".$arg->{'list'}."\n";
339    
340            my $m = Email::Simple->new($arg->{'message'}) || croak "can't parse message";
341    
342            my $to = $m->header('To') || die "can't find To: address in incomming message\n";
343    
344            my @addrs = Email::Address->parse( $to );
345    
346            die "can't parse To: $to address\n" unless (@addrs);
347    
348            my $hl = $self->{'hash_len'} || confess "no hash_len?";
349    
350            my $hash;
351    
352            foreach my $a (@addrs) {
353                    if ($a->address =~ m/\+([a-f0-9]{$hl})@/) {
354                            $hash = $1;
355                            last;
356                    }
357            }
358    
359            croak "can't find hash in e-mail $to\n" unless ($hash);
360    
361            my $sent = $self->{'loader'}->find_class('sent');
362    
363            # will use null if no matching message_id is found
364            my $sent_msg = $sent->search( hash => $hash )->first;
365    
366            my ($message_id, $user_id) = (undef, undef);    # init with NULL
367    
368            if ($sent_msg) {
369                    $message_id = $sent_msg->message_id || carp "no message_id";
370                    $user_id = $sent_msg->user_id || carp "no user_id";
371            }
372    
373    print "message_id: ",($message_id || "not found"),"\n";
374    
375            my $is_bounce = 0;
376    
377            my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(
378                    $arg->{'message'}, { report_non_bounces=>1 },
379            ) };
380            carp "can't check if this message is bounce!" if ($@);
381    
382            $is_bounce++ if ($bounce && $bounce->is_bounce);
383    
384            my $received = $self->{'loader'}->find_class('received');
385    
386            my $this_received = $received->find_or_create({
387                    user_id => $user_id,
388                    list_id => $this_list->id,
389                    message_id => $message_id,
390                    message => $arg->{'message'},
391                    bounced => $is_bounce,
392            }) || croak "can't insert received message";
393    
394          my $m = new Email::Simple->new($message);          $this_received->dbi_commit;
395    
396            warn "inbox is not yet implemented";
397  }  }
398    
399    
# Line 298  Create new list Line 412  Create new list
412    
413  Returns C<Class::DBI> object for created list.  Returns C<Class::DBI> object for created list.
414    
415    C<email> address can be with domain or without it if your
416    MTA appends it. There is no checking for validity of your
417    list e-mail. Flexibility comes with resposibility, so please
418    feed correct (and configured) return addresses.
419    
420  =cut  =cut
421    
422  sub _add_list {  sub _add_list {
# Line 344  sub _get_list { Line 463  sub _get_list {
463          return $lists->search({ name => $name })->first;          return $lists->search({ name => $name })->first;
464  }  }
465    
466    ###
467    ### SOAP
468    ###
469    
470    package Nos::SOAP;
471    
472    =head1 SOAP methods
473    
474    This methods are thin wrappers to provide SOAP calls. They are grouped in
475    C<Nos::SOAP> package which is in same F<Nos.pm> module file.
476    
477    Usually, you want to use named variables in your SOAP calls if at all
478    possible.
479    
480    However, if you have broken SOAP library (like PHP SOAP class from PEAR)
481    you will want to use positional arguments (in same order as documented for
482    methods below).
483    
484    =cut
485    
486    my $nos;
487    
488    sub new {
489            my $class = shift;
490            my $self = {@_};
491            bless($self, $class);
492    
493            $nos = new Nos( @_ ) || die "can't create Nos object";
494    
495            $self ? return $self : return undef;
496    }
497    
498    
499    =head2 NewList
500    
501     $message_id = NewList(
502            list => 'My list',
503            email => 'my-list@example.com'
504     );
505    
506    =cut
507    
508    sub NewList {
509            my $self = shift;
510    
511            if ($_[0] !~ m/^HASH/) {
512                    return $nos->new_list(
513                            list => $_[0], email => $_[1],
514                    );
515            } else {
516                    return $nos->new_list( %{ shift @_ } );
517            }
518    }
519    
520    =head2 AddMemberToList
521    
522     $member_id = AddMemberToList(
523            list => "My list",
524            email => "e-mail@example.com",
525            name => "Full Name"
526     );
527    
528    =cut
529    
530    sub AddMemberToList {
531            my $self = shift;
532    
533            if ($_[0] !~ m/^HASH/) {
534                    return $nos->add_member_to_list(
535                            list => $_[0], email => $_[1], name => $_[2],
536                    );
537            } else {
538                    return $nos->add_member_to_list( %{ shift @_ } );
539            }
540    }
541    
542    =head2 AddMessageToList
543    
544     $message_id = AddMessageToList(
545            list => 'My list',
546            message => 'From: My list...'
547     );
548    
549    =cut
550    
551    sub AddMessageToList {
552            my $self = shift;
553    
554            if ($_[0] !~ m/^HASH/) {
555                    return $nos->add_message_to_list(
556                            list => $_[0], message => $_[1],
557                    );
558            } else {
559                    return $nos->add_message_to_list( %{ shift @_ } );
560            }
561    }
562    
563    
564    ###
565    
566  =head1 EXPORT  =head1 EXPORT
567    
# Line 369  at your option, any later version of Per Line 587  at your option, any later version of Per
587    
588    
589  =cut  =cut
590    
591    1;
Legend:
Removed from v.32  
changed lines
  Added in v.39
  ViewVC Help
Powered by ViewVC 1.1.26