/[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 25 - (show annotations)
Mon May 16 13:52:43 2005 UTC (18 years, 9 months ago) by dpavlin
File size: 5893 byte(s)
added SOAP server and example (non-working) client

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 add_member_to_list
13 add_message_to_queue
14 ) ] );
15
16 our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
17
18 our @EXPORT = qw(
19 );
20
21 our $VERSION = '0.1';
22
23 use Class::DBI::Loader;
24 use Email::Valid;
25 use Email::Send;
26 use Carp;
27
28 =head1 NAME
29
30 Nos - Notice Sender core module
31
32 =head1 SYNOPSIS
33
34 use Nos;
35 my $nos = new Nos();
36
37 =head1 DESCRIPTION
38
39 Core module for notice sender's functionality.
40
41 =head1 METHODS
42
43 =head2 new
44
45 Create new instance specifing database, user, password and options.
46
47 my $nos = new Nos(
48 dsn => 'dbi:Pg:dbname=notices',
49 user => 'dpavlin',
50 passwd => '',
51 debug => 1,
52 verbose => 1,
53 );
54
55 =cut
56
57 sub new {
58 my $class = shift;
59 my $self = {@_};
60 bless($self, $class);
61
62 croak "need at least dsn" unless ($self->{'dsn'});
63
64 $self->{'loader'} = Class::DBI::Loader->new(
65 debug => $self->{'debug'},
66 dsn => $self->{'dsn'},
67 user => $self->{'user'},
68 password => $self->{'passwd'},
69 namespace => "Nos",
70 # additional_classes => qw/Class::DBI::AbstractSearch/,
71 # additional_base_classes => qw/My::Stuff/,
72 relationships => 1,
73 ) || croak "can't init Class::DBI::Loader";
74
75 $self ? return $self : return undef;
76 }
77
78 =head2 add_member_to_list
79
80 Add new member to list
81
82 $nos->add_member_to_list(
83 list => "My list",
84 email => "john.doe@example.com",
85 name => "John A. Doe",
86 );
87
88 C<name> parametar is optional.
89
90 Return true if user is added.
91
92 =cut
93
94 sub add_member_to_list {
95 my $self = shift;
96
97 my $arg = {@_};
98
99 my $email = $arg->{'email'} || confess "can't add user without e-mail";
100 my $name = $arg->{'name'} || '';
101 confess "need list name" unless ($arg->{'list'});
102
103 if (! Email::Valid->address($email)) {
104 warn "SKIPPING $name <$email>";
105 return 0;
106 }
107
108 print "# $name <$email>\n";
109
110 my $lists = $self->{'loader'}->find_class('lists');
111 my $users = $self->{'loader'}->find_class('users');
112 my $user_list = $self->{'loader'}->find_class('user_list');
113
114 my $list = $lists->find_or_create({
115 name => $arg->{'list'},
116 }) || croak "can't add list ",$arg->{'list'},"\n";
117
118 my $this_user = $users->find_or_create({
119 email => $email,
120 full_name => $name,
121 }) || croak "can't find or create member\n";
122
123 my $user_on_list = $user_list->find_or_create({
124 user_id => $this_user->id,
125 list_id => $list->id,
126 }) || croak "can't add user to list";
127
128 $list->dbi_commit;
129 $this_user->dbi_commit;
130 $user_on_list->dbi_commit;
131
132 return 1;
133 }
134
135 =head2 add_message_to_queue
136
137 Adds message to one list's queue for later sending.
138
139 $nos->add_message_to_queue(
140 list => 'My list',
141 message => 'From: My list <mylist@example.com>
142 To: John A. Doe <john.doe@example.com>
143
144 This is example message
145 ',
146 );
147
148 On success returns ID of newly created (or existing) message.
149
150 =cut
151
152 sub add_message_to_queue {
153 my $self = shift;
154
155 my $args = {@_};
156
157 my $list_name = $args->{'list'} || confess "need list name";
158 my $message_text = $args->{'message'} || croak "need message";
159
160 my $lists = $self->{'loader'}->find_class('lists');
161
162 my $this_list = $lists->search(
163 name => $list_name,
164 )->first || croak "can't find list $list_name";
165
166 my $messages = $self->{'loader'}->find_class('messages');
167
168 my $this_message = $messages->find_or_create({
169 message => $message_text
170 }) || croak "can't insert message";
171
172 $this_message->dbi_commit() || croak "can't add message";
173
174 my $queue = $self->{'loader'}->find_class('queue');
175
176 $queue->find_or_create({
177 message_id => $this_message->id,
178 list_id => $this_list->id,
179 }) || croak "can't add message ",$this_message->id," to list ",$this_list->id, ": ",$this_list->name;
180
181 $queue->dbi_commit || croak "can't add message to list ",$this_list->name;
182
183 return $this_message->id;
184 }
185
186
187 =head2 send_queued_messages
188
189 Send queued messages or just ones for selected list
190
191 $nos->send_queued_messages("My list");
192
193 =cut
194
195 sub send_queued_messages {
196 my $self = shift;
197
198 my $list_name = shift;
199
200 my $lists = $self->{'loader'}->find_class('lists');
201 my $queue = $self->{'loader'}->find_class('queue');
202 my $user_list = $self->{'loader'}->find_class('user_list');
203 my $sent = $self->{'loader'}->find_class('sent');
204
205 my $my_q;
206 if ($list_name ne '') {
207 my $l_id = $lists->search_like( name => $list_name )->first ||
208 croak "can't find list $list_name";
209 $my_q = $queue->search_like( list_id => $l_id ) ||
210 croak "can't find list $list_name";
211 } else {
212 $my_q = $queue->retrieve_all;
213 }
214
215 while (my $m = $my_q->next) {
216 next if ($m->all_sent);
217
218 print "sending message ",$m->message_id," enqueued on ",$m->date," to list ",$m->list_id->name,"\n";
219 my $msg = $m->message_id->message;
220
221 foreach my $u ($user_list->search(list_id => $m->list_id)) {
222
223 if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {
224 print "SKIP ",$u->user_id->email," message allready sent\n";
225 } else {
226 print "\t",$u->user_id->email,"\n";
227
228 my $hdr = "From: " . $u->list_id->name . " <" . $u->list_id->email . ">\n" .
229 "To: " . $u->user_id->full_name . " <". $u->user_id->email. ">\n";
230
231 # FIXME do real sending :-)
232 send IO => "$hdr\n$msg";
233
234 $sent->create({
235 message_id => $m->message_id,
236 user_id => $u->user_id,
237 });
238 $sent->dbi_commit;
239 }
240 }
241 $m->all_sent(1);
242 $m->update;
243 $m->dbi_commit;
244 }
245
246 }
247
248 =head1 EXPORT
249
250 Exported methods are also available using SOAP interface. For now, those are:
251
252 =over 4
253
254 =item add_member_to_list
255
256 =item add_message_to_queue
257
258 =back
259
260
261 =head1 SEE ALSO
262
263 mailman, ezmlm, sympa, L<Mail::Salsa>
264
265
266 =head1 AUTHOR
267
268 Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
269
270
271 =head1 COPYRIGHT AND LICENSE
272
273 Copyright (C) 2005 by Dobrica Pavlinusic
274
275 This library is free software; you can redistribute it and/or modify
276 it under the same terms as Perl itself, either Perl version 5.8.4 or,
277 at your option, any later version of Perl 5 you may have available.
278
279
280 =cut

  ViewVC Help
Powered by ViewVC 1.1.26