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 Email::Address;
use Mail::DeliveryStatus::BounceParser;
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,
        hash_len => 8,
 );

Parametar C<hash_len> defines length of hash which will be added to each
outgoing e-mail message to ensure that replies can be linked with sent e-mails.

=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->{'hash_len'} ||= 8;

        $self ? return $self : return undef;
}


=head2 new_list

Create new list. Required arguments are name of C<list> and
C<email> address.

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

Returns ID of newly created list.

Calls internally L<_add_list>, see details there.

=cut

sub new_list {
        my $self = shift;

        my $arg = {@_};

        confess "need list name" unless ($arg->{'list'});
        confess "need list email" unless ($arg->{'list'});

        my $l = $self->_get_list($arg->{'list'}) ||
                $self->_add_list( @_ ) ||
                return undef;

        return $l->id;
}


=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";
                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,
        }) || croak "can't find or create member\n";

        if ($name && $this_user->full_name ne $name) {
                $this_user->full_name($name || '');
                $this_user->update;
        }

        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 => 'Subject: welcome to list

 This is example message
 ',
 );     

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

Only required header in e-mail is C<Subject:>. C<From:> and C<To:> headers
will be automatically generated, but if you want to use own headers, just
include them in messages.

=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";

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

        unless( $m->header('Subject') ) {
                warn "message doesn't have Subject header\n";
                return;
        }

        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)) {

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

                        my ($from,$domain) = split(/@/, $u->list_id->email, 2);

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

                                my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id;
                                my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} );

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

                                my $from = $u->list_id->name . " <" . $from . "+" . $hash . ( $domain ? "@" . $domain : '' ). ">";
                                my $to = $u->user_id->full_name . " <$to_email>";

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

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

                                $m_obj->header_set('X-Nos-Version', $VERSION);
                                $m_obj->header_set('X-Nos-Hash', $hash);

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

                                $sent->create({
                                        message_id => $m->message_id,
                                        user_id => $u->user_id,
                                        hash => $hash,
                                });
                                $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(
        list => 'My list',
        message => $message,
 );

=cut

sub inbox_message {
        my $self = shift;

        my $arg = {@_};

        return unless ($arg->{'message'});
        croak "need list name" unless ($arg->{'list'});

        my $this_list = $self->_get_list($arg->{'list'}) || croak "can't find list ".$arg->{'list'}."\n";

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

        my $to = $m->header('To') || die "can't find To: address in incomming message\n";

        my @addrs = Email::Address->parse( $to );

        die "can't parse To: $to address\n" unless (@addrs);

        my $hl = $self->{'hash_len'} || confess "no hash_len?";

        my $hash;

        foreach my $a (@addrs) {
                if ($a->address =~ m/\+([a-f0-9]{$hl})@/) {
                        $hash = $1;
                        last;
                }
        }

        croak "can't find hash in e-mail $to\n" unless ($hash);

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

        # will use null if no matching message_id is found
        my $sent_msg = $sent->search( hash => $hash )->first;

        my ($message_id, $user_id) = (undef, undef);    # init with NULL

        if ($sent_msg) {
                $message_id = $sent_msg->message_id || carp "no message_id";
                $user_id = $sent_msg->user_id || carp "no user_id";
        }

print "message_id: ",($message_id || "not found"),"\n";

        my $is_bounce = 0;

        my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(
                $arg->{'message'}, { report_non_bounces=>1 },
        ) };
        carp "can't check if this message is bounce!" if ($@);

        $is_bounce++ if ($bounce && $bounce->is_bounce);

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

        my $this_received = $received->find_or_create({
                user_id => $user_id,
                list_id => $this_list->id,
                message_id => $message_id,
                message => $arg->{'message'},
                bounced => $is_bounce,
        }) || croak "can't insert received message";

        $this_received->dbi_commit;

        warn "inbox is not yet implemented";
}


=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.

C<email> address can be with domain or without it if your
MTA appends it. There is no checking for validity of your
list e-mail. Flexibility comes with resposibility, so please
feed correct (and configured) return addresses.

=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	dpavlin	36	use Email::Address;
28	dpavlin	37	use Mail::DeliveryStatus::BounceParser;
29	dpavlin	29	use Data::Dumper;
30	dpavlin	20
31			=head1 NAME
32
33			Nos - Notice Sender core module
34
35			=head1 SYNOPSIS
36
37			use Nos;
38			my $nos = new Nos();
39
40			=head1 DESCRIPTION
41
42			Core module for notice sender's functionality.
43
44			=head1 METHODS
45
46			=head2 new
47
48			Create new instance specifing database, user, password and options.
49
50			my $nos = new Nos(
51			dsn => 'dbi:Pg:dbname=notices',
52			user => 'dpavlin',
53			passwd => '',
54			debug => 1,
55			verbose => 1,
56	dpavlin	36	hash_len => 8,
57	dpavlin	20	);
58
59	dpavlin	38	Parametar C<hash_len> defines length of hash which will be added to each
60			outgoing e-mail message to ensure that replies can be linked with sent e-mails.
61	dpavlin	36
62	dpavlin	20	=cut
63
64			sub new {
65			my $class = shift;
66			my $self = {@_};
67			bless($self, $class);
68
69	dpavlin	22	croak "need at least dsn" unless ($self->{'dsn'});
70
71	dpavlin	20	$self->{'loader'} = Class::DBI::Loader->new(
72			debug => $self->{'debug'},
73			dsn => $self->{'dsn'},
74			user => $self->{'user'},
75			password => $self->{'passwd'},
76			namespace => "Nos",
77			# additional_classes => qw/Class::DBI::AbstractSearch/,
78			# additional_base_classes => qw/My::Stuff/,
79			relationships => 1,
80	dpavlin	22	) \|\| croak "can't init Class::DBI::Loader";
81	dpavlin	20
82	dpavlin	36	$self->{'hash_len'} \|\|= 8;
83
84	dpavlin	20	$self ? return $self : return undef;
85			}
86
87	dpavlin	30
88	dpavlin	33	=head2 new_list
89
90	dpavlin	38	Create new list. Required arguments are name of C<list> and
91			C<email> address.
92	dpavlin	33
93			$nos->new_list(
94	dpavlin	38	list => 'My list',
95	dpavlin	33	email => 'my-list@example.com',
96			);
97
98			Returns ID of newly created list.
99
100	dpavlin	38	Calls internally L<_add_list>, see details there.
101
102	dpavlin	33	=cut
103
104			sub new_list {
105			my $self = shift;
106
107			my $arg = {@_};
108
109			confess "need list name" unless ($arg->{'list'});
110			confess "need list email" unless ($arg->{'list'});
111
112			my $l = $self->_get_list($arg->{'list'}) \|\|
113			$self->_add_list( @_ ) \|\|
114			return undef;
115
116			return $l->id;
117			}
118
119
120	dpavlin	23	=head2 add_member_to_list
121
122			Add new member to list
123
124			$nos->add_member_to_list(
125			list => "My list",
126			email => "john.doe@example.com",
127			name => "John A. Doe",
128			);
129
130			C<name> parametar is optional.
131
132	dpavlin	27	Return member ID if user is added.
133	dpavlin	23
134			=cut
135
136			sub add_member_to_list {
137			my $self = shift;
138
139			my $arg = {@_};
140
141	dpavlin	30	my $email = $arg->{'email'} \|\| croak "can't add user without e-mail";
142	dpavlin	23	my $name = $arg->{'name'} \|\| '';
143	dpavlin	30	my $list_name = $arg->{'list'} \|\| croak "need list name";
144	dpavlin	23
145	dpavlin	30	my $list = $self->_get_list($list_name) \|\| croak "list $list_name doesn't exist";
146
147	dpavlin	23	if (! Email::Valid->address($email)) {
148	dpavlin	33	carp "SKIPPING $name <$email>\n";
149	dpavlin	23	return 0;
150			}
151
152	dpavlin	29	carp "# $name <$email>\n" if ($self->{'verbose'});
153	dpavlin	23
154			my $users = $self->{'loader'}->find_class('users');
155			my $user_list = $self->{'loader'}->find_class('user_list');
156
157			my $this_user = $users->find_or_create({
158			email => $email,
159			}) \|\| croak "can't find or create member\n";
160
161	dpavlin	33	if ($name && $this_user->full_name ne $name) {
162			$this_user->full_name($name \|\| '');
163			$this_user->update;
164			}
165
166	dpavlin	23	my $user_on_list = $user_list->find_or_create({
167			user_id => $this_user->id,
168			list_id => $list->id,
169			}) \|\| croak "can't add user to list";
170
171			$list->dbi_commit;
172			$this_user->dbi_commit;
173			$user_on_list->dbi_commit;
174
175	dpavlin	27	return $this_user->id;
176	dpavlin	23	}
177
178	dpavlin	29	=head2 add_message_to_list
179	dpavlin	24
180			Adds message to one list's queue for later sending.
181
182	dpavlin	29	$nos->add_message_to_list(
183	dpavlin	24	list => 'My list',
184	dpavlin	36	message => 'Subject: welcome to list
185	dpavlin	38
186	dpavlin	24	This is example message
187			',
188			);
189
190			On success returns ID of newly created (or existing) message.
191
192	dpavlin	36	Only required header in e-mail is C<Subject:>. C<From:> and C<To:> headers
193			will be automatically generated, but if you want to use own headers, just
194			include them in messages.
195
196	dpavlin	24	=cut
197
198	dpavlin	29	sub add_message_to_list {
199	dpavlin	24	my $self = shift;
200
201			my $args = {@_};
202
203			my $list_name = $args->{'list'} \|\| confess "need list name";
204			my $message_text = $args->{'message'} \|\| croak "need message";
205
206	dpavlin	29	my $m = Email::Simple->new($message_text) \|\| croak "can't parse message";
207
208	dpavlin	32	unless( $m->header('Subject') ) {
209			warn "message doesn't have Subject header\n";
210			return;
211			}
212	dpavlin	29
213	dpavlin	24	my $lists = $self->{'loader'}->find_class('lists');
214
215			my $this_list = $lists->search(
216			name => $list_name,
217			)->first \|\| croak "can't find list $list_name";
218
219			my $messages = $self->{'loader'}->find_class('messages');
220
221			my $this_message = $messages->find_or_create({
222			message => $message_text
223			}) \|\| croak "can't insert message";
224
225			$this_message->dbi_commit() \|\| croak "can't add message";
226
227			my $queue = $self->{'loader'}->find_class('queue');
228
229			$queue->find_or_create({
230			message_id => $this_message->id,
231			list_id => $this_list->id,
232			}) \|\| croak "can't add message ",$this_message->id," to list ",$this_list->id, ": ",$this_list->name;
233
234			$queue->dbi_commit \|\| croak "can't add message to list ",$this_list->name;
235
236			return $this_message->id;
237			}
238
239
240	dpavlin	22	=head2 send_queued_messages
241	dpavlin	20
242	dpavlin	22	Send queued messages or just ones for selected list
243	dpavlin	20
244	dpavlin	24	$nos->send_queued_messages("My list");
245	dpavlin	20
246	dpavlin	21	=cut
247	dpavlin	20
248	dpavlin	22	sub send_queued_messages {
249	dpavlin	21	my $self = shift;
250	dpavlin	20
251	dpavlin	22	my $list_name = shift;
252	dpavlin	20
253	dpavlin	22	my $lists = $self->{'loader'}->find_class('lists');
254			my $queue = $self->{'loader'}->find_class('queue');
255			my $user_list = $self->{'loader'}->find_class('user_list');
256			my $sent = $self->{'loader'}->find_class('sent');
257	dpavlin	20
258	dpavlin	22	my $my_q;
259			if ($list_name ne '') {
260			my $l_id = $lists->search_like( name => $list_name )->first \|\|
261			croak "can't find list $list_name";
262			$my_q = $queue->search_like( list_id => $l_id ) \|\|
263			croak "can't find list $list_name";
264			} else {
265			$my_q = $queue->retrieve_all;
266			}
267	dpavlin	20
268	dpavlin	22	while (my $m = $my_q->next) {
269			next if ($m->all_sent);
270	dpavlin	20
271	dpavlin	22	print "sending message ",$m->message_id," enqueued on ",$m->date," to list ",$m->list_id->name,"\n";
272			my $msg = $m->message_id->message;
273	dpavlin	20
274	dpavlin	22	foreach my $u ($user_list->search(list_id => $m->list_id)) {
275	dpavlin	20
276	dpavlin	29	my $to_email = $u->user_id->email;
277
278	dpavlin	32	my ($from,$domain) = split(/@/, $u->list_id->email, 2);
279
280	dpavlin	22	if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {
281	dpavlin	29	print "SKIP $to_email message allready sent\n";
282	dpavlin	22	} else {
283	dpavlin	32	print "=> $to_email\n";
284	dpavlin	20
285	dpavlin	32	my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id;
286	dpavlin	36	my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} );
287	dpavlin	32
288	dpavlin	29	my $hash = $auth->generate_hash( $to_email );
289	dpavlin	20
290	dpavlin	32	my $from = $u->list_id->name . " <" . $from . "+" . $hash . ( $domain ? "@" . $domain : '' ). ">";
291	dpavlin	29	my $to = $u->user_id->full_name . " <$to_email>";
292
293	dpavlin	32	my $m_obj = Email::Simple->new($msg) \|\| croak "can't parse message";
294	dpavlin	29
295	dpavlin	32	$m_obj->header_set('From', $from) \|\| croak "can't set From: header";
296			$m_obj->header_set('To', $to) \|\| croak "can't set To: header";
297	dpavlin	29
298	dpavlin	38	$m_obj->header_set('X-Nos-Version', $VERSION);
299			$m_obj->header_set('X-Nos-Hash', $hash);
300
301	dpavlin	22	# FIXME do real sending :-)
302	dpavlin	32	send IO => $m_obj->as_string;
303	dpavlin	22
304			$sent->create({
305			message_id => $m->message_id,
306			user_id => $u->user_id,
307	dpavlin	36	hash => $hash,
308	dpavlin	22	});
309			$sent->dbi_commit;
310			}
311			}
312			$m->all_sent(1);
313			$m->update;
314			$m->dbi_commit;
315			}
316
317	dpavlin	20	}
318
319	dpavlin	29	=head2 inbox_message
320
321			Receive single message for list's inbox.
322
323	dpavlin	36	my $ok = $nos->inbox_message(
324			list => 'My list',
325			message => $message,
326			);
327	dpavlin	29
328			=cut
329
330			sub inbox_message {
331			my $self = shift;
332
333	dpavlin	36	my $arg = {@_};
334	dpavlin	29
335	dpavlin	36	return unless ($arg->{'message'});
336			croak "need list name" unless ($arg->{'list'});
337	dpavlin	29
338	dpavlin	37	my $this_list = $self->_get_list($arg->{'list'}) \|\| croak "can't find list ".$arg->{'list'}."\n";
339
340	dpavlin	36	my $m = Email::Simple->new($arg->{'message'}) \|\| croak "can't parse message";
341
342			my $to = $m->header('To') \|\| die "can't find To: address in incomming message\n";
343
344			my @addrs = Email::Address->parse( $to );
345
346			die "can't parse To: $to address\n" unless (@addrs);
347
348			my $hl = $self->{'hash_len'} \|\| confess "no hash_len?";
349
350			my $hash;
351
352			foreach my $a (@addrs) {
353			if ($a->address =~ m/\+([a-f0-9]{$hl})@/) {
354			$hash = $1;
355			last;
356			}
357			}
358
359			croak "can't find hash in e-mail $to\n" unless ($hash);
360
361			my $sent = $self->{'loader'}->find_class('sent');
362
363			# will use null if no matching message_id is found
364	dpavlin	37	my $sent_msg = $sent->search( hash => $hash )->first;
365	dpavlin	36
366	dpavlin	37	my ($message_id, $user_id) = (undef, undef); # init with NULL
367	dpavlin	36
368	dpavlin	37	if ($sent_msg) {
369			$message_id = $sent_msg->message_id \|\| carp "no message_id";
370			$user_id = $sent_msg->user_id \|\| carp "no user_id";
371			}
372
373			print "message_id: ",($message_id \|\| "not found"),"\n";
374
375			my $is_bounce = 0;
376
377			my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(
378			$arg->{'message'}, { report_non_bounces=>1 },
379			) };
380			carp "can't check if this message is bounce!" if ($@);
381
382			$is_bounce++ if ($bounce && $bounce->is_bounce);
383
384			my $received = $self->{'loader'}->find_class('received');
385
386			my $this_received = $received->find_or_create({
387			user_id => $user_id,
388			list_id => $this_list->id,
389			message_id => $message_id,
390			message => $arg->{'message'},
391			bounced => $is_bounce,
392			}) \|\| croak "can't insert received message";
393
394			$this_received->dbi_commit;
395
396	dpavlin	36	warn "inbox is not yet implemented";
397	dpavlin	29	}
398
399
400	dpavlin	30	=head1 INTERNAL METHODS
401
402			Beware of dragons! You shouldn't need to call those methods directly.
403
404			=head2 _add_list
405
406			Create new list
407
408			my $list_obj = $nos->_add_list(
409			list => 'My list',
410			email => 'my-list@example.com',
411			);
412
413			Returns C<Class::DBI> object for created list.
414
415	dpavlin	38	C<email> address can be with domain or without it if your
416			MTA appends it. There is no checking for validity of your
417			list e-mail. Flexibility comes with resposibility, so please
418			feed correct (and configured) return addresses.
419
420	dpavlin	30	=cut
421
422			sub _add_list {
423			my $self = shift;
424
425			my $arg = {@_};
426
427			my $name = $arg->{'list'} \|\| confess "can't add list without name";
428			my $email = $arg->{'email'} \|\| confess "can't add list without e-mail";
429
430			my $lists = $self->{'loader'}->find_class('lists');
431
432			my $l = $lists->find_or_create({
433			name => $name,
434			email => $email,
435			});
436
437			croak "can't add list $name\n" unless ($l);
438
439			$l->dbi_commit;
440
441			return $l;
442
443			}
444
445
446			=head2 _get_list
447
448			Get list C<Class::DBI> object.
449
450			my $list_obj = $nos->check_list('My list');
451
452			Returns false on failure.
453
454			=cut
455
456			sub _get_list {
457			my $self = shift;
458
459			my $name = shift \|\| return;
460
461	dpavlin	31	my $lists = $self->{'loader'}->find_class('lists') \|\| confess "can't find lists class";
462	dpavlin	30
463	dpavlin	31	return $lists->search({ name => $name })->first;
464	dpavlin	30	}
465
466
467	dpavlin	25	=head1 EXPORT
468	dpavlin	20
469	dpavlin	27	Nothing.
470	dpavlin	20
471			=head1 SEE ALSO
472
473			mailman, ezmlm, sympa, L<Mail::Salsa>
474
475	dpavlin	25
476	dpavlin	20	=head1 AUTHOR
477
478			Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
479
480	dpavlin	25
481	dpavlin	20	=head1 COPYRIGHT AND LICENSE
482
483			Copyright (C) 2005 by Dobrica Pavlinusic
484
485			This library is free software; you can redistribute it and/or modify
486			it under the same terms as Perl itself, either Perl version 5.8.4 or,
487			at your option, any later version of Perl 5 you may have available.
488
489
490			=cut