/[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 65 - (show annotations)
Wed Jun 29 17:05:30 2005 UTC (18 years, 8 months ago) by dpavlin
File size: 21591 byte(s)
added check when sending out e-mail. If unsuccesful, it will croak

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.5';
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 Class::DBI::AbstractSearch;
30
31
32 =head1 NAME
33
34 Nos - Notice Sender core module
35
36 =head1 SYNOPSIS
37
38 use Nos;
39 my $nos = new Nos();
40
41 =head1 DESCRIPTION
42
43 Notice sender is mail handler. It is not MTA, since it doesn't know how to
44 receive e-mails or send them directly to other hosts. It is not mail list
45 manager because it requires programming to add list members and send
46 messages. You can think of it as mechanisam for off-loading your e-mail
47 sending to remote server using SOAP service.
48
49 It's concept is based around B<lists>. Each list can have zero or more
50 B<members>. Each list can have zero or more B<messages>.
51
52 Here comes a twist: each outgoing message will have unique e-mail generated,
53 so Notice Sender will be able to link received replies (or bounces) with
54 outgoing messages.
55
56 It doesn't do much more than that. It B<can't> create MIME encoded e-mail,
57 send attachments, handle 8-bit characters in headers (which have to be
58 encoded) or anything else.
59
60 It will just queue your e-mail message to particular list (sending it to
61 possibly remote Notice Sender SOAP server just once), send it out at
62 reasonable rate (so that it doesn't flood your e-mail infrastructure) and
63 track replies.
64
65 It is best used to send smaller number of messages to more-or-less fixed
66 list of recipients while allowing individual responses to be examined.
67 Tipical use include replacing php e-mail sending code with SOAP call to
68 Notice Sender. It does support additional C<ext_id> field for each member
69 which can be used to track some unique identifier from remote system for
70 particular user.
71
72 It comes with command-line utility C<sender.pl> which can be used to perform
73 all available operation from scripts (see C<perldoc sender.pl>).
74 This command is also useful for debugging while writing client SOAP
75 application.
76
77 =head1 METHODS
78
79 =head2 new
80
81 Create new instance specifing database, user, password and options.
82
83 my $nos = new Nos(
84 dsn => 'dbi:Pg:dbname=notices',
85 user => 'dpavlin',
86 passwd => '',
87 debug => 1,
88 verbose => 1,
89 hash_len => 8,
90 );
91
92 Parametar C<hash_len> defines length of hash which will be added to each
93 outgoing e-mail message to ensure that replies can be linked with sent e-mails.
94
95 =cut
96
97 sub new {
98 my $class = shift;
99 my $self = {@_};
100 bless($self, $class);
101
102 croak "need at least dsn" unless ($self->{'dsn'});
103
104 $self->{'loader'} = Class::DBI::Loader->new(
105 debug => $self->{'debug'},
106 dsn => $self->{'dsn'},
107 user => $self->{'user'},
108 password => $self->{'passwd'},
109 namespace => "Nos",
110 additional_classes => qw/Class::DBI::AbstractSearch/,
111 # additional_base_classes => qw/My::Stuff/,
112 relationships => 1,
113 ) || croak "can't init Class::DBI::Loader";
114
115 $self->{'hash_len'} ||= 8;
116
117 $self ? return $self : return undef;
118 }
119
120
121 =head2 new_list
122
123 Create new list. Required arguments are name of C<list> and
124 C<email> address.
125
126 $nos->new_list(
127 list => 'My list',
128 from => 'Outgoing from comment',
129 email => 'my-list@example.com',
130 );
131
132 Returns ID of newly created list.
133
134 Calls internally C<_add_list>, see details there.
135
136 =cut
137
138 sub new_list {
139 my $self = shift;
140
141 my $arg = {@_};
142
143 confess "need list name" unless ($arg->{'list'});
144 confess "need list email" unless ($arg->{'email'});
145
146 $arg->{'list'} = lc($arg->{'list'});
147 $arg->{'email'} = lc($arg->{'email'});
148
149 my $l = $self->_get_list($arg->{'list'}) ||
150 $self->_add_list( @_ ) ||
151 return undef;
152
153 return $l->id;
154 }
155
156
157 =head2 delete_list
158
159 Delete list from database.
160
161 my $ok = delete_list(
162 list => 'My list'
163 );
164
165 Returns false if list doesn't exist.
166
167 =cut
168
169 sub delete_list {
170 my $self = shift;
171
172 my $args = {@_};
173
174 croak "need list to delete" unless ($args->{'list'});
175
176 $args->{'list'} = lc($args->{'list'});
177
178 my $lists = $self->{'loader'}->find_class('lists');
179
180 my $this_list = $lists->search( name => $args->{'list'} )->first || return;
181
182 $this_list->delete || croak "can't delete list\n";
183
184 return $lists->dbi_commit || croak "can't commit";
185 }
186
187
188 =head2 add_member_to_list
189
190 Add new member to list
191
192 $nos->add_member_to_list(
193 list => "My list",
194 email => "john.doe@example.com",
195 name => "John A. Doe",
196 ext_id => 42,
197 );
198
199 C<name> and C<ext_id> parametars are optional.
200
201 Return member ID if user is added.
202
203 =cut
204
205 sub add_member_to_list {
206 my $self = shift;
207
208 my $arg = {@_};
209
210 my $email = lc($arg->{'email'}) || croak "can't add user without e-mail";
211 my $name = $arg->{'name'} || '';
212 my $list_name = lc($arg->{'list'}) || croak "need list name";
213 my $ext_id = $arg->{'ext_id'};
214
215 my $list = $self->_get_list($list_name) || croak "list $list_name doesn't exist";
216
217 if (! Email::Valid->address($email)) {
218 carp "SKIPPING $name <$email>\n";
219 return 0;
220 }
221
222 carp "# $name <$email>\n" if ($self->{'verbose'});
223
224 my $users = $self->{'loader'}->find_class('users');
225 my $user_list = $self->{'loader'}->find_class('user_list');
226
227 my $this_user = $users->find_or_create({
228 email => $email,
229 }) || croak "can't find or create member\n";
230
231 if ($name && $this_user->name ne $name) {
232 $this_user->name($name || '');
233 $this_user->update;
234 }
235
236 if (defined($ext_id) && ($this_user->ext_id || '') ne $ext_id) {
237 $this_user->ext_id($ext_id);
238 $this_user->update;
239 }
240
241 my $user_on_list = $user_list->find_or_create({
242 user_id => $this_user->id,
243 list_id => $list->id,
244 }) || croak "can't add user to list";
245
246 $list->dbi_commit;
247 $this_user->dbi_commit;
248 $user_on_list->dbi_commit;
249
250 return $this_user->id;
251 }
252
253 =head2 list_members
254
255 List all members of some list.
256
257 my @members = list_members(
258 list => 'My list',
259 );
260
261 Returns array of hashes with user informations like this:
262
263 $member = {
264 name => 'Dobrica Pavlinusic',
265 email => 'dpavlin@rot13.org
266 }
267
268 If list is not found, returns false. If there is C<ext_id> in user data,
269 it will also be returned.
270
271 =cut
272
273 sub list_members {
274 my $self = shift;
275
276 my $args = {@_};
277
278 my $list_name = lc($args->{'list'}) || confess "need list name";
279
280 my $lists = $self->{'loader'}->find_class('lists');
281 my $user_list = $self->{'loader'}->find_class('user_list');
282
283 my $this_list = $lists->search( name => $list_name )->first || return;
284
285 my @results;
286
287 foreach my $user_on_list ($user_list->search(list_id => $this_list->id)) {
288 my $row = {
289 name => $user_on_list->user_id->name,
290 email => $user_on_list->user_id->email,
291 };
292
293 my $ext_id = $user_on_list->user_id->ext_id;
294 $row->{'ext_id'} = $ext_id if (defined($ext_id));
295
296 push @results, $row;
297 }
298
299 return @results;
300
301 }
302
303
304 =head2 delete_member
305
306 Delete member from database.
307
308 my $ok = delete_member(
309 name => 'Dobrica Pavlinusic'
310 );
311
312 my $ok = delete_member(
313 email => 'dpavlin@rot13.org'
314 );
315
316 Returns false if user doesn't exist.
317
318 This function will delete member from all lists (by cascading delete), so it
319 shouldn't be used lightly.
320
321 =cut
322
323 sub delete_member {
324 my $self = shift;
325
326 my $args = {@_};
327
328 croak "need name or email of user to delete" unless ($args->{'name'} || $args->{'email'});
329
330 $args->{'email'} = lc($args->{'email'}) if ($args->{'email'});
331
332 my $key = 'name';
333 $key = 'email' if ($args->{'email'});
334
335 my $users = $self->{'loader'}->find_class('users');
336
337 my $this_user = $users->search( $key => $args->{$key} )->first || return;
338
339 $this_user->delete || croak "can't delete user\n";
340
341 return $users->dbi_commit || croak "can't commit";
342 }
343
344 =head2 delete_member_from_list
345
346 Delete member from particular list.
347
348 my $ok = delete_member_from_list(
349 list => 'My list',
350 email => 'dpavlin@rot13.org',
351 );
352
353 Returns false if user doesn't exist on that particular list.
354
355 It will die if list or user doesn't exist. You have been warned (you might
356 want to eval this functon to prevent it from croaking).
357
358 =cut
359
360 sub delete_member_from_list {
361 my $self = shift;
362
363 my $args = {@_};
364
365 croak "need list name and email of user to delete" unless ($args->{'list'} && $args->{'email'});
366
367 $args->{'list'} = lc($args->{'list'});
368 $args->{'email'} = lc($args->{'email'});
369
370 my $user = $self->{'loader'}->find_class('users');
371 my $list = $self->{'loader'}->find_class('lists');
372 my $user_list = $self->{'loader'}->find_class('user_list');
373
374 my $this_user = $user->search( email => $args->{'email'} )->first || croak "can't find user: ".$args->{'email'};
375 my $this_list = $list->search( name => $args->{'list'} )->first || croak "can't find list: ".$args->{'list'};
376
377 my $this_user_list = $user_list->search_where( list_id => $this_list->id, user_id => $this_user->id )->first || return;
378
379 $this_user_list->delete || croak "can't delete user from list\n";
380
381 return $user_list->dbi_commit || croak "can't commit";
382 }
383
384 =head2 add_message_to_list
385
386 Adds message to one list's queue for later sending.
387
388 $nos->add_message_to_list(
389 list => 'My list',
390 message => 'Subject: welcome to list
391
392 This is example message
393 ',
394 );
395
396 On success returns ID of newly created (or existing) message.
397
398 Only required header in e-mail is C<Subject:>. C<From:> and C<To:> headers
399 will be automatically generated, but if you want to use own headers, just
400 include them in messages.
401
402 =cut
403
404 sub add_message_to_list {
405 my $self = shift;
406
407 my $args = {@_};
408
409 my $list_name = lc($args->{'list'}) || confess "need list name";
410 my $message_text = $args->{'message'} || croak "need message";
411
412 my $m = Email::Simple->new($message_text) || croak "can't parse message";
413
414 unless( $m->header('Subject') ) {
415 warn "message doesn't have Subject header\n";
416 return;
417 }
418
419 my $lists = $self->{'loader'}->find_class('lists');
420
421 my $this_list = $lists->search(
422 name => $list_name,
423 )->first || croak "can't find list $list_name";
424
425 my $messages = $self->{'loader'}->find_class('messages');
426
427 my $this_message = $messages->find_or_create({
428 message => $message_text
429 }) || croak "can't insert message";
430
431 $this_message->dbi_commit() || croak "can't add message";
432
433 my $queue = $self->{'loader'}->find_class('queue');
434
435 $queue->find_or_create({
436 message_id => $this_message->id,
437 list_id => $this_list->id,
438 }) || croak "can't add message ",$this_message->id," to list ",$this_list->id, ": ",$this_list->name;
439
440 $queue->dbi_commit || croak "can't add message to list ",$this_list->name;
441
442 return $this_message->id;
443 }
444
445
446 =head2 send_queued_messages
447
448 Send queued messages or just ones for selected list
449
450 $nos->send_queued_messages(
451 list => 'My list',
452 driver => 'smtp',
453 sleep => 3,
454 );
455
456 Second option is driver which will be used for e-mail delivery. If not
457 specified, C<IO> driver will be used which will dump e-mail to C<STDERR>.
458
459 Other valid drivers are:
460
461 =over 10
462
463 =item smtp
464
465 Send e-mail using SMTP server at 127.0.0.1
466
467 =back
468
469 Default sleep wait between two messages is 3 seconds.
470
471 =cut
472
473 sub send_queued_messages {
474 my $self = shift;
475
476 my $arg = {@_};
477
478 my $list_name = lc($arg->{'list'}) || '';
479 my $driver = $arg->{'driver'} || '';
480 my $sleep = $arg->{'sleep'};
481 $sleep ||= 3 unless defined($sleep);
482
483 my $email_send_driver = 'Email::Send::IO';
484 my @email_send_options;
485
486 if (lc($driver) eq 'smtp') {
487 $email_send_driver = 'Email::Send::SMTP';
488 @email_send_options = ['127.0.0.1'];
489 } else {
490 warn "dumping all messages to STDERR\n";
491 }
492
493 my $lists = $self->{'loader'}->find_class('lists');
494 my $queue = $self->{'loader'}->find_class('queue');
495 my $user_list = $self->{'loader'}->find_class('user_list');
496 my $sent = $self->{'loader'}->find_class('sent');
497
498 my $my_q;
499 if ($list_name ne '') {
500 my $l_id = $lists->search_like( name => $list_name )->first ||
501 croak "can't find list $list_name";
502 $my_q = $queue->search_like( list_id => $l_id ) ||
503 croak "can't find list $list_name";
504 } else {
505 $my_q = $queue->retrieve_all;
506 }
507
508 while (my $m = $my_q->next) {
509 next if ($m->all_sent);
510
511 print "sending message ",$m->message_id," enqueued on ",$m->date," to list ",$m->list_id->name,"\n";
512 my $msg = $m->message_id->message;
513
514 foreach my $u ($user_list->search(list_id => $m->list_id)) {
515
516 my $to_email = $u->user_id->email;
517
518 my ($from,$domain) = split(/@/, $u->list_id->email, 2);
519
520 if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {
521 print "SKIP $to_email message allready sent\n";
522 } else {
523 print "=> $to_email ";
524
525 my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id;
526 my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} );
527
528 my $hash = $auth->generate_hash( $to_email );
529
530 my $from_addr;
531 my $from_email_only = $from . "+" . $hash . ( $domain ? '@' . $domain : '');
532
533 $from_addr .= '"' . $u->list_id->from_addr . '" ' if ($u->list_id->from_addr);
534 $from_addr .= '<' . $from_email_only . '>';
535 my $to = '"' . $u->user_id->name . '" <' . $to_email . '>';
536
537 my $m_obj = Email::Simple->new($msg) || croak "can't parse message";
538
539 $m_obj->header_set('Return-Path', $from_email_only) || croak "can't set Return-Path: header";
540 $m_obj->header_set('Sender', $from_email_only) || croak "can't set Sender: header";
541 $m_obj->header_set('Errors-To', $from_email_only) || croak "can't set Errors-To: header";
542 $m_obj->header_set('From', $from_addr) || croak "can't set From: header";
543 $m_obj->header_set('To', $to) || croak "can't set To: header";
544
545 $m_obj->header_set('X-Nos-Version', $VERSION);
546 $m_obj->header_set('X-Nos-Hash', $hash);
547
548 # really send e-mail
549 my $sent_status;
550
551 if (@email_send_options) {
552 $sent_status = send $email_send_driver => $m_obj->as_string, @email_send_options;
553 } else {
554 $sent_status = send $email_send_driver => $m_obj->as_string;
555 }
556
557 croak "can't send e-mail: $sent_status\n\nOriginal e-mail follows:\n".$m_obj->as_string unless ($sent_status);
558 my @bad = @{ $sent_status->prop('bad') };
559 croak "failed sending to ",join(",",@bad) if (@bad);
560
561 if ($sent_status) {
562
563 $sent->create({
564 message_id => $m->message_id,
565 user_id => $u->user_id,
566 hash => $hash,
567 });
568 $sent->dbi_commit;
569
570 print " - $sent_status\n";
571
572 } else {
573 warn "ERROR: $sent_status\n";
574 }
575
576 if ($sleep) {
577 warn "sleeping $sleep seconds\n";
578 sleep($sleep);
579 }
580 }
581 }
582 $m->all_sent(1);
583 $m->update;
584 $m->dbi_commit;
585 }
586
587 }
588
589 =head2 inbox_message
590
591 Receive single message for list's inbox.
592
593 my $ok = $nos->inbox_message(
594 list => 'My list',
595 message => $message,
596 );
597
598 This method is used by C<sender.pl> when receiving e-mail messages.
599
600 =cut
601
602 sub inbox_message {
603 my $self = shift;
604
605 my $arg = {@_};
606
607 return unless ($arg->{'message'});
608 croak "need list name" unless ($arg->{'list'});
609
610 $arg->{'list'} = lc($arg->{'list'});
611
612 my $this_list = $self->_get_list($arg->{'list'}) || croak "can't find list ".$arg->{'list'}."\n";
613
614 my $m = Email::Simple->new($arg->{'message'}) || croak "can't parse message";
615
616 my $to = $m->header('To') || die "can't find To: address in incomming message\n";
617
618 my $return_path = $m->header('Return-Path') || '';
619
620 my @addrs = Email::Address->parse( $to );
621
622 die "can't parse To: $to address\n" unless (@addrs);
623
624 my $hl = $self->{'hash_len'} || confess "no hash_len?";
625
626 my $hash;
627
628 foreach my $a (@addrs) {
629 if ($a->address =~ m/\+([a-f0-9]{$hl})@/i) {
630 $hash = $1;
631 last;
632 }
633 }
634
635 #warn "can't find hash in e-mail $to\n" unless ($hash);
636
637 my $sent = $self->{'loader'}->find_class('sent');
638
639 # will use null if no matching message_id is found
640 my $sent_msg;
641 $sent_msg = $sent->search( hash => $hash )->first if ($hash);
642
643 my ($message_id, $user_id) = (undef, undef); # init with NULL
644
645 if ($sent_msg) {
646 $message_id = $sent_msg->message_id || carp "no message_id";
647 $user_id = $sent_msg->user_id || carp "no user_id";
648 } else {
649 #warn "can't find sender with hash $hash\n";
650 my $users = $self->{'loader'}->find_class('users');
651 my $from = $m->header('From');
652 $from = $1 if ($from =~ m/<(.*)>/);
653 my $this_user = $users->search( email => lc($from) )->first;
654 $user_id = $this_user->id if ($this_user);
655 }
656
657
658 my $is_bounce = 0;
659
660 if ($return_path eq '<>' || $return_path eq '') {
661 no warnings;
662 my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(
663 $arg->{'message'}, { report_non_bounces=>1 },
664 ) };
665 #warn "can't check if this message is bounce!" if ($@);
666
667 $is_bounce++ if ($bounce && $bounce->is_bounce);
668 }
669
670 my $received = $self->{'loader'}->find_class('received');
671
672 my $this_received = $received->find_or_create({
673 user_id => $user_id,
674 list_id => $this_list->id,
675 message_id => $message_id,
676 message => $arg->{'message'},
677 bounced => $is_bounce,
678 }) || croak "can't insert received message";
679
680 $this_received->dbi_commit;
681
682 # print "message_id: ",($message_id || "not found")," -- $is_bounce\n";
683 }
684
685
686 =head1 INTERNAL METHODS
687
688 Beware of dragons! You shouldn't need to call those methods directly.
689
690 =head2 _add_list
691
692 Create new list
693
694 my $list_obj = $nos->_add_list(
695 list => 'My list',
696 from => 'Outgoing from comment',
697 email => 'my-list@example.com',
698 );
699
700 Returns C<Class::DBI> object for created list.
701
702 C<email> address can be with domain or without it if your
703 MTA appends it. There is no checking for validity of your
704 list e-mail. Flexibility comes with resposibility, so please
705 feed correct (and configured) return addresses.
706
707 =cut
708
709 sub _add_list {
710 my $self = shift;
711
712 my $arg = {@_};
713
714 my $name = lc($arg->{'list'}) || confess "can't add list without name";
715 my $email = lc($arg->{'email'}) || confess "can't add list without e-mail";
716 my $from_addr = $arg->{'from'};
717
718 my $lists = $self->{'loader'}->find_class('lists');
719
720 my $l = $lists->find_or_create({
721 name => $name,
722 email => $email,
723 });
724
725 croak "can't add list $name\n" unless ($l);
726
727 if ($from_addr && $l->from_addr ne $from_addr) {
728 $l->from_addr($from_addr);
729 $l->update;
730 }
731
732 $l->dbi_commit;
733
734 return $l;
735
736 }
737
738
739 =head2 _get_list
740
741 Get list C<Class::DBI> object.
742
743 my $list_obj = $nos->check_list('My list');
744
745 Returns false on failure.
746
747 =cut
748
749 sub _get_list {
750 my $self = shift;
751
752 my $name = shift || return;
753
754 my $lists = $self->{'loader'}->find_class('lists') || confess "can't find lists class";
755
756 return $lists->search({ name => lc($name) })->first;
757 }
758
759 ###
760 ### SOAP
761 ###
762
763 package Nos::SOAP;
764
765 use Carp;
766
767 =head1 SOAP methods
768
769 This methods are thin wrappers to provide SOAP calls. They are grouped in
770 C<Nos::SOAP> package which is in same F<Nos.pm> module file.
771
772 Usually, you want to use named variables in your SOAP calls if at all
773 possible.
774
775 However, if you have broken SOAP library (like PHP SOAP class from PEAR)
776 you will want to use positional arguments (in same order as documented for
777 methods below).
778
779 =cut
780
781 my $nos;
782
783 sub new {
784 my $class = shift;
785 my $self = {@_};
786 bless($self, $class);
787
788 $nos = new Nos( @_ ) || die "can't create Nos object";
789
790 $self ? return $self : return undef;
791 }
792
793
794 =head2 NewList
795
796 $message_id = NewList(
797 list => 'My list',
798 from => 'Name of my list',
799 email => 'my-list@example.com'
800 );
801
802 =cut
803
804 sub NewList {
805 my $self = shift;
806
807 if ($_[0] !~ m/^HASH/) {
808 return $nos->new_list(
809 list => $_[0], from => $_[1], email => $_[2],
810 );
811 } else {
812 return $nos->new_list( %{ shift @_ } );
813 }
814 }
815
816
817 =head2 DeleteList
818
819 $ok = DeleteList(
820 list => 'My list',
821 );
822
823 =cut
824
825 sub DeleteList {
826 my $self = shift;
827
828 if ($_[0] !~ m/^HASH/) {
829 return $nos->delete_list(
830 list => $_[0],
831 );
832 } else {
833 return $nos->delete_list( %{ shift @_ } );
834 }
835 }
836
837 =head2 AddMemberToList
838
839 $member_id = AddMemberToList(
840 list => 'My list',
841 email => 'e-mail@example.com',
842 name => 'Full Name',
843 ext_id => 42,
844 );
845
846 =cut
847
848 sub AddMemberToList {
849 my $self = shift;
850
851 if ($_[0] !~ m/^HASH/) {
852 return $nos->add_member_to_list(
853 list => $_[0], email => $_[1], name => $_[2], ext_id => $_[4],
854 );
855 } else {
856 return $nos->add_member_to_list( %{ shift @_ } );
857 }
858 }
859
860
861 =head2 ListMembers
862
863 my @members = ListMembers(
864 list => 'My list',
865 );
866
867 Returns array of hashes with user informations, see C<list_members>.
868
869 Returning arrays from SOAP calls is somewhat fuzzy (at least to me). It
870 seems that SOAP::Lite client thinks that it has array with one element which
871 is array of hashes with data.
872
873 =cut
874
875 sub ListMembers {
876 my $self = shift;
877
878 my $list_name;
879
880 if ($_[0] !~ m/^HASH/) {
881 $list_name = shift;
882 } else {
883 $list_name = $_[0]->{'list'};
884 }
885
886 return [ $nos->list_members( list => $list_name ) ];
887 }
888
889
890 =head2 DeleteMemberFromList
891
892 $member_id = DeleteMemberFromList(
893 list => 'My list',
894 email => 'e-mail@example.com',
895 );
896
897 =cut
898
899 sub DeleteMemberFromList {
900 my $self = shift;
901
902 if ($_[0] !~ m/^HASH/) {
903 return $nos->delete_member_from_list(
904 list => $_[0], email => $_[1],
905 );
906 } else {
907 return $nos->delete_member_from_list( %{ shift @_ } );
908 }
909 }
910
911
912 =head2 AddMessageToList
913
914 $message_id = AddMessageToList(
915 list => 'My list',
916 message => 'From: My list...'
917 );
918
919 =cut
920
921 sub AddMessageToList {
922 my $self = shift;
923
924 if ($_[0] !~ m/^HASH/) {
925 return $nos->add_message_to_list(
926 list => $_[0], message => $_[1],
927 );
928 } else {
929 return $nos->add_message_to_list( %{ shift @_ } );
930 }
931 }
932
933
934 ###
935
936 =head1 EXPORT
937
938 Nothing.
939
940 =head1 SEE ALSO
941
942 mailman, ezmlm, sympa, L<Mail::Salsa>
943
944
945 =head1 AUTHOR
946
947 Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
948
949
950 =head1 COPYRIGHT AND LICENSE
951
952 Copyright (C) 2005 by Dobrica Pavlinusic
953
954 This library is free software; you can redistribute it and/or modify
955 it under the same terms as Perl itself, either Perl version 5.8.4 or,
956 at your option, any later version of Perl 5 you may have available.
957
958
959 =cut
960
961 1;

  ViewVC Help
Powered by ViewVC 1.1.26