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;
}

###
### SOAP
###

package Nos::SOAP;

=head1 SOAP methods

This methods are thin wrappers to provide SOAP calls. They are grouped in
C<Nos::SOAP> package which is in same F<Nos.pm> module file.

Usually, you want to use named variables in your SOAP calls if at all
possible.

However, if you have broken SOAP library (like PHP SOAP class from PEAR)
you will want to use positional arguments (in same order as documented for
methods below).

=cut

my $nos;

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

        $nos = new Nos( @_ ) || die "can't create Nos object";

        $self ? return $self : return undef;
}


=head2 NewList

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

=cut

sub NewList {
        my $self = shift;

        if ($_[0] !~ m/^HASH/) {
                return $nos->new_list(
                        list => $_[0], email => $_[1],
                );
        } else {
                return $nos->new_list( %{ shift @_ } );
        }
}

=head2 AddMemberToList

 $member_id = AddMemberToList(
        list => "My list",
        email => "e-mail@example.com",
        name => "Full Name"
 );

=cut

sub AddMemberToList {
        my $self = shift;

        if ($_[0] !~ m/^HASH/) {
                return $nos->add_member_to_list(
                        list => $_[0], email => $_[1], name => $_[2],
                );
        } else {
                return $nos->add_member_to_list( %{ shift @_ } );
        }
}

=head2 AddMessageToList

 $message_id = AddMessageToList(
        list => 'My list',
        message => 'From: My list...'
 ); 

=cut

sub AddMessageToList {
        my $self = shift;

        if ($_[0] !~ m/^HASH/) {
                return $nos->add_message_to_list(
                        list => $_[0], message => $_[1],
                );
        } else {
                return $nos->add_message_to_list( %{ shift @_ } );
        }
}


###

=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;
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.3';
20
21	use Class::DBI::Loader;
22	use Email::Valid;
23	use Email::Send;
24	use Carp;
25	use Email::Auth::AddressHash;
26	use Email::Simple;
27	use Email::Address;
28	use Mail::DeliveryStatus::BounceParser;
29	use Data::Dumper;
30
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	hash_len => 8,
57	);
58
59	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
62	=cut
63
64	sub new {
65	my $class = shift;
66	my $self = {@_};
67	bless($self, $class);
68
69	croak "need at least dsn" unless ($self->{'dsn'});
70
71	$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	) \|\| croak "can't init Class::DBI::Loader";
81
82	$self->{'hash_len'} \|\|= 8;
83
84	$self ? return $self : return undef;
85	}
86
87
88	=head2 new_list
89
90	Create new list. Required arguments are name of C<list> and
91	C<email> address.
92
93	$nos->new_list(
94	list => 'My list',
95	email => 'my-list@example.com',
96	);
97
98	Returns ID of newly created list.
99
100	Calls internally L<_add_list>, see details there.
101
102	=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	=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	Return member ID if user is added.
133
134	=cut
135
136	sub add_member_to_list {
137	my $self = shift;
138
139	my $arg = {@_};
140
141	my $email = $arg->{'email'} \|\| croak "can't add user without e-mail";
142	my $name = $arg->{'name'} \|\| '';
143	my $list_name = $arg->{'list'} \|\| croak "need list name";
144
145	my $list = $self->_get_list($list_name) \|\| croak "list $list_name doesn't exist";
146
147	if (! Email::Valid->address($email)) {
148	carp "SKIPPING $name <$email>\n";
149	return 0;
150	}
151
152	carp "# $name <$email>\n" if ($self->{'verbose'});
153
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	if ($name && $this_user->full_name ne $name) {
162	$this_user->full_name($name \|\| '');
163	$this_user->update;
164	}
165
166	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	return $this_user->id;
176	}
177
178	=head2 add_message_to_list
179
180	Adds message to one list's queue for later sending.
181
182	$nos->add_message_to_list(
183	list => 'My list',
184	message => 'Subject: welcome to list
185
186	This is example message
187	',
188	);
189
190	On success returns ID of newly created (or existing) message.
191
192	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	=cut
197
198	sub add_message_to_list {
199	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	my $m = Email::Simple->new($message_text) \|\| croak "can't parse message";
207
208	unless( $m->header('Subject') ) {
209	warn "message doesn't have Subject header\n";
210	return;
211	}
212
213	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	=head2 send_queued_messages
241
242	Send queued messages or just ones for selected list
243
244	$nos->send_queued_messages("My list");
245
246	=cut
247
248	sub send_queued_messages {
249	my $self = shift;
250
251	my $list_name = shift;
252
253	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
258	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
268	while (my $m = $my_q->next) {
269	next if ($m->all_sent);
270
271	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
274	foreach my $u ($user_list->search(list_id => $m->list_id)) {
275
276	my $to_email = $u->user_id->email;
277
278	my ($from,$domain) = split(/@/, $u->list_id->email, 2);
279
280	if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {
281	print "SKIP $to_email message allready sent\n";
282	} else {
283	print "=> $to_email\n";
284
285	my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id;
286	my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} );
287
288	my $hash = $auth->generate_hash( $to_email );
289
290	my $from = $u->list_id->name . " <" . $from . "+" . $hash . ( $domain ? "@" . $domain : '' ). ">";
291	my $to = $u->user_id->full_name . " <$to_email>";
292
293	my $m_obj = Email::Simple->new($msg) \|\| croak "can't parse message";
294
295	$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
298	$m_obj->header_set('X-Nos-Version', $VERSION);
299	$m_obj->header_set('X-Nos-Hash', $hash);
300
301	# FIXME do real sending :-)
302	send IO => $m_obj->as_string;
303
304	$sent->create({
305	message_id => $m->message_id,
306	user_id => $u->user_id,
307	hash => $hash,
308	});
309	$sent->dbi_commit;
310	}
311	}
312	$m->all_sent(1);
313	$m->update;
314	$m->dbi_commit;
315	}
316
317	}
318
319	=head2 inbox_message
320
321	Receive single message for list's inbox.
322
323	my $ok = $nos->inbox_message(
324	list => 'My list',
325	message => $message,
326	);
327
328	=cut
329
330	sub inbox_message {
331	my $self = shift;
332
333	my $arg = {@_};
334
335	return unless ($arg->{'message'});
336	croak "need list name" unless ($arg->{'list'});
337
338	my $this_list = $self->_get_list($arg->{'list'}) \|\| croak "can't find list ".$arg->{'list'}."\n";
339
340	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	my $sent_msg = $sent->search( hash => $hash )->first;
365
366	my ($message_id, $user_id) = (undef, undef); # init with NULL
367
368	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	warn "inbox is not yet implemented";
397	}
398
399
400	=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	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	=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	my $lists = $self->{'loader'}->find_class('lists') \|\| confess "can't find lists class";
462
463	return $lists->search({ name => $name })->first;
464	}
465
466	###
467	### SOAP
468	###
469
470	package Nos::SOAP;
471
472	=head1 SOAP methods
473
474	This methods are thin wrappers to provide SOAP calls. They are grouped in
475	C<Nos::SOAP> package which is in same F<Nos.pm> module file.
476
477	Usually, you want to use named variables in your SOAP calls if at all
478	possible.
479
480	However, if you have broken SOAP library (like PHP SOAP class from PEAR)
481	you will want to use positional arguments (in same order as documented for
482	methods below).
483
484	=cut
485
486	my $nos;
487
488	sub new {
489	my $class = shift;
490	my $self = {@_};
491	bless($self, $class);
492
493	$nos = new Nos( @_ ) \|\| die "can't create Nos object";
494
495	$self ? return $self : return undef;
496	}
497
498
499	=head2 NewList
500
501	$message_id = NewList(
502	list => 'My list',
503	email => 'my-list@example.com'
504	);
505
506	=cut
507
508	sub NewList {
509	my $self = shift;
510
511	if ($_[0] !~ m/^HASH/) {
512	return $nos->new_list(
513	list => $_[0], email => $_[1],
514	);
515	} else {
516	return $nos->new_list( %{ shift @_ } );
517	}
518	}
519
520	=head2 AddMemberToList
521
522	$member_id = AddMemberToList(
523	list => "My list",
524	email => "e-mail@example.com",
525	name => "Full Name"
526	);
527
528	=cut
529
530	sub AddMemberToList {
531	my $self = shift;
532
533	if ($_[0] !~ m/^HASH/) {
534	return $nos->add_member_to_list(
535	list => $_[0], email => $_[1], name => $_[2],
536	);
537	} else {
538	return $nos->add_member_to_list( %{ shift @_ } );
539	}
540	}
541
542	=head2 AddMessageToList
543
544	$message_id = AddMessageToList(
545	list => 'My list',
546	message => 'From: My list...'
547	);
548
549	=cut
550
551	sub AddMessageToList {
552	my $self = shift;
553
554	if ($_[0] !~ m/^HASH/) {
555	return $nos->add_message_to_list(
556	list => $_[0], message => $_[1],
557	);
558	} else {
559	return $nos->add_message_to_list( %{ shift @_ } );
560	}
561	}
562
563
564	###
565
566	=head1 EXPORT
567
568	Nothing.
569
570	=head1 SEE ALSO
571
572	mailman, ezmlm, sympa, L<Mail::Salsa>
573
574
575	=head1 AUTHOR
576
577	Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
578
579
580	=head1 COPYRIGHT AND LICENSE
581
582	Copyright (C) 2005 by Dobrica Pavlinusic
583
584	This library is free software; you can redistribute it and/or modify
585	it under the same terms as Perl itself, either Perl version 5.8.4 or,
586	at your option, any later version of Perl 5 you may have available.
587
588
589	=cut
590
591	1;