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

  ViewVC Help
Powered by ViewVC 1.1.26