/[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 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 236  sub send_queued_messages { Line 280  sub send_queued_messages {
280                                  print "=> $to_email\n";                                  print "=> $to_email\n";
281    
282                                  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;
283                                  my $auth = Email::Auth::AddressHash->new( $secret, 10 );                                  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    
# Line 254  sub send_queued_messages { Line 298  sub send_queued_messages {
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 269  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            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          my $m = new Email::Simple->new($message);          $this_received->dbi_commit;
389    
390            warn "inbox is not yet implemented";
391  }  }
392    
393    
Legend:
Removed from v.32  
changed lines
  Added in v.37
  ViewVC Help
Powered by ViewVC 1.1.26