notice-sender/trunk/Nos.pm

package Nos;

use 5.008;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw(
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw( 
);

our $VERSION = '0.3';

use Class::DBI::Loader;
use Email::Valid;
use Email::Send;
use Carp;
use Email::Auth::AddressHash;
use Email::Simple;
use Data::Dumper;

=head1 NAME

Nos - Notice Sender core module

=head1 SYNOPSIS

  use Nos;
  my $nos = new Nos();

=head1 DESCRIPTION

Core module for notice sender's functionality.

=head1 METHODS

=head2 new

Create new instance specifing database, user, password and options.

 my $nos = new Nos(
        dsn => 'dbi:Pg:dbname=notices',
        user => 'dpavlin',
        passwd => '',
        debug => 1,
        verbose => 1,
 );

=cut

sub new {
        my $class = shift;
        my $self = {@_};
        bless($self, $class);

        croak "need at least dsn" unless ($self->{'dsn'});

        $self->{'loader'} = Class::DBI::Loader->new(
                debug           => $self->{'debug'},
                dsn             => $self->{'dsn'},
                user            => $self->{'user'},
                password        => $self->{'passwd'},
                namespace       => "Nos",
#               additional_classes      => qw/Class::DBI::AbstractSearch/,
#               additional_base_classes => qw/My::Stuff/,
                relationships   => 1,
        ) || croak "can't init Class::DBI::Loader";

        $self ? return $self : return undef;
}


=head2 add_member_to_list

Add new member to list

 $nos->add_member_to_list(
        list => "My list",
        email => "john.doe@example.com",
        name => "John A. Doe",
 );

C<name> parametar is optional.

Return member ID if user is added.

=cut

sub add_member_to_list {
        my $self = shift;

        my $arg = {@_};

        my $email = $arg->{'email'} || croak "can't add user without e-mail";
        my $name = $arg->{'name'} || '';
        my $list_name = $arg->{'list'} || croak "need list name";

        my $list = $self->_get_list($list_name) || croak "list $list_name doesn't exist";

        if (! Email::Valid->address($email)) {
                carp "SKIPPING $name <$email>\n" if ($self->{'verbose'});
                return 0;
        }

        carp "# $name <$email>\n" if ($self->{'verbose'});

        my $users = $self->{'loader'}->find_class('users');
        my $user_list = $self->{'loader'}->find_class('user_list');

        my $this_user = $users->find_or_create({
                email => $email,
                full_name => $name,
        }) || croak "can't find or create member\n";

        my $user_on_list = $user_list->find_or_create({
                user_id => $this_user->id,
                list_id => $list->id,
        }) || croak "can't add user to list";

        $list->dbi_commit;
        $this_user->dbi_commit;
        $user_on_list->dbi_commit;

        return $this_user->id;
}

=head2 add_message_to_list

Adds message to one list's queue for later sending.

 $nos->add_message_to_list(
        list => 'My list',
        message => 'From: My list <mylist@example.com>
 To: John A. Doe <john.doe@example.com>
 
 This is example message
 ',
 );     

On success returns ID of newly created (or existing) message.

=cut

sub add_message_to_list {
        my $self = shift;

        my $args = {@_};

        my $list_name = $args->{'list'} || confess "need list name";
        my $message_text = $args->{'message'} || croak "need message";

        warn Dumper($message_text);

        my $m = Email::Simple->new($message_text) || croak "can't parse message";

        croak "message doesn't have Subject header\n" unless( $m->header('Subject') );

        my $lists = $self->{'loader'}->find_class('lists');

        my $this_list = $lists->search(
                name => $list_name,
        )->first || croak "can't find list $list_name";

        my $messages = $self->{'loader'}->find_class('messages');

        my $this_message = $messages->find_or_create({
                message => $message_text
        }) || croak "can't insert message";

        $this_message->dbi_commit() || croak "can't add message";

        my $queue = $self->{'loader'}->find_class('queue');

        $queue->find_or_create({
                message_id => $this_message->id,
                list_id => $this_list->id,
        }) || croak "can't add message ",$this_message->id," to list ",$this_list->id, ": ",$this_list->name;

        $queue->dbi_commit || croak "can't add message to list ",$this_list->name;

        return $this_message->id;
}


=head2 send_queued_messages

Send queued messages or just ones for selected list

 $nos->send_queued_messages("My list");

=cut

sub send_queued_messages {
        my $self = shift;

        my $list_name = shift;

        my $lists = $self->{'loader'}->find_class('lists');
        my $queue = $self->{'loader'}->find_class('queue');
        my $user_list = $self->{'loader'}->find_class('user_list');
        my $sent = $self->{'loader'}->find_class('sent');

        my $my_q;
        if ($list_name ne '') {
                my $l_id = $lists->search_like( name => $list_name )->first ||
                        croak "can't find list $list_name";
                $my_q = $queue->search_like( list_id => $l_id ) ||
                        croak "can't find list $list_name";
        } else {
                $my_q = $queue->retrieve_all;
        }

        while (my $m = $my_q->next) {
                next if ($m->all_sent);

                print "sending message ",$m->message_id," enqueued on ",$m->date," to list ",$m->list_id->name,"\n";
                my $msg = $m->message_id->message;

                my $auth = Email::Auth::AddressHash->new(
                        $m->list_id->name,      # secret
                        10,                     # hashlen
                );

                foreach my $u ($user_list->search(list_id => $m->list_id)) {

                        my $to_email = $u->user_id->email;

                        if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {
                                print "SKIP $to_email message allready sent\n";
                        } else {
                                print "\t$to_email\n";

                                my $hash = $auth->generate_hash( $to_email );

                                my $from = $u->list_id->name . " <" . $u->list_id->email . "+" . $hash . ">";
                                my $to = $u->user_id->full_name . " <$to_email>";

                                my $m = Email::Simple->new($msg) || croak "can't parse message";

                                print Dumper($m);

                                $m->header_set('From', $from) || croak "can't set From: header";
                                $m->header_set('To', $to) || croak "can't set To: header";

                                # FIXME do real sending :-)
                                send IO => $m->as_string;

                                $sent->create({
                                        message_id => $m->message_id,
                                        user_id => $u->user_id,
                                });
                                $sent->dbi_commit;
                        }
                }
                $m->all_sent(1);
                $m->update;
                $m->dbi_commit;
        }

}

=head2 inbox_message

Receive single message for list's inbox.

 my $ok = $nos->inbox_message($message);

=cut

sub inbox_message {
        my $self = shift;

        my $message = shift || return;

        my $m = new Email::Simple->new($message);

}


=head1 INTERNAL METHODS

Beware of dragons! You shouldn't need to call those methods directly.

=head2 _add_list

Create new list

 my $list_obj = $nos->_add_list(
        list => 'My list',
        email => 'my-list@example.com',
 );

Returns C<Class::DBI> object for created list.

=cut

sub _add_list {
        my $self = shift;

        my $arg = {@_};

        my $name = $arg->{'list'} || confess "can't add list without name";
        my $email = $arg->{'email'} || confess "can't add list without e-mail";

        my $lists = $self->{'loader'}->find_class('lists');

        my $l = $lists->find_or_create({
                name => $name,
                email => $email,
        });
        
        croak "can't add list $name\n" unless ($l);

        $l->dbi_commit;

        return $l;

}


=head2 _get_list

Get list C<Class::DBI> object.

 my $list_obj = $nos->check_list('My list');

Returns false on failure.

=cut

sub _get_list {
        my $self = shift;

        my $name = shift || return;

        my $lists = $self->{'loader'}->find_class('lists') || confess "can't find lists class";

        return $lists->search({ name => $name })->first;
}


=head1 EXPORT

Nothing.

=head1 SEE ALSO

mailman, ezmlm, sympa, L<Mail::Salsa>


=head1 AUTHOR

Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>


=head1 COPYRIGHT AND LICENSE

Copyright (C) 2005 by Dobrica Pavlinusic

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.4 or,
at your option, any later version of Perl 5 you may have available.


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