/[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 22 by dpavlin, Sun May 15 21:52:56 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
118    
119    Add new member to list
120    
121     $nos->add_member_to_list(
122            list => "My list",
123            email => "john.doe@example.com",
124            name => "John A. Doe",
125     );
126    
127    C<name> parametar is optional.
128    
129    Return member ID if user is added.
130    
131    =cut
132    
133    sub add_member_to_list {
134            my $self = shift;
135    
136            my $arg = {@_};
137    
138            my $email = $arg->{'email'} || croak "can't add user without e-mail";
139            my $name = $arg->{'name'} || '';
140            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)) {
145                    carp "SKIPPING $name <$email>\n";
146                    return 0;
147            }
148    
149            carp "# $name <$email>\n" if ($self->{'verbose'});
150    
151            my $users = $self->{'loader'}->find_class('users');
152            my $user_list = $self->{'loader'}->find_class('user_list');
153    
154            my $this_user = $users->find_or_create({
155                    email => $email,
156            }) || 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({
164                    user_id => $this_user->id,
165                    list_id => $list->id,
166            }) || croak "can't add user to list";
167    
168            $list->dbi_commit;
169            $this_user->dbi_commit;
170            $user_on_list->dbi_commit;
171    
172            return $this_user->id;
173    }
174    
175    =head2 add_message_to_list
176    
177    Adds message to one list's queue for later sending.
178    
179     $nos->add_message_to_list(
180            list => 'My list',
181            message => 'Subject: welcome to list
182    
183     This is example message
184     ',
185     );    
186    
187    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
194    
195    sub add_message_to_list {
196            my $self = shift;
197    
198            my $args = {@_};
199    
200            my $list_name = $args->{'list'} || confess "need list name";
201            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');
211    
212            my $this_list = $lists->search(
213                    name => $list_name,
214            )->first || croak "can't find list $list_name";
215    
216            my $messages = $self->{'loader'}->find_class('messages');
217    
218            my $this_message = $messages->find_or_create({
219                    message => $message_text
220            }) || croak "can't insert message";
221    
222            $this_message->dbi_commit() || croak "can't add message";
223    
224            my $queue = $self->{'loader'}->find_class('queue');
225    
226            $queue->find_or_create({
227                    message_id => $this_message->id,
228                    list_id => $this_list->id,
229            }) || croak "can't add message ",$this_message->id," to list ",$this_list->id, ": ",$this_list->name;
230    
231            $queue->dbi_commit || croak "can't add message to list ",$this_list->name;
232    
233            return $this_message->id;
234    }
235    
236    
237  =head2 send_queued_messages  =head2 send_queued_messages
238    
239  Send queued messages or just ones for selected list  Send queued messages or just ones for selected list
240    
241   $noc->send_queued_messages("my list");   $nos->send_queued_messages("My list");
242    
243  =cut  =cut
244    
# Line 109  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 134  sub send_queued_messages { Line 310  sub send_queued_messages {
310    
311  }  }
312    
313  =head2 EXPORT  =head2 inbox_message
314    
315  None by default.  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     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.22  
changed lines
  Added in v.37
  ViewVC Help
Powered by ViewVC 1.1.26