/[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 65 by dpavlin, Wed Jun 29 17:05:30 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 233  sub send_queued_messages { Line 520  sub send_queued_messages {
520                          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 )) {
521                                  print "SKIP $to_email message allready sent\n";                                  print "SKIP $to_email message allready sent\n";
522                          } else {                          } else {
523                                  print "=> $to_email\n";                                  print "=> $to_email ";
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                                    my $sent_status;
550    
551                                  $sent->create({                                  if (@email_send_options) {
552                                          message_id => $m->message_id,                                          $sent_status = send $email_send_driver => $m_obj->as_string, @email_send_options;
553                                          user_id => $u->user_id,                                  } else {
554                                  });                                          $sent_status = send $email_send_driver => $m_obj->as_string;
555                                  $sent->dbi_commit;                                  }
556    
557                                    croak "can't send e-mail: $sent_status\n\nOriginal e-mail follows:\n".$m_obj->as_string unless ($sent_status);
558                                    my @bad = @{ $sent_status->prop('bad') };
559                                    croak "failed sending to ",join(",",@bad) if (@bad);
560    
561                                    if ($sent_status) {
562    
563                                            $sent->create({
564                                                    message_id => $m->message_id,
565                                                    user_id => $u->user_id,
566                                                    hash => $hash,
567                                            });
568                                            $sent->dbi_commit;
569    
570                                            print " - $sent_status\n";
571    
572                                    } else {
573                                            warn "ERROR: $sent_status\n";
574                                    }
575    
576                                    if ($sleep) {
577                                            warn "sleeping $sleep seconds\n";
578                                            sleep($sleep);
579                                    }
580                          }                          }
581                  }                  }
582                  $m->all_sent(1);                  $m->all_sent(1);
# Line 269  sub send_queued_messages { Line 590  sub send_queued_messages {
590    
591  Receive single message for list's inbox.  Receive single message for list's inbox.
592    
593   my $ok = $nos->inbox_message($message);   my $ok = $nos->inbox_message(
594            list => 'My list',
595            message => $message,
596     );
597    
598    This method is used by C<sender.pl> when receiving e-mail messages.
599    
600  =cut  =cut
601    
602  sub inbox_message {  sub inbox_message {
603          my $self = shift;          my $self = shift;
604    
605          my $message = shift || return;          my $arg = {@_};
606    
607            return unless ($arg->{'message'});
608            croak "need list name" unless ($arg->{'list'});
609    
610            $arg->{'list'} = lc($arg->{'list'});
611    
612            my $this_list = $self->_get_list($arg->{'list'}) || croak "can't find list ".$arg->{'list'}."\n";
613    
614            my $m = Email::Simple->new($arg->{'message'}) || croak "can't parse message";
615    
616            my $to = $m->header('To') || die "can't find To: address in incomming message\n";
617    
618            my $return_path = $m->header('Return-Path') || '';
619    
620            my @addrs = Email::Address->parse( $to );
621    
622            die "can't parse To: $to address\n" unless (@addrs);
623    
624            my $hl = $self->{'hash_len'} || confess "no hash_len?";
625    
626            my $hash;
627    
628            foreach my $a (@addrs) {
629                    if ($a->address =~ m/\+([a-f0-9]{$hl})@/i) {
630                            $hash = $1;
631                            last;
632                    }
633            }
634    
635            #warn "can't find hash in e-mail $to\n" unless ($hash);
636    
637            my $sent = $self->{'loader'}->find_class('sent');
638    
639            # will use null if no matching message_id is found
640            my $sent_msg;
641            $sent_msg = $sent->search( hash => $hash )->first if ($hash);
642    
643            my ($message_id, $user_id) = (undef, undef);    # init with NULL
644    
645            if ($sent_msg) {
646                    $message_id = $sent_msg->message_id || carp "no message_id";
647                    $user_id = $sent_msg->user_id || carp "no user_id";
648            } else {
649                    #warn "can't find sender with hash $hash\n";
650                    my $users = $self->{'loader'}->find_class('users');
651                    my $from = $m->header('From');
652                    $from = $1 if ($from =~ m/<(.*)>/);
653                    my $this_user = $users->search( email => lc($from) )->first;
654                    $user_id = $this_user->id if ($this_user);
655            }
656    
657    
658            my $is_bounce = 0;
659    
660            if ($return_path eq '<>' || $return_path eq '') {
661                    no warnings;
662                    my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(
663                            $arg->{'message'}, { report_non_bounces=>1 },
664                    ) };
665                    #warn "can't check if this message is bounce!" if ($@);
666            
667                    $is_bounce++ if ($bounce && $bounce->is_bounce);
668            }
669    
670            my $received = $self->{'loader'}->find_class('received');
671    
672            my $this_received = $received->find_or_create({
673                    user_id => $user_id,
674                    list_id => $this_list->id,
675                    message_id => $message_id,
676                    message => $arg->{'message'},
677                    bounced => $is_bounce,
678            }) || croak "can't insert received message";
679    
680          my $m = new Email::Simple->new($message);          $this_received->dbi_commit;
681    
682    #       print "message_id: ",($message_id || "not found")," -- $is_bounce\n";
683  }  }
684    
685    
# Line 293  Create new list Line 693  Create new list
693    
694   my $list_obj = $nos->_add_list(   my $list_obj = $nos->_add_list(
695          list => 'My list',          list => 'My list',
696            from => 'Outgoing from comment',
697          email => 'my-list@example.com',          email => 'my-list@example.com',
698   );   );
699    
700  Returns C<Class::DBI> object for created list.  Returns C<Class::DBI> object for created list.
701    
702    C<email> address can be with domain or without it if your
703    MTA appends it. There is no checking for validity of your
704    list e-mail. Flexibility comes with resposibility, so please
705    feed correct (and configured) return addresses.
706    
707  =cut  =cut
708    
709  sub _add_list {  sub _add_list {
# Line 305  sub _add_list { Line 711  sub _add_list {
711    
712          my $arg = {@_};          my $arg = {@_};
713    
714          my $name = $arg->{'list'} || confess "can't add list without name";          my $name = lc($arg->{'list'}) || confess "can't add list without name";
715          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";
716            my $from_addr = $arg->{'from'};
717    
718          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
719    
# Line 314  sub _add_list { Line 721  sub _add_list {
721                  name => $name,                  name => $name,
722                  email => $email,                  email => $email,
723          });          });
724            
725          croak "can't add list $name\n" unless ($l);          croak "can't add list $name\n" unless ($l);
726    
727            if ($from_addr && $l->from_addr ne $from_addr) {
728                    $l->from_addr($from_addr);
729                    $l->update;
730            }
731    
732          $l->dbi_commit;          $l->dbi_commit;
733    
734          return $l;          return $l;
# Line 341  sub _get_list { Line 753  sub _get_list {
753    
754          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";
755    
756          return $lists->search({ name => $name })->first;          return $lists->search({ name => lc($name) })->first;
757    }
758    
759    ###
760    ### SOAP
761    ###
762    
763    package Nos::SOAP;
764    
765    use Carp;
766    
767    =head1 SOAP methods
768    
769    This methods are thin wrappers to provide SOAP calls. They are grouped in
770    C<Nos::SOAP> package which is in same F<Nos.pm> module file.
771    
772    Usually, you want to use named variables in your SOAP calls if at all
773    possible.
774    
775    However, if you have broken SOAP library (like PHP SOAP class from PEAR)
776    you will want to use positional arguments (in same order as documented for
777    methods below).
778    
779    =cut
780    
781    my $nos;
782    
783    sub new {
784            my $class = shift;
785            my $self = {@_};
786            bless($self, $class);
787    
788            $nos = new Nos( @_ ) || die "can't create Nos object";
789    
790            $self ? return $self : return undef;
791    }
792    
793    
794    =head2 NewList
795    
796     $message_id = NewList(
797            list => 'My list',
798            from => 'Name of my list',
799            email => 'my-list@example.com'
800     );
801    
802    =cut
803    
804    sub NewList {
805            my $self = shift;
806    
807            if ($_[0] !~ m/^HASH/) {
808                    return $nos->new_list(
809                            list => $_[0], from => $_[1], email => $_[2],
810                    );
811            } else {
812                    return $nos->new_list( %{ shift @_ } );
813            }
814    }
815    
816    
817    =head2 DeleteList
818    
819     $ok = DeleteList(
820            list => 'My list',
821     );
822    
823    =cut
824    
825    sub DeleteList {
826            my $self = shift;
827    
828            if ($_[0] !~ m/^HASH/) {
829                    return $nos->delete_list(
830                            list => $_[0],
831                    );
832            } else {
833                    return $nos->delete_list( %{ shift @_ } );
834            }
835    }
836    
837    =head2 AddMemberToList
838    
839     $member_id = AddMemberToList(
840            list => 'My list',
841            email => 'e-mail@example.com',
842            name => 'Full Name',
843            ext_id => 42,
844     );
845    
846    =cut
847    
848    sub AddMemberToList {
849            my $self = shift;
850    
851            if ($_[0] !~ m/^HASH/) {
852                    return $nos->add_member_to_list(
853                            list => $_[0], email => $_[1], name => $_[2], ext_id => $_[4],
854                    );
855            } else {
856                    return $nos->add_member_to_list( %{ shift @_ } );
857            }
858  }  }
859    
860    
861    =head2 ListMembers
862    
863     my @members = ListMembers(
864            list => 'My list',
865     );
866    
867    Returns array of hashes with user informations, see C<list_members>.
868    
869    Returning arrays from SOAP calls is somewhat fuzzy (at least to me). It
870    seems that SOAP::Lite client thinks that it has array with one element which
871    is array of hashes with data.
872    
873    =cut
874    
875    sub ListMembers {
876            my $self = shift;
877    
878            my $list_name;
879    
880            if ($_[0] !~ m/^HASH/) {
881                    $list_name = shift;
882            } else {
883                    $list_name = $_[0]->{'list'};
884            }
885    
886            return [ $nos->list_members( list => $list_name ) ];
887    }
888    
889    
890    =head2 DeleteMemberFromList
891    
892     $member_id = DeleteMemberFromList(
893            list => 'My list',
894            email => 'e-mail@example.com',
895     );
896    
897    =cut
898    
899    sub DeleteMemberFromList {
900            my $self = shift;
901    
902            if ($_[0] !~ m/^HASH/) {
903                    return $nos->delete_member_from_list(
904                            list => $_[0], email => $_[1],
905                    );
906            } else {
907                    return $nos->delete_member_from_list( %{ shift @_ } );
908            }
909    }
910    
911    
912    =head2 AddMessageToList
913    
914     $message_id = AddMessageToList(
915            list => 'My list',
916            message => 'From: My list...'
917     );
918    
919    =cut
920    
921    sub AddMessageToList {
922            my $self = shift;
923    
924            if ($_[0] !~ m/^HASH/) {
925                    return $nos->add_message_to_list(
926                            list => $_[0], message => $_[1],
927                    );
928            } else {
929                    return $nos->add_message_to_list( %{ shift @_ } );
930            }
931    }
932    
933    
934    ###
935    
936  =head1 EXPORT  =head1 EXPORT
937    
938  Nothing.  Nothing.
# Line 369  at your option, any later version of Per Line 957  at your option, any later version of Per
957    
958    
959  =cut  =cut
960    
961    1;
Legend:
Removed from v.32  
changed lines
  Added in v.65
  ViewVC Help
Powered by ViewVC 1.1.26