/[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 24 by dpavlin, Sun May 15 22:30:54 2005 UTC revision 37 by dpavlin, Tue May 17 19:15:27 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.1';  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> 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 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
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 85  Add new member to list Line 126  Add new member to list
126    
127  C<name> parametar is optional.  C<name> parametar is optional.
128    
129  Return true if user is added.  Return member ID if user is added.
130    
131  =cut  =cut
132    
# Line 94  sub add_member_to_list { Line 135  sub add_member_to_list {
135    
136          my $arg = {@_};          my $arg = {@_};
137    
138          my $email = $arg->{'email'} || confess "can't add user without e-mail";          my $email = $arg->{'email'} || croak "can't add user without e-mail";
139          my $name = $arg->{'name'} || '';          my $name = $arg->{'name'} || '';
140          confess "need list name" unless ($arg->{'list'});          my $list_name = $arg->{'list'} || croak "need list name";
141    
142            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                  warn "SKIPPING $name <$email>";                  carp "SKIPPING $name <$email>\n";
146                  return 0;                  return 0;
147          }          }
148    
149          print "# $name <$email>\n";          carp "# $name <$email>\n" if ($self->{'verbose'});
150    
         my $lists = $self->{'loader'}->find_class('lists');  
151          my $users = $self->{'loader'}->find_class('users');          my $users = $self->{'loader'}->find_class('users');
152          my $user_list = $self->{'loader'}->find_class('user_list');          my $user_list = $self->{'loader'}->find_class('user_list');
153    
         my $list = $lists->find_or_create({  
                 name => $arg->{'list'},  
         }) || croak "can't add list ",$arg->{'list'},"\n";  
           
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 127  sub add_member_to_list { Line 169  sub add_member_to_list {
169          $this_user->dbi_commit;          $this_user->dbi_commit;
170          $user_on_list->dbi_commit;          $user_on_list->dbi_commit;
171    
172          return 1;          return $this_user->id;
173  }  }
174    
175  =head2 add_message_to_queue  =head2 add_message_to_list
176    
177  Adds message to one list's queue for later sending.  Adds message to one list's queue for later sending.
178    
179   $nos->add_message_to_queue(   $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 145  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_queue {  sub add_message_to_list {
196          my $self = shift;          my $self = shift;
197    
198          my $args = {@_};          my $args = {@_};
# Line 155  sub add_message_to_queue { Line 200  sub add_message_to_queue {
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    
203            my $m = Email::Simple->new($message_text) || croak "can't parse message";
204    
205            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    
212          my $this_list = $lists->search(          my $this_list = $lists->search(
# Line 218  sub send_queued_messages { Line 270  sub send_queued_messages {
270    
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;
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 ",$u->user_id->email," message allready sent\n";                                  print "SKIP $to_email message allready sent\n";
279                          } else {                          } else {
280                                  print "\t",$u->user_id->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 $hdr = "From: " . $u->list_id->name . " <" . $u->list_id->email . ">\n" .                                  my $hash = $auth->generate_hash( $to_email );
286                                          "To: " . $u->user_id->full_name . " <". $u->user_id->email. ">\n";  
287                                    my $from = $u->list_id->name . " <" . $from . "+" . $hash . ( $domain ? "@" . $domain : '' ). ">";
288                                    my $to = $u->user_id->full_name . " <$to_email>";
289    
290                                    my $m_obj = Email::Simple->new($msg) || croak "can't parse message";
291    
292                                    $m_obj->header_set('From', $from) || croak "can't set From: header";
293                                    $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 => "$hdr\n$msg";                                  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 243  sub send_queued_messages { Line 310  sub send_queued_messages {
310    
311  }  }
312    
313  =head2 EXPORT  =head2 inbox_message
314    
315    Receive single message for list's inbox.
316    
317     my $ok = $nos->inbox_message(
318            list => 'My list',
319            message => $message,
320     );
321    
322    =cut
323    
324    sub inbox_message {
325            my $self = shift;
326    
327            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            $this_received->dbi_commit;
389    
390            warn "inbox is not yet implemented";
391    }
392    
393    
394    =head1 INTERNAL METHODS
395    
396    Beware of dragons! You shouldn't need to call those methods directly.
397    
398    =head2 _add_list
399    
400    Create new list
401    
402     my $list_obj = $nos->_add_list(
403            list => 'My list',
404            email => 'my-list@example.com',
405     );
406    
407    Returns C<Class::DBI> object for created list.
408    
409    =cut
410    
411    sub _add_list {
412            my $self = shift;
413    
414            my $arg = {@_};
415    
416            my $name = $arg->{'list'} || confess "can't add list without name";
417            my $email = $arg->{'email'} || confess "can't add list without e-mail";
418    
419            my $lists = $self->{'loader'}->find_class('lists');
420    
421            my $l = $lists->find_or_create({
422                    name => $name,
423                    email => $email,
424            });
425            
426            croak "can't add list $name\n" unless ($l);
427    
428            $l->dbi_commit;
429    
430            return $l;
431    
432    }
433    
434    
435    =head2 _get_list
436    
437    Get list C<Class::DBI> object.
438    
439  None by default.   my $list_obj = $nos->check_list('My list');
440    
441    Returns false on failure.
442    
443    =cut
444    
445    sub _get_list {
446            my $self = shift;
447    
448            my $name = shift || return;
449    
450            my $lists = $self->{'loader'}->find_class('lists') || confess "can't find lists class";
451    
452            return $lists->search({ name => $name })->first;
453    }
454    
455    
456    =head1 EXPORT
457    
458    Nothing.
459    
460  =head1 SEE ALSO  =head1 SEE ALSO
461    
462  mailman, ezmlm, sympa, L<Mail::Salsa>  mailman, ezmlm, sympa, L<Mail::Salsa>
463    
464    
465  =head1 AUTHOR  =head1 AUTHOR
466    
467  Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>  Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
468    
469    
470  =head1 COPYRIGHT AND LICENSE  =head1 COPYRIGHT AND LICENSE
471    
472  Copyright (C) 2005 by Dobrica Pavlinusic  Copyright (C) 2005 by Dobrica Pavlinusic
Legend:
Removed from v.24  
changed lines
  Added in v.37
  ViewVC Help
Powered by ViewVC 1.1.26