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

Diff of /trunk/Nos.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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