/[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

Annotation of /trunk/Nos.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 56 - (hide annotations)
Tue Jun 21 09:14:54 2005 UTC (18 years, 8 months ago) by dpavlin
File size: 16795 byte(s)
added from address to SOAP method NewList, added ext_id to add_member_to_list

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 56 our $VERSION = '0.5';
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 20
30 dpavlin 47
31 dpavlin 20 =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 47 from => 'Outgoing from comment',
96 dpavlin 33 email => 'my-list@example.com',
97     );
98    
99     Returns ID of newly created list.
100    
101 dpavlin 38 Calls internally L<_add_list>, see details there.
102    
103 dpavlin 33 =cut
104    
105     sub new_list {
106     my $self = shift;
107    
108     my $arg = {@_};
109    
110     confess "need list name" unless ($arg->{'list'});
111 dpavlin 52 confess "need list email" unless ($arg->{'email'});
112 dpavlin 33
113 dpavlin 52 $arg->{'list'} = lc($arg->{'list'});
114     $arg->{'email'} = lc($arg->{'email'});
115    
116 dpavlin 33 my $l = $self->_get_list($arg->{'list'}) ||
117     $self->_add_list( @_ ) ||
118     return undef;
119    
120     return $l->id;
121     }
122    
123    
124 dpavlin 23 =head2 add_member_to_list
125    
126     Add new member to list
127    
128     $nos->add_member_to_list(
129     list => "My list",
130     email => "john.doe@example.com",
131     name => "John A. Doe",
132 dpavlin 56 ext_id => 42,
133 dpavlin 23 );
134    
135 dpavlin 56 C<name> and C<ext_id> parametars are optional.
136 dpavlin 23
137 dpavlin 27 Return member ID if user is added.
138 dpavlin 23
139     =cut
140    
141     sub add_member_to_list {
142     my $self = shift;
143    
144     my $arg = {@_};
145    
146 dpavlin 52 my $email = lc($arg->{'email'}) || croak "can't add user without e-mail";
147 dpavlin 23 my $name = $arg->{'name'} || '';
148 dpavlin 52 my $list_name = lc($arg->{'list'}) || croak "need list name";
149 dpavlin 56 my $ext_id = $arg->{'ext_id'};
150 dpavlin 23
151 dpavlin 30 my $list = $self->_get_list($list_name) || croak "list $list_name doesn't exist";
152    
153 dpavlin 23 if (! Email::Valid->address($email)) {
154 dpavlin 33 carp "SKIPPING $name <$email>\n";
155 dpavlin 23 return 0;
156     }
157    
158 dpavlin 29 carp "# $name <$email>\n" if ($self->{'verbose'});
159 dpavlin 23
160     my $users = $self->{'loader'}->find_class('users');
161     my $user_list = $self->{'loader'}->find_class('user_list');
162    
163     my $this_user = $users->find_or_create({
164     email => $email,
165     }) || croak "can't find or create member\n";
166    
167 dpavlin 45 if ($name && $this_user->name ne $name) {
168     $this_user->name($name || '');
169 dpavlin 33 $this_user->update;
170     }
171    
172 dpavlin 56 if (defined($ext_id) && ($this_user->ext_id || '') ne $ext_id) {
173     $this_user->ext_id($ext_id);
174     $this_user->update;
175     }
176    
177 dpavlin 23 my $user_on_list = $user_list->find_or_create({
178     user_id => $this_user->id,
179     list_id => $list->id,
180     }) || croak "can't add user to list";
181    
182     $list->dbi_commit;
183     $this_user->dbi_commit;
184     $user_on_list->dbi_commit;
185    
186 dpavlin 27 return $this_user->id;
187 dpavlin 23 }
188    
189 dpavlin 43 =head2 list_members
190    
191 dpavlin 45 List all members of some list.
192    
193 dpavlin 43 my @members = list_members(
194     list => 'My list',
195     );
196    
197     Returns array of hashes with user informations like this:
198    
199     $member = {
200 dpavlin 45 name => 'Dobrica Pavlinusic',
201 dpavlin 43 email => 'dpavlin@rot13.org
202     }
203    
204 dpavlin 56 If list is not found, returns false. If there is C<ext_id> in user data,
205     that will also be returned.
206 dpavlin 45
207 dpavlin 43 =cut
208    
209     sub list_members {
210     my $self = shift;
211    
212     my $args = {@_};
213    
214 dpavlin 52 my $list_name = lc($args->{'list'}) || confess "need list name";
215 dpavlin 43
216     my $lists = $self->{'loader'}->find_class('lists');
217     my $user_list = $self->{'loader'}->find_class('user_list');
218    
219 dpavlin 45 my $this_list = $lists->search( name => $list_name )->first || return;
220 dpavlin 43
221     my @results;
222    
223     foreach my $user_on_list ($user_list->search(list_id => $this_list->id)) {
224     my $row = {
225 dpavlin 45 name => $user_on_list->user_id->name,
226 dpavlin 43 email => $user_on_list->user_id->email,
227     };
228    
229 dpavlin 56 my $ext_id = $user_on_list->user_id->ext_id;
230     $row->{'ext_id'} = $ext_id if (defined($ext_id));
231    
232 dpavlin 43 push @results, $row;
233     }
234    
235     return @results;
236    
237     }
238    
239    
240 dpavlin 45 =head2 delete_member
241    
242     Delete member from database.
243    
244     my $ok = delete_member(
245     name => 'Dobrica Pavlinusic'
246     );
247    
248     my $ok = delete_member(
249     email => 'dpavlin@rot13.org'
250     );
251    
252     Returns false if user doesn't exist.
253    
254     =cut
255    
256     sub delete_member {
257     my $self = shift;
258    
259     my $args = {@_};
260    
261     croak "need name or email of user to delete" unless ($args->{'name'} || $args->{'email'});
262    
263 dpavlin 52 $args->{'email'} = lc($args->{'email'}) if ($args->{'email'});
264    
265 dpavlin 45 my $key = 'name';
266     $key = 'email' if ($args->{'email'});
267    
268     my $users = $self->{'loader'}->find_class('users');
269    
270     my $this_user = $users->search( $key => $args->{$key} )->first || return;
271    
272     $this_user->delete || croak "can't delete user\n";
273    
274     return $users->dbi_commit || croak "can't commit";
275     }
276    
277 dpavlin 29 =head2 add_message_to_list
278 dpavlin 24
279     Adds message to one list's queue for later sending.
280    
281 dpavlin 29 $nos->add_message_to_list(
282 dpavlin 24 list => 'My list',
283 dpavlin 36 message => 'Subject: welcome to list
284 dpavlin 38
285 dpavlin 24 This is example message
286     ',
287     );
288    
289     On success returns ID of newly created (or existing) message.
290    
291 dpavlin 36 Only required header in e-mail is C<Subject:>. C<From:> and C<To:> headers
292     will be automatically generated, but if you want to use own headers, just
293     include them in messages.
294    
295 dpavlin 24 =cut
296    
297 dpavlin 29 sub add_message_to_list {
298 dpavlin 24 my $self = shift;
299    
300     my $args = {@_};
301    
302 dpavlin 52 my $list_name = lc($args->{'list'}) || confess "need list name";
303 dpavlin 24 my $message_text = $args->{'message'} || croak "need message";
304    
305 dpavlin 29 my $m = Email::Simple->new($message_text) || croak "can't parse message";
306    
307 dpavlin 32 unless( $m->header('Subject') ) {
308     warn "message doesn't have Subject header\n";
309     return;
310     }
311 dpavlin 29
312 dpavlin 24 my $lists = $self->{'loader'}->find_class('lists');
313    
314     my $this_list = $lists->search(
315     name => $list_name,
316     )->first || croak "can't find list $list_name";
317    
318     my $messages = $self->{'loader'}->find_class('messages');
319    
320     my $this_message = $messages->find_or_create({
321     message => $message_text
322     }) || croak "can't insert message";
323    
324     $this_message->dbi_commit() || croak "can't add message";
325    
326     my $queue = $self->{'loader'}->find_class('queue');
327    
328     $queue->find_or_create({
329     message_id => $this_message->id,
330     list_id => $this_list->id,
331     }) || croak "can't add message ",$this_message->id," to list ",$this_list->id, ": ",$this_list->name;
332    
333     $queue->dbi_commit || croak "can't add message to list ",$this_list->name;
334    
335     return $this_message->id;
336     }
337    
338    
339 dpavlin 22 =head2 send_queued_messages
340 dpavlin 20
341 dpavlin 22 Send queued messages or just ones for selected list
342 dpavlin 20
343 dpavlin 49 $nos->send_queued_messages(
344     list => 'My list',
345     driver => 'smtp',
346     sleep => 3,
347     );
348 dpavlin 20
349 dpavlin 47 Second option is driver which will be used for e-mail delivery. If not
350     specified, C<IO> driver will be used which will dump e-mail to C<STDERR>.
351    
352     Other valid drivers are:
353    
354     =over 10
355    
356     =item smtp
357    
358     Send e-mail using SMTP server at 127.0.0.1
359    
360     =back
361    
362 dpavlin 49 Default sleep wait between two messages is 3 seconds.
363    
364 dpavlin 21 =cut
365 dpavlin 20
366 dpavlin 22 sub send_queued_messages {
367 dpavlin 21 my $self = shift;
368 dpavlin 20
369 dpavlin 49 my $arg = {@_};
370 dpavlin 20
371 dpavlin 52 my $list_name = lc($arg->{'list'}) || '';
372 dpavlin 49 my $driver = $arg->{'driver'} || '';
373     my $sleep = $arg->{'sleep'};
374     $sleep ||= 3 unless defined($sleep);
375 dpavlin 47
376 dpavlin 49 my $email_send_driver = 'Email::Send::IO';
377     my @email_send_options;
378    
379 dpavlin 47 if (lc($driver) eq 'smtp') {
380     $email_send_driver = 'Email::Send::SMTP';
381     @email_send_options = ['127.0.0.1'];
382 dpavlin 52 } else {
383     warn "dumping all messages to STDERR\n";
384 dpavlin 47 }
385    
386 dpavlin 22 my $lists = $self->{'loader'}->find_class('lists');
387     my $queue = $self->{'loader'}->find_class('queue');
388     my $user_list = $self->{'loader'}->find_class('user_list');
389     my $sent = $self->{'loader'}->find_class('sent');
390 dpavlin 20
391 dpavlin 22 my $my_q;
392     if ($list_name ne '') {
393     my $l_id = $lists->search_like( name => $list_name )->first ||
394     croak "can't find list $list_name";
395     $my_q = $queue->search_like( list_id => $l_id ) ||
396     croak "can't find list $list_name";
397     } else {
398     $my_q = $queue->retrieve_all;
399     }
400 dpavlin 20
401 dpavlin 22 while (my $m = $my_q->next) {
402     next if ($m->all_sent);
403 dpavlin 20
404 dpavlin 22 print "sending message ",$m->message_id," enqueued on ",$m->date," to list ",$m->list_id->name,"\n";
405     my $msg = $m->message_id->message;
406 dpavlin 20
407 dpavlin 22 foreach my $u ($user_list->search(list_id => $m->list_id)) {
408 dpavlin 20
409 dpavlin 29 my $to_email = $u->user_id->email;
410    
411 dpavlin 32 my ($from,$domain) = split(/@/, $u->list_id->email, 2);
412    
413 dpavlin 22 if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {
414 dpavlin 29 print "SKIP $to_email message allready sent\n";
415 dpavlin 22 } else {
416 dpavlin 32 print "=> $to_email\n";
417 dpavlin 20
418 dpavlin 32 my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id;
419 dpavlin 36 my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} );
420 dpavlin 32
421 dpavlin 29 my $hash = $auth->generate_hash( $to_email );
422 dpavlin 20
423 dpavlin 47 my $from_addr;
424 dpavlin 49 my $from_email_only = $from . "+" . $hash . ( $domain ? '@' . $domain : '');
425 dpavlin 48
426 dpavlin 47 $from_addr .= '"' . $u->list_id->from_addr . '" ' if ($u->list_id->from_addr);
427     $from_addr .= '<' . $from_email_only . '>';
428     my $to = '"' . $u->user_id->name . '" <' . $to_email . '>';
429 dpavlin 29
430 dpavlin 32 my $m_obj = Email::Simple->new($msg) || croak "can't parse message";
431 dpavlin 29
432 dpavlin 49 $m_obj->header_set('Return-Path', $from_email_only) || croak "can't set Return-Path: header";
433     $m_obj->header_set('Sender', $from_email_only) || croak "can't set Sender: header";
434     $m_obj->header_set('Errors-To', $from_email_only) || croak "can't set Errors-To: header";
435 dpavlin 47 $m_obj->header_set('From', $from_addr) || croak "can't set From: header";
436 dpavlin 32 $m_obj->header_set('To', $to) || croak "can't set To: header";
437 dpavlin 29
438 dpavlin 38 $m_obj->header_set('X-Nos-Version', $VERSION);
439     $m_obj->header_set('X-Nos-Hash', $hash);
440    
441 dpavlin 47 # really send e-mail
442     if (@email_send_options) {
443     send $email_send_driver => $m_obj->as_string, @email_send_options;
444     } else {
445     send $email_send_driver => $m_obj->as_string;
446     }
447 dpavlin 22
448     $sent->create({
449     message_id => $m->message_id,
450     user_id => $u->user_id,
451 dpavlin 36 hash => $hash,
452 dpavlin 22 });
453     $sent->dbi_commit;
454 dpavlin 49
455     if ($sleep) {
456     warn "sleeping $sleep seconds\n";
457     sleep($sleep);
458     }
459 dpavlin 22 }
460     }
461     $m->all_sent(1);
462     $m->update;
463     $m->dbi_commit;
464     }
465    
466 dpavlin 20 }
467    
468 dpavlin 29 =head2 inbox_message
469    
470     Receive single message for list's inbox.
471    
472 dpavlin 36 my $ok = $nos->inbox_message(
473     list => 'My list',
474     message => $message,
475     );
476 dpavlin 29
477     =cut
478    
479     sub inbox_message {
480     my $self = shift;
481    
482 dpavlin 36 my $arg = {@_};
483 dpavlin 29
484 dpavlin 36 return unless ($arg->{'message'});
485     croak "need list name" unless ($arg->{'list'});
486 dpavlin 29
487 dpavlin 52 $arg->{'list'} = lc($arg->{'list'});
488    
489 dpavlin 37 my $this_list = $self->_get_list($arg->{'list'}) || croak "can't find list ".$arg->{'list'}."\n";
490    
491 dpavlin 36 my $m = Email::Simple->new($arg->{'message'}) || croak "can't parse message";
492    
493     my $to = $m->header('To') || die "can't find To: address in incomming message\n";
494    
495 dpavlin 48 my $return_path = $m->header('Return-Path') || '';
496    
497 dpavlin 36 my @addrs = Email::Address->parse( $to );
498    
499     die "can't parse To: $to address\n" unless (@addrs);
500    
501     my $hl = $self->{'hash_len'} || confess "no hash_len?";
502    
503     my $hash;
504    
505     foreach my $a (@addrs) {
506 dpavlin 52 if ($a->address =~ m/\+([a-f0-9]{$hl})@/i) {
507 dpavlin 36 $hash = $1;
508     last;
509     }
510     }
511    
512 dpavlin 50 #warn "can't find hash in e-mail $to\n" unless ($hash);
513 dpavlin 36
514     my $sent = $self->{'loader'}->find_class('sent');
515    
516     # will use null if no matching message_id is found
517 dpavlin 50 my $sent_msg;
518     $sent_msg = $sent->search( hash => $hash )->first if ($hash);
519 dpavlin 36
520 dpavlin 37 my ($message_id, $user_id) = (undef, undef); # init with NULL
521 dpavlin 36
522 dpavlin 37 if ($sent_msg) {
523     $message_id = $sent_msg->message_id || carp "no message_id";
524     $user_id = $sent_msg->user_id || carp "no user_id";
525 dpavlin 47 } else {
526 dpavlin 50 #warn "can't find sender with hash $hash\n";
527     my $users = $self->{'loader'}->find_class('users');
528     my $from = $m->header('From');
529     $from = $1 if ($from =~ m/<(.*)>/);
530 dpavlin 52 my $this_user = $users->search( email => lc($from) )->first;
531 dpavlin 50 $user_id = $this_user->id if ($this_user);
532 dpavlin 37 }
533    
534    
535     my $is_bounce = 0;
536    
537 dpavlin 49 if ($return_path eq '<>' || $return_path eq '') {
538 dpavlin 47 no warnings;
539     my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(
540     $arg->{'message'}, { report_non_bounces=>1 },
541     ) };
542 dpavlin 50 #warn "can't check if this message is bounce!" if ($@);
543 dpavlin 47
544     $is_bounce++ if ($bounce && $bounce->is_bounce);
545     }
546 dpavlin 37
547     my $received = $self->{'loader'}->find_class('received');
548    
549     my $this_received = $received->find_or_create({
550     user_id => $user_id,
551     list_id => $this_list->id,
552     message_id => $message_id,
553     message => $arg->{'message'},
554     bounced => $is_bounce,
555     }) || croak "can't insert received message";
556    
557     $this_received->dbi_commit;
558    
559 dpavlin 49 # print "message_id: ",($message_id || "not found")," -- $is_bounce\n";
560 dpavlin 29 }
561    
562    
563 dpavlin 30 =head1 INTERNAL METHODS
564    
565     Beware of dragons! You shouldn't need to call those methods directly.
566    
567     =head2 _add_list
568    
569     Create new list
570    
571     my $list_obj = $nos->_add_list(
572     list => 'My list',
573 dpavlin 47 from => 'Outgoing from comment',
574 dpavlin 30 email => 'my-list@example.com',
575     );
576    
577     Returns C<Class::DBI> object for created list.
578    
579 dpavlin 38 C<email> address can be with domain or without it if your
580     MTA appends it. There is no checking for validity of your
581     list e-mail. Flexibility comes with resposibility, so please
582     feed correct (and configured) return addresses.
583    
584 dpavlin 30 =cut
585    
586     sub _add_list {
587     my $self = shift;
588    
589     my $arg = {@_};
590    
591 dpavlin 52 my $name = lc($arg->{'list'}) || confess "can't add list without name";
592     my $email = lc($arg->{'email'}) || confess "can't add list without e-mail";
593 dpavlin 47 my $from_addr = $arg->{'from'};
594 dpavlin 30
595     my $lists = $self->{'loader'}->find_class('lists');
596    
597     my $l = $lists->find_or_create({
598     name => $name,
599     email => $email,
600     });
601 dpavlin 47
602 dpavlin 30 croak "can't add list $name\n" unless ($l);
603    
604 dpavlin 47 if ($from_addr && $l->from_addr ne $from_addr) {
605     $l->from_addr($from_addr);
606     $l->update;
607     }
608    
609 dpavlin 30 $l->dbi_commit;
610    
611     return $l;
612    
613     }
614    
615    
616     =head2 _get_list
617    
618     Get list C<Class::DBI> object.
619    
620     my $list_obj = $nos->check_list('My list');
621    
622     Returns false on failure.
623    
624     =cut
625    
626     sub _get_list {
627     my $self = shift;
628    
629     my $name = shift || return;
630    
631 dpavlin 31 my $lists = $self->{'loader'}->find_class('lists') || confess "can't find lists class";
632 dpavlin 30
633 dpavlin 52 return $lists->search({ name => lc($name) })->first;
634 dpavlin 30 }
635    
636 dpavlin 39 ###
637     ### SOAP
638     ###
639 dpavlin 30
640 dpavlin 39 package Nos::SOAP;
641    
642 dpavlin 43 use Carp;
643    
644 dpavlin 39 =head1 SOAP methods
645    
646     This methods are thin wrappers to provide SOAP calls. They are grouped in
647     C<Nos::SOAP> package which is in same F<Nos.pm> module file.
648    
649     Usually, you want to use named variables in your SOAP calls if at all
650     possible.
651    
652     However, if you have broken SOAP library (like PHP SOAP class from PEAR)
653     you will want to use positional arguments (in same order as documented for
654     methods below).
655    
656     =cut
657    
658     my $nos;
659    
660     sub new {
661     my $class = shift;
662     my $self = {@_};
663     bless($self, $class);
664    
665     $nos = new Nos( @_ ) || die "can't create Nos object";
666    
667     $self ? return $self : return undef;
668     }
669    
670    
671     =head2 NewList
672    
673     $message_id = NewList(
674     list => 'My list',
675 dpavlin 56 from => 'Name of my list',
676 dpavlin 39 email => 'my-list@example.com'
677     );
678    
679     =cut
680    
681     sub NewList {
682     my $self = shift;
683    
684     if ($_[0] !~ m/^HASH/) {
685     return $nos->new_list(
686 dpavlin 56 list => $_[0], from => $_[1], email => $_[2],
687 dpavlin 39 );
688     } else {
689     return $nos->new_list( %{ shift @_ } );
690     }
691     }
692    
693 dpavlin 43
694 dpavlin 39 =head2 AddMemberToList
695    
696     $member_id = AddMemberToList(
697 dpavlin 43 list => 'My list',
698     email => 'e-mail@example.com',
699     name => 'Full Name'
700 dpavlin 39 );
701    
702     =cut
703    
704     sub AddMemberToList {
705     my $self = shift;
706    
707     if ($_[0] !~ m/^HASH/) {
708     return $nos->add_member_to_list(
709     list => $_[0], email => $_[1], name => $_[2],
710     );
711     } else {
712     return $nos->add_member_to_list( %{ shift @_ } );
713     }
714     }
715    
716 dpavlin 43
717     =head2 ListMembers
718    
719     my @members = ListMembers(
720     list => 'My list',
721     );
722    
723     Returns array of hashes with user informations, see C<list_members>.
724    
725     =cut
726    
727     sub ListMembers {
728     my $self = shift;
729    
730     my $list_name;
731    
732     if ($_[0] !~ m/^HASH/) {
733     $list_name = shift;
734     } else {
735     $list_name = $_[0]->{'list'};
736     }
737    
738     return $nos->list_members( list => $list_name );
739     }
740    
741 dpavlin 39 =head2 AddMessageToList
742    
743     $message_id = AddMessageToList(
744     list => 'My list',
745     message => 'From: My list...'
746     );
747    
748     =cut
749    
750     sub AddMessageToList {
751     my $self = shift;
752    
753     if ($_[0] !~ m/^HASH/) {
754     return $nos->add_message_to_list(
755     list => $_[0], message => $_[1],
756     );
757     } else {
758     return $nos->add_message_to_list( %{ shift @_ } );
759     }
760     }
761    
762    
763     ###
764    
765 dpavlin 25 =head1 EXPORT
766 dpavlin 20
767 dpavlin 27 Nothing.
768 dpavlin 20
769     =head1 SEE ALSO
770    
771     mailman, ezmlm, sympa, L<Mail::Salsa>
772    
773 dpavlin 25
774 dpavlin 20 =head1 AUTHOR
775    
776     Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
777    
778 dpavlin 25
779 dpavlin 20 =head1 COPYRIGHT AND LICENSE
780    
781     Copyright (C) 2005 by Dobrica Pavlinusic
782    
783     This library is free software; you can redistribute it and/or modify
784     it under the same terms as Perl itself, either Perl version 5.8.4 or,
785     at your option, any later version of Perl 5 you may have available.
786    
787    
788     =cut
789 dpavlin 39
790     1;

  ViewVC Help
Powered by ViewVC 1.1.26