/[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 37 by dpavlin, Tue May 17 19:15:27 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> defined length of hash which will be added to each
60    outgoing e-mail message.
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
91    
92     $nos->new_list(
93            list => 'My list",
94            email => 'my-list@example.com',
95     );
96    
97    Returns ID of newly created list.
98    
99    =cut
100    
101    sub new_list {
102            my $self = shift;
103    
104            my $arg = {@_};
105    
106            confess "need list name" unless ($arg->{'list'});
107            confess "need list email" unless ($arg->{'list'});
108    
109            my $l = $self->_get_list($arg->{'list'}) ||
110                    $self->_add_list( @_ ) ||
111                    return undef;
112    
113            return $l->id;
114    }
115    
116    
117  =head2 add_member_to_list  =head2 add_member_to_list
118    
119  Add new member to list  Add new member to list
# Line 105  sub add_member_to_list { Line 142  sub add_member_to_list {
142          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";
143    
144          if (! Email::Valid->address($email)) {          if (! Email::Valid->address($email)) {
145                  carp "SKIPPING $name <$email>\n" if ($self->{'verbose'});                  carp "SKIPPING $name <$email>\n";
146                  return 0;                  return 0;
147          }          }
148    
# Line 116  sub add_member_to_list { Line 153  sub add_member_to_list {
153    
154          my $this_user = $users->find_or_create({          my $this_user = $users->find_or_create({
155                  email => $email,                  email => $email,
                 full_name => $name,  
156          }) || croak "can't find or create member\n";          }) || croak "can't find or create member\n";
157    
158            if ($name && $this_user->full_name ne $name) {
159                    $this_user->full_name($name || '');
160                    $this_user->update;
161            }
162    
163          my $user_on_list = $user_list->find_or_create({          my $user_on_list = $user_list->find_or_create({
164                  user_id => $this_user->id,                  user_id => $this_user->id,
165                  list_id => $list->id,                  list_id => $list->id,
# Line 137  Adds message to one list's queue for lat Line 178  Adds message to one list's queue for lat
178    
179   $nos->add_message_to_list(   $nos->add_message_to_list(
180          list => 'My list',          list => 'My list',
181          message => 'From: My list <mylist@example.com>          message => 'Subject: welcome to list
  To: John A. Doe <john.doe@example.com>  
182    
183   This is example message   This is example message
184   ',   ',
# Line 146  Adds message to one list's queue for lat Line 186  Adds message to one list's queue for lat
186    
187  On success returns ID of newly created (or existing) message.  On success returns ID of newly created (or existing) message.
188    
189    Only required header in e-mail is C<Subject:>. C<From:> and C<To:> headers
190    will be automatically generated, but if you want to use own headers, just
191    include them in messages.
192    
193  =cut  =cut
194    
195  sub add_message_to_list {  sub add_message_to_list {
# Line 156  sub add_message_to_list { Line 200  sub add_message_to_list {
200          my $list_name = $args->{'list'} || confess "need list name";          my $list_name = $args->{'list'} || confess "need list name";
201          my $message_text = $args->{'message'} || croak "need message";          my $message_text = $args->{'message'} || croak "need message";
202    
         warn Dumper($message_text);  
   
203          my $m = Email::Simple->new($message_text) || croak "can't parse message";          my $m = Email::Simple->new($message_text) || croak "can't parse message";
204    
205          croak "message doesn't have Subject header\n" unless( $m->header('Subject') );          unless( $m->header('Subject') ) {
206                    warn "message doesn't have Subject header\n";
207                    return;
208            }
209    
210          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
211    
# Line 223  sub send_queued_messages { Line 268  sub send_queued_messages {
268                  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";
269                  my $msg = $m->message_id->message;                  my $msg = $m->message_id->message;
270    
                 my $auth = Email::Auth::AddressHash->new(  
                         $m->list_id->name,      # secret  
                         10,                     # hashlen  
                 );  
   
271                  foreach my $u ($user_list->search(list_id => $m->list_id)) {                  foreach my $u ($user_list->search(list_id => $m->list_id)) {
272    
273                          my $to_email = $u->user_id->email;                          my $to_email = $u->user_id->email;
274    
275                            my ($from,$domain) = split(/@/, $u->list_id->email, 2);
276    
277                          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 )) {
278                                  print "SKIP $to_email message allready sent\n";                                  print "SKIP $to_email message allready sent\n";
279                          } else {                          } else {
280                                  print "\t$to_email\n";                                  print "=> $to_email\n";
281    
282                                    my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id;
283                                    my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} );
284    
285                                  my $hash = $auth->generate_hash( $to_email );                                  my $hash = $auth->generate_hash( $to_email );
286    
287                                  my $from = $u->list_id->name . " <" . $u->list_id->email . "+" . $hash . ">";                                  my $from = $u->list_id->name . " <" . $from . "+" . $hash . ( $domain ? "@" . $domain : '' ). ">";
288                                  my $to = $u->user_id->full_name . " <$to_email>";                                  my $to = $u->user_id->full_name . " <$to_email>";
289    
290                                  my $m = Email::Simple->new($msg) || croak "can't parse message";                                  my $m_obj = Email::Simple->new($msg) || croak "can't parse message";
   
                                 print Dumper($m);  
291    
292                                  $m->header_set('From', $from) || croak "can't set From: header";                                  $m_obj->header_set('From', $from) || croak "can't set From: header";
293                                  $m->header_set('To', $to) || croak "can't set To: header";                                  $m_obj->header_set('To', $to) || croak "can't set To: header";
294    
295                                  # FIXME do real sending :-)                                  # FIXME do real sending :-)
296                                  send IO => $m->as_string;                                  send IO => $m_obj->as_string;
297    
298                                  $sent->create({                                  $sent->create({
299                                          message_id => $m->message_id,                                          message_id => $m->message_id,
300                                          user_id => $u->user_id,                                          user_id => $u->user_id,
301                                            hash => $hash,
302                                  });                                  });
303                                  $sent->dbi_commit;                                  $sent->dbi_commit;
304                          }                          }
# Line 270  sub send_queued_messages { Line 314  sub send_queued_messages {
314    
315  Receive single message for list's inbox.  Receive single message for list's inbox.
316    
317   my $ok = $nos->inbox_message($message);   my $ok = $nos->inbox_message(
318            list => 'My list',
319            message => $message,
320     );
321    
322  =cut  =cut
323    
324  sub inbox_message {  sub inbox_message {
325          my $self = shift;          my $self = shift;
326    
327          my $message = shift || return;          my $arg = {@_};
328    
329            return unless ($arg->{'message'});
330            croak "need list name" unless ($arg->{'list'});
331    
332            my $this_list = $self->_get_list($arg->{'list'}) || croak "can't find list ".$arg->{'list'}."\n";
333    
334            my $m = Email::Simple->new($arg->{'message'}) || croak "can't parse message";
335    
336            my $to = $m->header('To') || die "can't find To: address in incomming message\n";
337    
338            my @addrs = Email::Address->parse( $to );
339    
340          my $m = new Email::Simple->new($message);          die "can't parse To: $to address\n" unless (@addrs);
341    
342            my $hl = $self->{'hash_len'} || confess "no hash_len?";
343    
344            my $hash;
345    
346            foreach my $a (@addrs) {
347                    if ($a->address =~ m/\+([a-f0-9]{$hl})@/) {
348                            $hash = $1;
349                            last;
350                    }
351            }
352    
353            croak "can't find hash in e-mail $to\n" unless ($hash);
354    
355            my $sent = $self->{'loader'}->find_class('sent');
356    
357            # will use null if no matching message_id is found
358            my $sent_msg = $sent->search( hash => $hash )->first;
359    
360            my ($message_id, $user_id) = (undef, undef);    # init with NULL
361    
362            if ($sent_msg) {
363                    $message_id = $sent_msg->message_id || carp "no message_id";
364                    $user_id = $sent_msg->user_id || carp "no user_id";
365            }
366    
367    print "message_id: ",($message_id || "not found"),"\n";
368    
369            my $is_bounce = 0;
370    
371            my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(
372                    $arg->{'message'}, { report_non_bounces=>1 },
373            ) };
374            carp "can't check if this message is bounce!" if ($@);
375    
376            $is_bounce++ if ($bounce && $bounce->is_bounce);
377    
378            my $received = $self->{'loader'}->find_class('received');
379    
380            my $this_received = $received->find_or_create({
381                    user_id => $user_id,
382                    list_id => $this_list->id,
383                    message_id => $message_id,
384                    message => $arg->{'message'},
385                    bounced => $is_bounce,
386            }) || croak "can't insert received message";
387    
388            $this_received->dbi_commit;
389    
390            warn "inbox is not yet implemented";
391  }  }
392    
393    
# Line 340  sub _get_list { Line 447  sub _get_list {
447    
448          my $name = shift || return;          my $name = shift || return;
449    
450          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists') || confess "can't find lists class";
451    
452          return $lists->search({ name => $name });          return $lists->search({ name => $name })->first;
453  }  }
454    
455    
Legend:
Removed from v.30  
changed lines
  Added in v.37
  ViewVC Help
Powered by ViewVC 1.1.26