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(
        add_member_to_list
        add_message_to_queue
) ] );

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

our @EXPORT = qw( 
);

our $VERSION = '0.1';

use Class::DBI::Loader;
use Email::Valid;
use Email::Send;
use Carp;

=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 true if user is added.

=cut

sub add_member_to_list {
        my $self = shift;

        my $arg = {@_};

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

        if (! Email::Valid->address($email)) {
                warn "SKIPPING $name <$email>";
                return 0;
        }

        print "# $name <$email>\n";

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

        my $list = $lists->find_or_create({
                name => $arg->{'list'},
        }) || croak "can't add list ",$arg->{'list'},"\n";
        
        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 1;
}

=head2 add_message_to_queue

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

 $nos->add_message_to_queue(
        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_queue {
        my $self = shift;

        my $args = {@_};

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

        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;

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

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

                                my $hdr = "From: " . $u->list_id->name . " <" . $u->list_id->email . ">\n" .
                                        "To: " . $u->user_id->full_name . " <". $u->user_id->email. ">\n";

                                # FIXME do real sending :-)
                                send IO => "$hdr\n$msg";

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

}

=head1 EXPORT

Exported methods are also available using SOAP interface. For now, those are:

=over 4

=item add_member_to_list

=item add_message_to_queue

=back


=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	dpavlin	25	add_member_to_list
13			add_message_to_queue
14	dpavlin	20	) ] );
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	dpavlin	22	croak "need at least dsn" unless ($self->{'dsn'});
63
64	dpavlin	20	$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	dpavlin	22	) \|\| croak "can't init Class::DBI::Loader";
74	dpavlin	20
75			$self ? return $self : return undef;
76			}
77
78	dpavlin	23	=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	dpavlin	24	=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	dpavlin	22	=head2 send_queued_messages
188	dpavlin	20
189	dpavlin	22	Send queued messages or just ones for selected list
190	dpavlin	20
191	dpavlin	24	$nos->send_queued_messages("My list");
192	dpavlin	20
193	dpavlin	21	=cut
194	dpavlin	20
195	dpavlin	22	sub send_queued_messages {
196	dpavlin	21	my $self = shift;
197	dpavlin	20
198	dpavlin	22	my $list_name = shift;
199	dpavlin	20
200	dpavlin	22	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	dpavlin	20
205	dpavlin	22	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	dpavlin	20
215	dpavlin	22	while (my $m = $my_q->next) {
216			next if ($m->all_sent);
217	dpavlin	20
218	dpavlin	22	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	dpavlin	20
221	dpavlin	22	foreach my $u ($user_list->search(list_id => $m->list_id)) {
222	dpavlin	20
223	dpavlin	22	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	dpavlin	20
228	dpavlin	22	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	dpavlin	20
231	dpavlin	22	# 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	dpavlin	20	}
247
248	dpavlin	25	=head1 EXPORT
249	dpavlin	20
250	dpavlin	25	Exported methods are also available using SOAP interface. For now, those are:
251	dpavlin	20
252	dpavlin	25	=over 4
253
254			=item add_member_to_list
255
256			=item add_message_to_queue
257
258			=back
259
260
261	dpavlin	20	=head1 SEE ALSO
262
263			mailman, ezmlm, sympa, L<Mail::Salsa>
264
265	dpavlin	25
266	dpavlin	20	=head1 AUTHOR
267
268			Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
269
270	dpavlin	25
271	dpavlin	20	=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