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

Contents of /trunk/Nos.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 33 - (show 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 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 our $VERSION = '0.3';
20
21 use Class::DBI::Loader;
22 use Email::Valid;
23 use Email::Send;
24 use Carp;
25 use Email::Auth::AddressHash;
26 use Email::Simple;
27 use Data::Dumper;
28
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 croak "need at least dsn" unless ($self->{'dsn'});
64
65 $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 ) || croak "can't init Class::DBI::Loader";
75
76 $self ? return $self : return undef;
77 }
78
79
80 =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 $nos->send_queued_messages("My list");
231
232 =cut
233
234 sub send_queued_messages {
235 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 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 =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 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
386
387 mailman, ezmlm, sympa, L<Mail::Salsa>
388
389
390 =head1 AUTHOR
391
392 Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
393
394
395 =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