/[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 59 - (hide annotations)
Tue Jun 21 20:49:27 2005 UTC (18 years, 8 months ago) by dpavlin
File size: 18113 byte(s)
added delete_member_from_list and tests for delete

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

  ViewVC Help
Powered by ViewVC 1.1.26