/[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 21 by dpavlin, Sun May 15 21:35:15 2005 UTC revision 33 by dpavlin, Tue May 17 11:09:08 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 Data::Dumper;
28    
29  =head1 NAME  =head1 NAME
30    
# Line 57  sub new { Line 60  sub new {
60          my $self = {@_};          my $self = {@_};
61          bless($self, $class);          bless($self, $class);
62    
63            croak "need at least dsn" unless ($self->{'dsn'});
64    
65          $self->{'loader'} = Class::DBI::Loader->new(          $self->{'loader'} = Class::DBI::Loader->new(
66                  debug           => $self->{'debug'},                  debug           => $self->{'debug'},
67                  dsn             => $self->{'dsn'},                  dsn             => $self->{'dsn'},
# Line 66  sub new { Line 71  sub new {
71  #               additional_classes      => qw/Class::DBI::AbstractSearch/,  #               additional_classes      => qw/Class::DBI::AbstractSearch/,
72  #               additional_base_classes => qw/My::Stuff/,  #               additional_base_classes => qw/My::Stuff/,
73                  relationships   => 1,                  relationships   => 1,
74          );          ) || croak "can't init Class::DBI::Loader";
75    
76          $self ? return $self : return undef;          $self ? return $self : return undef;
77  }  }
78    
 =head2 update_list_email  
79    
80  Update list e-mail address  =head2 new_list
81    
82    Create new list
83    
84     $nos->new_list(
85            list => 'My list",
86            email => 'my-list@example.com',
87     );
88    
89    Returns ID of newly created list.
90    
91    =cut
92    
93    sub new_list {
94            my $self = shift;
95    
96            my $arg = {@_};
97    
98            confess "need list name" unless ($arg->{'list'});
99            confess "need list email" unless ($arg->{'list'});
100    
101            my $l = $self->_get_list($arg->{'list'}) ||
102                    $self->_add_list( @_ ) ||
103                    return undef;
104    
105            return $l->id;
106    }
107    
108    
109    =head2 add_member_to_list
110    
111    Add new member to list
112    
113     $nos->add_member_to_list(
114            list => "My list",
115            email => "john.doe@example.com",
116            name => "John A. Doe",
117     );
118    
119    C<name> parametar is optional.
120    
121    Return member ID if user is added.
122    
123    =cut
124    
125    sub add_member_to_list {
126            my $self = shift;
127    
128            my $arg = {@_};
129    
130            my $email = $arg->{'email'} || croak "can't add user without e-mail";
131            my $name = $arg->{'name'} || '';
132            my $list_name = $arg->{'list'} || croak "need list name";
133    
134            my $list = $self->_get_list($list_name) || croak "list $list_name doesn't exist";
135    
136            if (! Email::Valid->address($email)) {
137                    carp "SKIPPING $name <$email>\n";
138                    return 0;
139            }
140    
141            carp "# $name <$email>\n" if ($self->{'verbose'});
142    
143            my $users = $self->{'loader'}->find_class('users');
144            my $user_list = $self->{'loader'}->find_class('user_list');
145    
146            my $this_user = $users->find_or_create({
147                    email => $email,
148            }) || croak "can't find or create member\n";
149    
150            if ($name && $this_user->full_name ne $name) {
151                    $this_user->full_name($name || '');
152                    $this_user->update;
153            }
154    
155            my $user_on_list = $user_list->find_or_create({
156                    user_id => $this_user->id,
157                    list_id => $list->id,
158            }) || croak "can't add user to list";
159    
160            $list->dbi_commit;
161            $this_user->dbi_commit;
162            $user_on_list->dbi_commit;
163    
164            return $this_user->id;
165    }
166    
167    =head2 add_message_to_list
168    
169    Adds message to one list's queue for later sending.
170    
171     $nos->add_message_to_list(
172            list => 'My list',
173            message => 'From: My list <mylist@example.com>
174     To: John A. Doe <john.doe@example.com>
175    
176     This is example message
177     ',
178     );    
179    
180    On success returns ID of newly created (or existing) message.
181    
182    =cut
183    
184    sub add_message_to_list {
185            my $self = shift;
186    
187            my $args = {@_};
188    
189            my $list_name = $args->{'list'} || confess "need list name";
190            my $message_text = $args->{'message'} || croak "need message";
191    
192            my $m = Email::Simple->new($message_text) || croak "can't parse message";
193    
194            unless( $m->header('Subject') ) {
195                    warn "message doesn't have Subject header\n";
196                    return;
197            }
198    
199            my $lists = $self->{'loader'}->find_class('lists');
200    
201            my $this_list = $lists->search(
202                    name => $list_name,
203            )->first || croak "can't find list $list_name";
204    
205            my $messages = $self->{'loader'}->find_class('messages');
206    
207            my $this_message = $messages->find_or_create({
208                    message => $message_text
209            }) || croak "can't insert message";
210    
211            $this_message->dbi_commit() || croak "can't add message";
212    
213            my $queue = $self->{'loader'}->find_class('queue');
214    
215            $queue->find_or_create({
216                    message_id => $this_message->id,
217                    list_id => $this_list->id,
218            }) || croak "can't add message ",$this_message->id," to list ",$this_list->id, ": ",$this_list->name;
219    
220            $queue->dbi_commit || croak "can't add message to list ",$this_list->name;
221    
222            return $this_message->id;
223    }
224    
225    
226    =head2 send_queued_messages
227    
228    Send queued messages or just ones for selected list
229    
230   $noc->update_list_email($list, 'foobar@example.com');   $nos->send_queued_messages("My list");
231    
232  =cut  =cut
233    
234  sub update_list_email {  sub send_queued_messages {
235          my $self = shift;          my $self = shift;
236    
237            my $list_name = shift;
238    
239            my $lists = $self->{'loader'}->find_class('lists');
240            my $queue = $self->{'loader'}->find_class('queue');
241            my $user_list = $self->{'loader'}->find_class('user_list');
242            my $sent = $self->{'loader'}->find_class('sent');
243    
244            my $my_q;
245            if ($list_name ne '') {
246                    my $l_id = $lists->search_like( name => $list_name )->first ||
247                            croak "can't find list $list_name";
248                    $my_q = $queue->search_like( list_id => $l_id ) ||
249                            croak "can't find list $list_name";
250            } else {
251                    $my_q = $queue->retrieve_all;
252            }
253    
254            while (my $m = $my_q->next) {
255                    next if ($m->all_sent);
256    
257                    print "sending message ",$m->message_id," enqueued on ",$m->date," to list ",$m->list_id->name,"\n";
258                    my $msg = $m->message_id->message;
259    
260                    foreach my $u ($user_list->search(list_id => $m->list_id)) {
261    
262                            my $to_email = $u->user_id->email;
263    
264                            my ($from,$domain) = split(/@/, $u->list_id->email, 2);
265    
266                            if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {
267                                    print "SKIP $to_email message allready sent\n";
268                            } else {
269                                    print "=> $to_email\n";
270    
271                                    my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id;
272                                    my $auth = Email::Auth::AddressHash->new( $secret, 10 );
273    
274                                    my $hash = $auth->generate_hash( $to_email );
275    
276                                    my $from = $u->list_id->name . " <" . $from . "+" . $hash . ( $domain ? "@" . $domain : '' ). ">";
277                                    my $to = $u->user_id->full_name . " <$to_email>";
278    
279                                    my $m_obj = Email::Simple->new($msg) || croak "can't parse message";
280    
281                                    $m_obj->header_set('From', $from) || croak "can't set From: header";
282                                    $m_obj->header_set('To', $to) || croak "can't set To: header";
283    
284                                    # FIXME do real sending :-)
285                                    send IO => $m_obj->as_string;
286    
287                                    $sent->create({
288                                            message_id => $m->message_id,
289                                            user_id => $u->user_id,
290                                    });
291                                    $sent->dbi_commit;
292                            }
293                    }
294                    $m->all_sent(1);
295                    $m->update;
296                    $m->dbi_commit;
297            }
298    
299  }  }
300    
301  =head2 send  =head2 inbox_message
302    
303  Send a message using configured mailer.  Receive single message for list's inbox.
304    
305   $nos->send("message with headers");   my $ok = $nos->inbox_message($message);
306    
307  =cut  =cut
308    
309  sub send_email {  sub inbox_message {
310          my $self = shift;          my $self = shift;
311    
312          my $message = shift || return;          my $message = shift || return;
313    
314          send IO => $message;          my $m = new Email::Simple->new($message);
315    
316    }
317    
318    
319    =head1 INTERNAL METHODS
320    
321    Beware of dragons! You shouldn't need to call those methods directly.
322    
323    =head2 _add_list
324    
325    Create new list
326    
327     my $list_obj = $nos->_add_list(
328            list => 'My list',
329            email => 'my-list@example.com',
330     );
331    
332    Returns C<Class::DBI> object for created list.
333    
334    =cut
335    
336    sub _add_list {
337            my $self = shift;
338    
339            my $arg = {@_};
340    
341            my $name = $arg->{'list'} || confess "can't add list without name";
342            my $email = $arg->{'email'} || confess "can't add list without e-mail";
343    
344            my $lists = $self->{'loader'}->find_class('lists');
345    
346            my $l = $lists->find_or_create({
347                    name => $name,
348                    email => $email,
349            });
350            
351            croak "can't add list $name\n" unless ($l);
352    
353            $l->dbi_commit;
354    
355            return $l;
356    
357  }  }
358    
 =head2 EXPORT  
359    
360  None by default.  =head2 _get_list
361    
362    Get list C<Class::DBI> object.
363    
364     my $list_obj = $nos->check_list('My list');
365    
366    Returns false on failure.
367    
368    =cut
369    
370    sub _get_list {
371            my $self = shift;
372    
373            my $name = shift || return;
374    
375            my $lists = $self->{'loader'}->find_class('lists') || confess "can't find lists class";
376    
377            return $lists->search({ name => $name })->first;
378    }
379    
380    
381    =head1 EXPORT
382    
383    Nothing.
384    
385  =head1 SEE ALSO  =head1 SEE ALSO
386    
387  mailman, ezmlm, sympa, L<Mail::Salsa>  mailman, ezmlm, sympa, L<Mail::Salsa>
388    
389    
390  =head1 AUTHOR  =head1 AUTHOR
391    
392  Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>  Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
393    
394    
395  =head1 COPYRIGHT AND LICENSE  =head1 COPYRIGHT AND LICENSE
396    
397  Copyright (C) 2005 by Dobrica Pavlinusic  Copyright (C) 2005 by Dobrica Pavlinusic
Legend:
Removed from v.21  
changed lines
  Added in v.33
  ViewVC Help
Powered by ViewVC 1.1.26