/[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 33 by dpavlin, Tue May 17 11:09:08 2005 UTC revision 38 by dpavlin, Tue May 17 21:37:06 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  =head2 new_list
89    
90  Create new list  Create new list. Required arguments are name of C<list> and
91    C<email> address.
92    
93   $nos->new_list(   $nos->new_list(
94          list => 'My list",          list => 'My list',
95          email => 'my-list@example.com',          email => 'my-list@example.com',
96   );   );
97    
98  Returns ID of newly created list.  Returns ID of newly created list.
99    
100    Calls internally L<_add_list>, see details there.
101    
102  =cut  =cut
103    
104  sub new_list {  sub new_list {
# Line 170  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 269  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 281  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 302  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 $m = new Email::Simple->new($message);          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            $this_received->dbi_commit;
395    
396            warn "inbox is not yet implemented";
397  }  }
398    
399    
# Line 331  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 {
Legend:
Removed from v.33  
changed lines
  Added in v.38
  ViewVC Help
Powered by ViewVC 1.1.26