/[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

Annotation of /trunk/Nos.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 33 - (hide annotations)
Tue May 17 11:09:08 2005 UTC (18 years, 9 months ago) by dpavlin
File size: 8175 byte(s)
added new_list method, cleanus, e-mail is now unique for user, adding user with different full name will just update full name for that record.

1 dpavlin 20 package Nos;
2    
3     use 5.008;
4     use strict;
5     use warnings;
6    
7     require Exporter;
8    
9     our @ISA = qw(Exporter);
10    
11     our %EXPORT_TAGS = ( 'all' => [ qw(
12     ) ] );
13    
14     our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
15    
16     our @EXPORT = qw(
17     );
18    
19 dpavlin 29 our $VERSION = '0.3';
20 dpavlin 20
21     use Class::DBI::Loader;
22     use Email::Valid;
23     use Email::Send;
24     use Carp;
25 dpavlin 29 use Email::Auth::AddressHash;
26     use Email::Simple;
27     use Data::Dumper;
28 dpavlin 20
29     =head1 NAME
30    
31     Nos - Notice Sender core module
32    
33     =head1 SYNOPSIS
34    
35     use Nos;
36     my $nos = new Nos();
37    
38     =head1 DESCRIPTION
39    
40     Core module for notice sender's functionality.
41    
42     =head1 METHODS
43    
44     =head2 new
45    
46     Create new instance specifing database, user, password and options.
47    
48     my $nos = new Nos(
49     dsn => 'dbi:Pg:dbname=notices',
50     user => 'dpavlin',
51     passwd => '',
52     debug => 1,
53     verbose => 1,
54     );
55    
56     =cut
57    
58     sub new {
59     my $class = shift;
60     my $self = {@_};
61     bless($self, $class);
62    
63 dpavlin 22 croak "need at least dsn" unless ($self->{'dsn'});
64    
65 dpavlin 20 $self->{'loader'} = Class::DBI::Loader->new(
66     debug => $self->{'debug'},
67     dsn => $self->{'dsn'},
68     user => $self->{'user'},
69     password => $self->{'passwd'},
70     namespace => "Nos",
71     # additional_classes => qw/Class::DBI::AbstractSearch/,
72     # additional_base_classes => qw/My::Stuff/,
73     relationships => 1,
74 dpavlin 22 ) || croak "can't init Class::DBI::Loader";
75 dpavlin 20
76     $self ? return $self : return undef;
77     }
78    
79 dpavlin 30
80 dpavlin 33 =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 dpavlin 23 =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 dpavlin 27 Return member ID if user is added.
122 dpavlin 23
123     =cut
124    
125     sub add_member_to_list {
126     my $self = shift;
127    
128     my $arg = {@_};
129    
130 dpavlin 30 my $email = $arg->{'email'} || croak "can't add user without e-mail";
131 dpavlin 23 my $name = $arg->{'name'} || '';
132 dpavlin 30 my $list_name = $arg->{'list'} || croak "need list name";
133 dpavlin 23
134 dpavlin 30 my $list = $self->_get_list($list_name) || croak "list $list_name doesn't exist";
135    
136 dpavlin 23 if (! Email::Valid->address($email)) {
137 dpavlin 33 carp "SKIPPING $name <$email>\n";
138 dpavlin 23 return 0;
139     }
140    
141 dpavlin 29 carp "# $name <$email>\n" if ($self->{'verbose'});
142 dpavlin 23
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 dpavlin 33 if ($name && $this_user->full_name ne $name) {
151     $this_user->full_name($name || '');
152     $this_user->update;
153     }
154    
155 dpavlin 23 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 dpavlin 27 return $this_user->id;
165 dpavlin 23 }
166    
167 dpavlin 29 =head2 add_message_to_list
168 dpavlin 24
169     Adds message to one list's queue for later sending.
170    
171 dpavlin 29 $nos->add_message_to_list(
172 dpavlin 24 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 dpavlin 29 sub add_message_to_list {
185 dpavlin 24 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 dpavlin 29 my $m = Email::Simple->new($message_text) || croak "can't parse message";
193    
194 dpavlin 32 unless( $m->header('Subject') ) {
195     warn "message doesn't have Subject header\n";
196     return;
197     }
198 dpavlin 29
199 dpavlin 24 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 dpavlin 22 =head2 send_queued_messages
227 dpavlin 20
228 dpavlin 22 Send queued messages or just ones for selected list
229 dpavlin 20
230 dpavlin 24 $nos->send_queued_messages("My list");
231 dpavlin 20
232 dpavlin 21 =cut
233 dpavlin 20
234 dpavlin 22 sub send_queued_messages {
235 dpavlin 21 my $self = shift;
236 dpavlin 20
237 dpavlin 22 my $list_name = shift;
238 dpavlin 20
239 dpavlin 22 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 dpavlin 20
244 dpavlin 22 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 dpavlin 20
254 dpavlin 22 while (my $m = $my_q->next) {
255     next if ($m->all_sent);
256 dpavlin 20
257 dpavlin 22 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 dpavlin 20
260 dpavlin 22 foreach my $u ($user_list->search(list_id => $m->list_id)) {
261 dpavlin 20
262 dpavlin 29 my $to_email = $u->user_id->email;
263    
264 dpavlin 32 my ($from,$domain) = split(/@/, $u->list_id->email, 2);
265    
266 dpavlin 22 if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {
267 dpavlin 29 print "SKIP $to_email message allready sent\n";
268 dpavlin 22 } else {
269 dpavlin 32 print "=> $to_email\n";
270 dpavlin 20
271 dpavlin 32 my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id;
272     my $auth = Email::Auth::AddressHash->new( $secret, 10 );
273    
274 dpavlin 29 my $hash = $auth->generate_hash( $to_email );
275 dpavlin 20
276 dpavlin 32 my $from = $u->list_id->name . " <" . $from . "+" . $hash . ( $domain ? "@" . $domain : '' ). ">";
277 dpavlin 29 my $to = $u->user_id->full_name . " <$to_email>";
278    
279 dpavlin 32 my $m_obj = Email::Simple->new($msg) || croak "can't parse message";
280 dpavlin 29
281 dpavlin 32 $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 dpavlin 29
284 dpavlin 22 # FIXME do real sending :-)
285 dpavlin 32 send IO => $m_obj->as_string;
286 dpavlin 22
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 dpavlin 20 }
300    
301 dpavlin 29 =head2 inbox_message
302    
303     Receive single message for list's inbox.
304    
305     my $ok = $nos->inbox_message($message);
306    
307     =cut
308    
309     sub inbox_message {
310     my $self = shift;
311    
312     my $message = shift || return;
313    
314     my $m = new Email::Simple->new($message);
315    
316     }
317    
318    
319 dpavlin 30 =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    
359    
360     =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 dpavlin 31 my $lists = $self->{'loader'}->find_class('lists') || confess "can't find lists class";
376 dpavlin 30
377 dpavlin 31 return $lists->search({ name => $name })->first;
378 dpavlin 30 }
379    
380    
381 dpavlin 25 =head1 EXPORT
382 dpavlin 20
383 dpavlin 27 Nothing.
384 dpavlin 20
385     =head1 SEE ALSO
386    
387     mailman, ezmlm, sympa, L<Mail::Salsa>
388    
389 dpavlin 25
390 dpavlin 20 =head1 AUTHOR
391    
392     Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
393    
394 dpavlin 25
395 dpavlin 20 =head1 COPYRIGHT AND LICENSE
396    
397     Copyright (C) 2005 by Dobrica Pavlinusic
398    
399     This library is free software; you can redistribute it and/or modify
400     it under the same terms as Perl itself, either Perl version 5.8.4 or,
401     at your option, any later version of Perl 5 you may have available.
402    
403    
404     =cut

  ViewVC Help
Powered by ViewVC 1.1.26