/[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 29 - (show annotations)
Mon May 16 20:58:44 2005 UTC (18 years, 10 months ago) by dpavlin
File size: 6636 byte(s)
attempt at validating queued mail messages, sending with unique hash,
documentation for inbox option (but not implementation),
renamed add_message_to_queue to add_message_to_list

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 =head2 add_member_to_list
80
81 Add new member to list
82
83 $nos->add_member_to_list(
84 list => "My list",
85 email => "john.doe@example.com",
86 name => "John A. Doe",
87 );
88
89 C<name> parametar is optional.
90
91 Return member ID if user is added.
92
93 =cut
94
95 sub add_member_to_list {
96 my $self = shift;
97
98 my $arg = {@_};
99
100 my $email = $arg->{'email'} || confess "can't add user without e-mail";
101 my $name = $arg->{'name'} || '';
102 confess "need list name" unless ($arg->{'list'});
103
104 if (! Email::Valid->address($email)) {
105 carp "SKIPPING $name <$email>\n" if ($self->{'verbose'});
106 return 0;
107 }
108
109 carp "# $name <$email>\n" if ($self->{'verbose'});
110
111 my $lists = $self->{'loader'}->find_class('lists');
112 my $users = $self->{'loader'}->find_class('users');
113 my $user_list = $self->{'loader'}->find_class('user_list');
114
115 my $list = $lists->find_or_create({
116 name => $arg->{'list'},
117 }) || croak "can't add list ",$arg->{'list'},"\n";
118
119 my $this_user = $users->find_or_create({
120 email => $email,
121 full_name => $name,
122 }) || croak "can't find or create member\n";
123
124 my $user_on_list = $user_list->find_or_create({
125 user_id => $this_user->id,
126 list_id => $list->id,
127 }) || croak "can't add user to list";
128
129 $list->dbi_commit;
130 $this_user->dbi_commit;
131 $user_on_list->dbi_commit;
132
133 return $this_user->id;
134 }
135
136 =head2 add_message_to_list
137
138 Adds message to one list's queue for later sending.
139
140 $nos->add_message_to_list(
141 list => 'My list',
142 message => 'From: My list <mylist@example.com>
143 To: John A. Doe <john.doe@example.com>
144
145 This is example message
146 ',
147 );
148
149 On success returns ID of newly created (or existing) message.
150
151 =cut
152
153 sub add_message_to_list {
154 my $self = shift;
155
156 my $args = {@_};
157
158 my $list_name = $args->{'list'} || confess "need list name";
159 my $message_text = $args->{'message'} || croak "need message";
160
161 warn Dumper($message_text);
162
163 my $m = Email::Simple->new($message_text) || croak "can't parse message";
164
165 croak "message doesn't have Subject header\n" unless( $m->header('Subject') );
166
167 my $lists = $self->{'loader'}->find_class('lists');
168
169 my $this_list = $lists->search(
170 name => $list_name,
171 )->first || croak "can't find list $list_name";
172
173 my $messages = $self->{'loader'}->find_class('messages');
174
175 my $this_message = $messages->find_or_create({
176 message => $message_text
177 }) || croak "can't insert message";
178
179 $this_message->dbi_commit() || croak "can't add message";
180
181 my $queue = $self->{'loader'}->find_class('queue');
182
183 $queue->find_or_create({
184 message_id => $this_message->id,
185 list_id => $this_list->id,
186 }) || croak "can't add message ",$this_message->id," to list ",$this_list->id, ": ",$this_list->name;
187
188 $queue->dbi_commit || croak "can't add message to list ",$this_list->name;
189
190 return $this_message->id;
191 }
192
193
194 =head2 send_queued_messages
195
196 Send queued messages or just ones for selected list
197
198 $nos->send_queued_messages("My list");
199
200 =cut
201
202 sub send_queued_messages {
203 my $self = shift;
204
205 my $list_name = shift;
206
207 my $lists = $self->{'loader'}->find_class('lists');
208 my $queue = $self->{'loader'}->find_class('queue');
209 my $user_list = $self->{'loader'}->find_class('user_list');
210 my $sent = $self->{'loader'}->find_class('sent');
211
212 my $my_q;
213 if ($list_name ne '') {
214 my $l_id = $lists->search_like( name => $list_name )->first ||
215 croak "can't find list $list_name";
216 $my_q = $queue->search_like( list_id => $l_id ) ||
217 croak "can't find list $list_name";
218 } else {
219 $my_q = $queue->retrieve_all;
220 }
221
222 while (my $m = $my_q->next) {
223 next if ($m->all_sent);
224
225 print "sending message ",$m->message_id," enqueued on ",$m->date," to list ",$m->list_id->name,"\n";
226 my $msg = $m->message_id->message;
227
228 my $auth = Email::Auth::AddressHash->new(
229 $m->list_id->name, # secret
230 10, # hashlen
231 );
232
233 foreach my $u ($user_list->search(list_id => $m->list_id)) {
234
235 my $to_email = $u->user_id->email;
236
237 if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {
238 print "SKIP $to_email message allready sent\n";
239 } else {
240 print "\t$to_email\n";
241
242 my $hash = $auth->generate_hash( $to_email );
243
244 my $from = $u->list_id->name . " <" . $u->list_id->email . "+" . $hash . ">";
245 my $to = $u->user_id->full_name . " <$to_email>";
246
247 my $m = Email::Simple->new($msg) || croak "can't parse message";
248
249 print Dumper($m);
250
251 $m->header_set('From', $from) || croak "can't set From: header";
252 $m->header_set('To', $to) || croak "can't set To: header";
253
254 # FIXME do real sending :-)
255 send IO => $m->as_string;
256
257 $sent->create({
258 message_id => $m->message_id,
259 user_id => $u->user_id,
260 });
261 $sent->dbi_commit;
262 }
263 }
264 $m->all_sent(1);
265 $m->update;
266 $m->dbi_commit;
267 }
268
269 }
270
271 =head2 inbox_message
272
273 Receive single message for list's inbox.
274
275 my $ok = $nos->inbox_message($message);
276
277 =cut
278
279 sub inbox_message {
280 my $self = shift;
281
282 my $message = shift || return;
283
284 my $m = new Email::Simple->new($message);
285
286 }
287
288
289 =head1 EXPORT
290
291 Nothing.
292
293 =head1 SEE ALSO
294
295 mailman, ezmlm, sympa, L<Mail::Salsa>
296
297
298 =head1 AUTHOR
299
300 Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
301
302
303 =head1 COPYRIGHT AND LICENSE
304
305 Copyright (C) 2005 by Dobrica Pavlinusic
306
307 This library is free software; you can redistribute it and/or modify
308 it under the same terms as Perl itself, either Perl version 5.8.4 or,
309 at your option, any later version of Perl 5 you may have available.
310
311
312 =cut

  ViewVC Help
Powered by ViewVC 1.1.26