/[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 32 by dpavlin, Mon May 16 22:32:58 2005 UTC revision 63 by dpavlin, Wed Jun 22 16:42:06 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.3';  our $VERSION = '0.5';
20    
21  use Class::DBI::Loader;  use Class::DBI::Loader;
22  use Email::Valid;  use Email::Valid;
# Line 24  use Email::Send; Line 24  use Email::Send;
24  use Carp;  use Carp;
25  use Email::Auth::AddressHash;  use Email::Auth::AddressHash;
26  use Email::Simple;  use Email::Simple;
27  use Data::Dumper;  use Email::Address;
28    use Mail::DeliveryStatus::BounceParser;
29    use Class::DBI::AbstractSearch;
30    
31    
32  =head1 NAME  =head1 NAME
33    
# Line 37  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 51  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 68  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 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  =head2 add_member_to_list
189    
190  Add new member to list  Add new member to list
# Line 85  Add new member to list Line 193  Add new member to list
193          list => "My list",          list => "My list",
194          email => "john.doe@example.com",          email => "john.doe@example.com",
195          name => "John A. Doe",          name => "John A. Doe",
196            ext_id => 42,
197   );   );
198    
199  C<name> parametar is optional.  C<name> and C<ext_id> parametars are optional.
200    
201  Return member ID if user is added.  Return member ID if user is added.
202    
# Line 98  sub add_member_to_list { Line 207  sub add_member_to_list {
207    
208          my $arg = {@_};          my $arg = {@_};
209    
210          my $email = $arg->{'email'} || croak "can't add user without e-mail";          my $email = lc($arg->{'email'}) || croak "can't add user without e-mail";
211          my $name = $arg->{'name'} || '';          my $name = $arg->{'name'} || '';
212          my $list_name = $arg->{'list'} || croak "need list name";          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";          my $list = $self->_get_list($list_name) || croak "list $list_name doesn't exist";
216    
217          if (! Email::Valid->address($email)) {          if (! Email::Valid->address($email)) {
218                  carp "SKIPPING $name <$email>\n" if ($self->{'verbose'});                  carp "SKIPPING $name <$email>\n";
219                  return 0;                  return 0;
220          }          }
221    
# Line 116  sub add_member_to_list { Line 226  sub add_member_to_list {
226    
227          my $this_user = $users->find_or_create({          my $this_user = $users->find_or_create({
228                  email => $email,                  email => $email,
                 full_name => $name,  
229          }) || croak "can't find or create member\n";          }) || 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({          my $user_on_list = $user_list->find_or_create({
242                  user_id => $this_user->id,                  user_id => $this_user->id,
243                  list_id => $list->id,                  list_id => $list->id,
# Line 131  sub add_member_to_list { Line 250  sub add_member_to_list {
250          return $this_user->id;          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  =head2 add_message_to_list
385    
386  Adds message to one list's queue for later sending.  Adds message to one list's queue for later sending.
387    
388   $nos->add_message_to_list(   $nos->add_message_to_list(
389          list => 'My list',          list => 'My list',
390          message => 'From: My list <mylist@example.com>          message => 'Subject: welcome to list
391   To: John A. Doe <john.doe@example.com>  
   
392   This is example message   This is example message
393   ',   ',
394   );       );    
395    
396  On success returns ID of newly created (or existing) message.  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  =cut
403    
404  sub add_message_to_list {  sub add_message_to_list {
# Line 153  sub add_message_to_list { Line 406  sub add_message_to_list {
406    
407          my $args = {@_};          my $args = {@_};
408    
409          my $list_name = $args->{'list'} || confess "need list name";          my $list_name = lc($args->{'list'}) || confess "need list name";
410          my $message_text = $args->{'message'} || croak "need message";          my $message_text = $args->{'message'} || croak "need message";
411    
412          my $m = Email::Simple->new($message_text) || croak "can't parse message";          my $m = Email::Simple->new($message_text) || croak "can't parse message";
# Line 194  sub add_message_to_list { Line 447  sub add_message_to_list {
447    
448  Send queued messages or just ones for selected list  Send queued messages or just ones for selected list
449    
450   $nos->send_queued_messages("My list");   $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  =cut
472    
473  sub send_queued_messages {  sub send_queued_messages {
474          my $self = shift;          my $self = shift;
475    
476          my $list_name = shift;          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');          my $lists = $self->{'loader'}->find_class('lists');
494          my $queue = $self->{'loader'}->find_class('queue');          my $queue = $self->{'loader'}->find_class('queue');
# Line 236  sub send_queued_messages { Line 523  sub send_queued_messages {
523                                  print "=> $to_email\n";                                  print "=> $to_email\n";
524    
525                                  my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id;                                  my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id;
526                                  my $auth = Email::Auth::AddressHash->new( $secret, 10 );                                  my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} );
527    
528                                  my $hash = $auth->generate_hash( $to_email );                                  my $hash = $auth->generate_hash( $to_email );
529    
530                                  my $from = $u->list_id->name . " <" . $from . "+" . $hash . ( $domain ? "@" . $domain : '' ). ">";                                  my $from_addr;
531                                  my $to = $u->user_id->full_name . " <$to_email>";                                  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";                                  my $m_obj = Email::Simple->new($msg) || croak "can't parse message";
538    
539                                  $m_obj->header_set('From', $from) || croak "can't set From: header";                                  $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";                                  $m_obj->header_set('To', $to) || croak "can't set To: header";
544    
545                                  # FIXME do real sending :-)                                  $m_obj->header_set('X-Nos-Version', $VERSION);
546                                  send IO => $m_obj->as_string;                                  $m_obj->header_set('X-Nos-Hash', $hash);
547    
548                                    # really send e-mail
549                                    if (@email_send_options) {
550                                            send $email_send_driver => $m_obj->as_string, @email_send_options;
551                                    } else {
552                                            send $email_send_driver => $m_obj->as_string;
553                                    }
554    
555                                  $sent->create({                                  $sent->create({
556                                          message_id => $m->message_id,                                          message_id => $m->message_id,
557                                          user_id => $u->user_id,                                          user_id => $u->user_id,
558                                            hash => $hash,
559                                  });                                  });
560                                  $sent->dbi_commit;                                  $sent->dbi_commit;
561    
562                                    if ($sleep) {
563                                            warn "sleeping $sleep seconds\n";
564                                            sleep($sleep);
565                                    }
566                          }                          }
567                  }                  }
568                  $m->all_sent(1);                  $m->all_sent(1);
# Line 269  sub send_queued_messages { Line 576  sub send_queued_messages {
576    
577  Receive single message for list's inbox.  Receive single message for list's inbox.
578    
579   my $ok = $nos->inbox_message($message);   my $ok = $nos->inbox_message(
580            list => 'My list',
581            message => $message,
582     );
583    
584    This method is used by C<sender.pl> when receiving e-mail messages.
585    
586  =cut  =cut
587    
588  sub inbox_message {  sub inbox_message {
589          my $self = shift;          my $self = shift;
590    
591          my $message = shift || return;          my $arg = {@_};
592    
593            return unless ($arg->{'message'});
594            croak "need list name" unless ($arg->{'list'});
595    
596            $arg->{'list'} = lc($arg->{'list'});
597    
598            my $this_list = $self->_get_list($arg->{'list'}) || croak "can't find list ".$arg->{'list'}."\n";
599    
600            my $m = Email::Simple->new($arg->{'message'}) || croak "can't parse message";
601    
602            my $to = $m->header('To') || die "can't find To: address in incomming message\n";
603    
604            my $return_path = $m->header('Return-Path') || '';
605    
606            my @addrs = Email::Address->parse( $to );
607    
608            die "can't parse To: $to address\n" unless (@addrs);
609    
610            my $hl = $self->{'hash_len'} || confess "no hash_len?";
611    
612            my $hash;
613    
614            foreach my $a (@addrs) {
615                    if ($a->address =~ m/\+([a-f0-9]{$hl})@/i) {
616                            $hash = $1;
617                            last;
618                    }
619            }
620    
621            #warn "can't find hash in e-mail $to\n" unless ($hash);
622    
623            my $sent = $self->{'loader'}->find_class('sent');
624    
625            # will use null if no matching message_id is found
626            my $sent_msg;
627            $sent_msg = $sent->search( hash => $hash )->first if ($hash);
628    
629            my ($message_id, $user_id) = (undef, undef);    # init with NULL
630    
631            if ($sent_msg) {
632                    $message_id = $sent_msg->message_id || carp "no message_id";
633                    $user_id = $sent_msg->user_id || carp "no user_id";
634            } else {
635                    #warn "can't find sender with hash $hash\n";
636                    my $users = $self->{'loader'}->find_class('users');
637                    my $from = $m->header('From');
638                    $from = $1 if ($from =~ m/<(.*)>/);
639                    my $this_user = $users->search( email => lc($from) )->first;
640                    $user_id = $this_user->id if ($this_user);
641            }
642    
643    
644            my $is_bounce = 0;
645    
646            if ($return_path eq '<>' || $return_path eq '') {
647                    no warnings;
648                    my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(
649                            $arg->{'message'}, { report_non_bounces=>1 },
650                    ) };
651                    #warn "can't check if this message is bounce!" if ($@);
652            
653                    $is_bounce++ if ($bounce && $bounce->is_bounce);
654            }
655    
656            my $received = $self->{'loader'}->find_class('received');
657    
658            my $this_received = $received->find_or_create({
659                    user_id => $user_id,
660                    list_id => $this_list->id,
661                    message_id => $message_id,
662                    message => $arg->{'message'},
663                    bounced => $is_bounce,
664            }) || croak "can't insert received message";
665    
666          my $m = new Email::Simple->new($message);          $this_received->dbi_commit;
667    
668    #       print "message_id: ",($message_id || "not found")," -- $is_bounce\n";
669  }  }
670    
671    
# Line 293  Create new list Line 679  Create new list
679    
680   my $list_obj = $nos->_add_list(   my $list_obj = $nos->_add_list(
681          list => 'My list',          list => 'My list',
682            from => 'Outgoing from comment',
683          email => 'my-list@example.com',          email => 'my-list@example.com',
684   );   );
685    
686  Returns C<Class::DBI> object for created list.  Returns C<Class::DBI> object for created list.
687    
688    C<email> address can be with domain or without it if your
689    MTA appends it. There is no checking for validity of your
690    list e-mail. Flexibility comes with resposibility, so please
691    feed correct (and configured) return addresses.
692    
693  =cut  =cut
694    
695  sub _add_list {  sub _add_list {
# Line 305  sub _add_list { Line 697  sub _add_list {
697    
698          my $arg = {@_};          my $arg = {@_};
699    
700          my $name = $arg->{'list'} || confess "can't add list without name";          my $name = lc($arg->{'list'}) || confess "can't add list without name";
701          my $email = $arg->{'email'} || confess "can't add list without e-mail";          my $email = lc($arg->{'email'}) || confess "can't add list without e-mail";
702            my $from_addr = $arg->{'from'};
703    
704          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
705    
# Line 314  sub _add_list { Line 707  sub _add_list {
707                  name => $name,                  name => $name,
708                  email => $email,                  email => $email,
709          });          });
710            
711          croak "can't add list $name\n" unless ($l);          croak "can't add list $name\n" unless ($l);
712    
713            if ($from_addr && $l->from_addr ne $from_addr) {
714                    $l->from_addr($from_addr);
715                    $l->update;
716            }
717    
718          $l->dbi_commit;          $l->dbi_commit;
719    
720          return $l;          return $l;
# Line 341  sub _get_list { Line 739  sub _get_list {
739    
740          my $lists = $self->{'loader'}->find_class('lists') || confess "can't find lists class";          my $lists = $self->{'loader'}->find_class('lists') || confess "can't find lists class";
741    
742          return $lists->search({ name => $name })->first;          return $lists->search({ name => lc($name) })->first;
743    }
744    
745    ###
746    ### SOAP
747    ###
748    
749    package Nos::SOAP;
750    
751    use Carp;
752    
753    =head1 SOAP methods
754    
755    This methods are thin wrappers to provide SOAP calls. They are grouped in
756    C<Nos::SOAP> package which is in same F<Nos.pm> module file.
757    
758    Usually, you want to use named variables in your SOAP calls if at all
759    possible.
760    
761    However, if you have broken SOAP library (like PHP SOAP class from PEAR)
762    you will want to use positional arguments (in same order as documented for
763    methods below).
764    
765    =cut
766    
767    my $nos;
768    
769    sub new {
770            my $class = shift;
771            my $self = {@_};
772            bless($self, $class);
773    
774            $nos = new Nos( @_ ) || die "can't create Nos object";
775    
776            $self ? return $self : return undef;
777    }
778    
779    
780    =head2 NewList
781    
782     $message_id = NewList(
783            list => 'My list',
784            from => 'Name of my list',
785            email => 'my-list@example.com'
786     );
787    
788    =cut
789    
790    sub NewList {
791            my $self = shift;
792    
793            if ($_[0] !~ m/^HASH/) {
794                    return $nos->new_list(
795                            list => $_[0], from => $_[1], email => $_[2],
796                    );
797            } else {
798                    return $nos->new_list( %{ shift @_ } );
799            }
800    }
801    
802    
803    =head2 DeleteList
804    
805     $ok = DeleteList(
806            list => 'My list',
807     );
808    
809    =cut
810    
811    sub DeleteList {
812            my $self = shift;
813    
814            if ($_[0] !~ m/^HASH/) {
815                    return $nos->delete_list(
816                            list => $_[0],
817                    );
818            } else {
819                    return $nos->delete_list( %{ shift @_ } );
820            }
821    }
822    
823    =head2 AddMemberToList
824    
825     $member_id = AddMemberToList(
826            list => 'My list',
827            email => 'e-mail@example.com',
828            name => 'Full Name',
829            ext_id => 42,
830     );
831    
832    =cut
833    
834    sub AddMemberToList {
835            my $self = shift;
836    
837            if ($_[0] !~ m/^HASH/) {
838                    return $nos->add_member_to_list(
839                            list => $_[0], email => $_[1], name => $_[2], ext_id => $_[4],
840                    );
841            } else {
842                    return $nos->add_member_to_list( %{ shift @_ } );
843            }
844  }  }
845    
846    
847    =head2 ListMembers
848    
849     my @members = ListMembers(
850            list => 'My list',
851     );
852    
853    Returns array of hashes with user informations, see C<list_members>.
854    
855    Returning arrays from SOAP calls is somewhat fuzzy (at least to me). It
856    seems that SOAP::Lite client thinks that it has array with one element which
857    is array of hashes with data.
858    
859    =cut
860    
861    sub ListMembers {
862            my $self = shift;
863    
864            my $list_name;
865    
866            if ($_[0] !~ m/^HASH/) {
867                    $list_name = shift;
868            } else {
869                    $list_name = $_[0]->{'list'};
870            }
871    
872            return [ $nos->list_members( list => $list_name ) ];
873    }
874    
875    
876    =head2 DeleteMemberFromList
877    
878     $member_id = DeleteMemberFromList(
879            list => 'My list',
880            email => 'e-mail@example.com',
881     );
882    
883    =cut
884    
885    sub DeleteMemberFromList {
886            my $self = shift;
887    
888            if ($_[0] !~ m/^HASH/) {
889                    return $nos->delete_member_from_list(
890                            list => $_[0], email => $_[1],
891                    );
892            } else {
893                    return $nos->delete_member_from_list( %{ shift @_ } );
894            }
895    }
896    
897    
898    =head2 AddMessageToList
899    
900     $message_id = AddMessageToList(
901            list => 'My list',
902            message => 'From: My list...'
903     );
904    
905    =cut
906    
907    sub AddMessageToList {
908            my $self = shift;
909    
910            if ($_[0] !~ m/^HASH/) {
911                    return $nos->add_message_to_list(
912                            list => $_[0], message => $_[1],
913                    );
914            } else {
915                    return $nos->add_message_to_list( %{ shift @_ } );
916            }
917    }
918    
919    
920    ###
921    
922  =head1 EXPORT  =head1 EXPORT
923    
924  Nothing.  Nothing.
# Line 369  at your option, any later version of Per Line 943  at your option, any later version of Per
943    
944    
945  =cut  =cut
946    
947    1;
Legend:
Removed from v.32  
changed lines
  Added in v.63
  ViewVC Help
Powered by ViewVC 1.1.26