/[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 27 by dpavlin, Mon May 16 16:25:14 2005 UTC revision 38 by dpavlin, Tue May 17 21:37:06 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.2';  our $VERSION = '0.3';
20    
21  use Class::DBI::Loader;  use Class::DBI::Loader;
22  use Email::Valid;  use Email::Valid;
23  use Email::Send;  use Email::Send;
24  use Carp;  use Carp;
25    use Email::Auth::AddressHash;
26    use Email::Simple;
27    use Email::Address;
28    use Mail::DeliveryStatus::BounceParser;
29    use Data::Dumper;
30    
31  =head1 NAME  =head1 NAME
32    
# Line 48  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 70  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 94  sub add_member_to_list { Line 138  sub add_member_to_list {
138    
139          my $arg = {@_};          my $arg = {@_};
140    
141          my $email = $arg->{'email'} || confess "can't add user without e-mail";          my $email = $arg->{'email'} || croak "can't add user without e-mail";
142          my $name = $arg->{'name'} || '';          my $name = $arg->{'name'} || '';
143          confess "need list name" unless ($arg->{'list'});          my $list_name = $arg->{'list'} || croak "need list name";
144    
145            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                  warn "SKIPPING $name <$email>";                  carp "SKIPPING $name <$email>\n";
149                  return 0;                  return 0;
150          }          }
151    
152          print STDERR "# $name <$email>\n";          carp "# $name <$email>\n" if ($self->{'verbose'});
153    
         my $lists = $self->{'loader'}->find_class('lists');  
154          my $users = $self->{'loader'}->find_class('users');          my $users = $self->{'loader'}->find_class('users');
155          my $user_list = $self->{'loader'}->find_class('user_list');          my $user_list = $self->{'loader'}->find_class('user_list');
156    
         my $list = $lists->find_or_create({  
                 name => $arg->{'list'},  
         }) || croak "can't add list ",$arg->{'list'},"\n";  
           
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 130  sub add_member_to_list { Line 175  sub add_member_to_list {
175          return $this_user->id;          return $this_user->id;
176  }  }
177    
178  =head2 add_message_to_queue  =head2 add_message_to_list
179    
180  Adds message to one list's queue for later sending.  Adds message to one list's queue for later sending.
181    
182   $nos->add_message_to_queue(   $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_queue {  sub add_message_to_list {
199          my $self = shift;          my $self = shift;
200    
201          my $args = {@_};          my $args = {@_};
# Line 155  sub add_message_to_queue { Line 203  sub add_message_to_queue {
203          my $list_name = $args->{'list'} || confess "need list name";          my $list_name = $args->{'list'} || confess "need list name";
204          my $message_text = $args->{'message'} || croak "need message";          my $message_text = $args->{'message'} || croak "need message";
205    
206            my $m = Email::Simple->new($message_text) || croak "can't parse message";
207    
208            unless( $m->header('Subject') ) {
209                    warn "message doesn't have Subject header\n";
210                    return;
211            }
212    
213          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
214    
215          my $this_list = $lists->search(          my $this_list = $lists->search(
# Line 218  sub send_queued_messages { Line 273  sub send_queued_messages {
273    
274                  foreach my $u ($user_list->search(list_id => $m->list_id)) {                  foreach my $u ($user_list->search(list_id => $m->list_id)) {
275    
276                            my $to_email = $u->user_id->email;
277    
278                            my ($from,$domain) = split(/@/, $u->list_id->email, 2);
279    
280                          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 )) {
281                                  print "SKIP ",$u->user_id->email," message allready sent\n";                                  print "SKIP $to_email message allready sent\n";
282                          } else {                          } else {
283                                  print "\t",$u->user_id->email,"\n";                                  print "=> $to_email\n";
284    
285                                    my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id;
286                                    my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} );
287    
288                                    my $hash = $auth->generate_hash( $to_email );
289    
290                                    my $from = $u->list_id->name . " <" . $from . "+" . $hash . ( $domain ? "@" . $domain : '' ). ">";
291                                    my $to = $u->user_id->full_name . " <$to_email>";
292    
293                                  my $hdr = "From: " . $u->list_id->name . " <" . $u->list_id->email . ">\n" .                                  my $m_obj = Email::Simple->new($msg) || croak "can't parse message";
294                                          "To: " . $u->user_id->full_name . " <". $u->user_id->email. ">\n";  
295                                    $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";
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 => "$hdr\n$msg";                                  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 243  sub send_queued_messages { Line 316  sub send_queued_messages {
316    
317  }  }
318    
319    =head2 inbox_message
320    
321    Receive single message for list's inbox.
322    
323     my $ok = $nos->inbox_message(
324            list => 'My list',
325            message => $message,
326     );
327    
328    =cut
329    
330    sub inbox_message {
331            my $self = shift;
332    
333            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            $this_received->dbi_commit;
395    
396            warn "inbox is not yet implemented";
397    }
398    
399    
400    =head1 INTERNAL METHODS
401    
402    Beware of dragons! You shouldn't need to call those methods directly.
403    
404    =head2 _add_list
405    
406    Create new list
407    
408     my $list_obj = $nos->_add_list(
409            list => 'My list',
410            email => 'my-list@example.com',
411     );
412    
413    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
421    
422    sub _add_list {
423            my $self = shift;
424    
425            my $arg = {@_};
426    
427            my $name = $arg->{'list'} || confess "can't add list without name";
428            my $email = $arg->{'email'} || confess "can't add list without e-mail";
429    
430            my $lists = $self->{'loader'}->find_class('lists');
431    
432            my $l = $lists->find_or_create({
433                    name => $name,
434                    email => $email,
435            });
436            
437            croak "can't add list $name\n" unless ($l);
438    
439            $l->dbi_commit;
440    
441            return $l;
442    
443    }
444    
445    
446    =head2 _get_list
447    
448    Get list C<Class::DBI> object.
449    
450     my $list_obj = $nos->check_list('My list');
451    
452    Returns false on failure.
453    
454    =cut
455    
456    sub _get_list {
457            my $self = shift;
458    
459            my $name = shift || return;
460    
461            my $lists = $self->{'loader'}->find_class('lists') || confess "can't find lists class";
462    
463            return $lists->search({ name => $name })->first;
464    }
465    
466    
467  =head1 EXPORT  =head1 EXPORT
468    
469  Nothing.  Nothing.
Legend:
Removed from v.27  
changed lines
  Added in v.38
  ViewVC Help
Powered by ViewVC 1.1.26