/[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 29 - (hide annotations)
Mon May 16 20:58:44 2005 UTC (18 years, 9 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 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 23 =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 dpavlin 27 Return member ID if user is added.
92 dpavlin 23
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 dpavlin 29 carp "SKIPPING $name <$email>\n" if ($self->{'verbose'});
106 dpavlin 23 return 0;
107     }
108    
109 dpavlin 29 carp "# $name <$email>\n" if ($self->{'verbose'});
110 dpavlin 23
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 dpavlin 27 return $this_user->id;
134 dpavlin 23 }
135    
136 dpavlin 29 =head2 add_message_to_list
137 dpavlin 24
138     Adds message to one list's queue for later sending.
139    
140 dpavlin 29 $nos->add_message_to_list(
141 dpavlin 24 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 dpavlin 29 sub add_message_to_list {
154 dpavlin 24 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 dpavlin 29 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 dpavlin 24 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 dpavlin 22 =head2 send_queued_messages
195 dpavlin 20
196 dpavlin 22 Send queued messages or just ones for selected list
197 dpavlin 20
198 dpavlin 24 $nos->send_queued_messages("My list");
199 dpavlin 20
200 dpavlin 21 =cut
201 dpavlin 20
202 dpavlin 22 sub send_queued_messages {
203 dpavlin 21 my $self = shift;
204 dpavlin 20
205 dpavlin 22 my $list_name = shift;
206 dpavlin 20
207 dpavlin 22 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 dpavlin 20
212 dpavlin 22 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 dpavlin 20
222 dpavlin 22 while (my $m = $my_q->next) {
223     next if ($m->all_sent);
224 dpavlin 20
225 dpavlin 22 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 dpavlin 20
228 dpavlin 29 my $auth = Email::Auth::AddressHash->new(
229     $m->list_id->name, # secret
230     10, # hashlen
231     );
232    
233 dpavlin 22 foreach my $u ($user_list->search(list_id => $m->list_id)) {
234 dpavlin 20
235 dpavlin 29 my $to_email = $u->user_id->email;
236    
237 dpavlin 22 if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {
238 dpavlin 29 print "SKIP $to_email message allready sent\n";
239 dpavlin 22 } else {
240 dpavlin 29 print "\t$to_email\n";
241 dpavlin 20
242 dpavlin 29 my $hash = $auth->generate_hash( $to_email );
243 dpavlin 20
244 dpavlin 29 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 dpavlin 22 # FIXME do real sending :-)
255 dpavlin 29 send IO => $m->as_string;
256 dpavlin 22
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 dpavlin 20 }
270    
271 dpavlin 29 =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 dpavlin 25 =head1 EXPORT
290 dpavlin 20
291 dpavlin 27 Nothing.
292 dpavlin 20
293     =head1 SEE ALSO
294    
295     mailman, ezmlm, sympa, L<Mail::Salsa>
296    
297 dpavlin 25
298 dpavlin 20 =head1 AUTHOR
299    
300     Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
301    
302 dpavlin 25
303 dpavlin 20 =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