/[notice-sender]/jifty-dbi/lib/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 /jifty-dbi/lib/Nos.pm

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

trunk/Nos.pm revision 65 by dpavlin, Wed Jun 29 17:05:30 2005 UTC jifty-dbi/lib/Nos.pm revision 92 by dpavlin, Tue Dec 19 10:32:18 2006 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.5';  our $VERSION = '0.9_00';
20    
 use Class::DBI::Loader;  
21  use Email::Valid;  use Email::Valid;
22  use Email::Send;  use Email::Send;
23  use Carp;  use Carp;
# Line 26  use Email::Auth::AddressHash; Line 25  use Email::Auth::AddressHash;
25  use Email::Simple;  use Email::Simple;
26  use Email::Address;  use Email::Address;
27  use Mail::DeliveryStatus::BounceParser;  use Mail::DeliveryStatus::BounceParser;
28  use Class::DBI::AbstractSearch;  use Mail::Alias;
29    use Cwd qw(abs_path);
30    
31    use Jifty::DBI::Handle;
32    use lib 'lib';
33    use Nos::Lists;
34    
35    
36  =head1 NAME  =head1 NAME
# Line 60  encoded) or anything else. Line 64  encoded) or anything else.
64  It will just queue your e-mail message to particular list (sending it to  It will just queue your e-mail message to particular list (sending it to
65  possibly remote Notice Sender SOAP server just once), send it out at  possibly remote Notice Sender SOAP server just once), send it out at
66  reasonable rate (so that it doesn't flood your e-mail infrastructure) and  reasonable rate (so that it doesn't flood your e-mail infrastructure) and
67  track replies.  keep track replies.
68    
69  It is best used to send smaller number of messages to more-or-less fixed  It is best used to send small number of messages to more-or-less fixed
70  list of recipients while allowing individual responses to be examined.  list of recipients while allowing individual responses to be examined.
71  Tipical use include replacing php e-mail sending code with SOAP call to  Tipical use include replacing php e-mail sending code with SOAP call to
72  Notice Sender. It does support additional C<ext_id> field for each member  Notice Sender. It does support additional C<ext_id> field for each member
# Line 70  which can be used to track some unique i Line 74  which can be used to track some unique i
74  particular user.  particular user.
75    
76  It comes with command-line utility C<sender.pl> which can be used to perform  It comes with command-line utility C<sender.pl> which can be used to perform
77  all available operation from scripts (see C<perldoc sender.pl>).  all available operation from scripts (see C<sender.pl --man>).
78  This command is also useful for debugging while writing client SOAP  This command is also useful for debugging while writing client SOAP
79  application.  application.
80    
# Line 87  Create new instance specifing database, Line 91  Create new instance specifing database,
91          debug => 1,          debug => 1,
92          verbose => 1,          verbose => 1,
93          hash_len => 8,          hash_len => 8,
94            full_hostname_in_aliases => 0,
95   );   );
96    
97  Parametar C<hash_len> defines length of hash which will be added to each  Parametar C<hash_len> defines length of hash which will be added to each
98  outgoing e-mail message to ensure that replies can be linked with sent e-mails.  outgoing e-mail message to ensure that replies can be linked with sent e-mails.
99    
100    C<full_hostname_in_aliases> will turn on old behaviour (not supported by Postfix
101    postalias) to include full hostname in aliases file.
102    
103    
104  =cut  =cut
105    
106  sub new {  sub new {
107          my $class = shift;          my $class = shift;
108          my $self = {@_};          my $self = {@_};
109          bless($self, $class);          bless($self, $class);
110    
111          croak "need at least dsn" unless ($self->{'dsn'});          croak "need at least dsn" unless ($self->{dsn});
112    
113            my (undef,$driver,$dbname) = split(/:/, $self->{dsn});
114            $dbname =~ s!^dbname=!!;
115    
116            $self->{h} = Jifty::DBI::Handle->new();
117            $self->{h}->connect(
118                    driver   => $driver,
119                    database => $dbname,
120                    host     => 'localhost',
121                    user     => $self->{user},
122                    password => $self->{passwd},
123            );
124    
125          $self->{'loader'} = Class::DBI::Loader->new(          $self->{'loader'} = Class::DBI::Loader->new(
126                  debug           => $self->{'debug'},                  debug           => $self->{'debug'},
127                  dsn             => $self->{'dsn'},                  dsn                     => $self->{'dsn'},
128                  user            => $self->{'user'},                  user            => $self->{'user'},
129                  password        => $self->{'passwd'},                  password        => $self->{'passwd'},
130                  namespace       => "Nos",                  namespace       => "Nos",
# Line 118  sub new { Line 139  sub new {
139  }  }
140    
141    
142  =head2 new_list  =head2 create_list
143    
144  Create new list. Required arguments are name of C<list> and  Create new list. Required arguments are name of C<list>, C<email> address
145  C<email> address.  and path to C<aliases> file.
146    
147   $nos->new_list(   $nos->create_list(
148          list => 'My list',          list => 'My list',
149          from => 'Outgoing from comment',          from => 'Outgoing from comment',
150          email => 'my-list@example.com',          email => 'my-list@example.com',
151            aliases => '/etc/mail/mylist',
152            archive => '/path/to/mbox/archive',
153   );   );
154    
155  Returns ID of newly created list.  Returns ID of newly created list.
# Line 135  Calls internally C<_add_list>, see detai Line 158  Calls internally C<_add_list>, see detai
158    
159  =cut  =cut
160    
161  sub new_list {  sub create_list {
162          my $self = shift;          my $self = shift;
163    
164          my $arg = {@_};          my $arg = {@_};
# Line 154  sub new_list { Line 177  sub new_list {
177  }  }
178    
179    
180  =head2 delete_list  =head2 drop_list
181    
182  Delete list from database.  Delete list from database.
183    
184   my $ok = delete_list(   my $ok = drop_list(
185          list => 'My list'          list => 'My list'
186            aliases => '/etc/mail/mylist',
187   );   );
188    
189  Returns false if list doesn't exist.  Returns false if list doesn't exist.
190    
191  =cut  =cut
192    
193  sub delete_list {  sub drop_list {
194          my $self = shift;          my $self = shift;
195    
196          my $args = {@_};          my $args = {@_};
# Line 175  sub delete_list { Line 199  sub delete_list {
199    
200          $args->{'list'} = lc($args->{'list'});          $args->{'list'} = lc($args->{'list'});
201    
202            my $aliases = $args->{'aliases'} || croak "need path to aliases file";
203    
204          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
205    
206          my $this_list = $lists->search( name => $args->{'list'} )->first || return;          my $this_list = $lists->search( name => $args->{'list'} )->first || return;
207    
208            $self->_remove_alias( email => $this_list->email, aliases => $aliases);
209    
210          $this_list->delete || croak "can't delete list\n";          $this_list->delete || croak "can't delete list\n";
211    
212          return $lists->dbi_commit || croak "can't commit";          return $lists->dbi_commit || croak "can't commit";
# Line 258  List all members of some list. Line 286  List all members of some list.
286          list => 'My list',          list => 'My list',
287   );   );
288    
289  Returns array of hashes with user informations like this:  Returns array of hashes with user information like this:
290    
291   $member = {   $member = {
292          name => 'Dobrica Pavlinusic',          name => 'Dobrica Pavlinusic',
# Line 411  sub add_message_to_list { Line 439  sub add_message_to_list {
439    
440          my $m = Email::Simple->new($message_text) || croak "can't parse message";          my $m = Email::Simple->new($message_text) || croak "can't parse message";
441    
442          unless( $m->header('Subject') ) {          warn "message doesn't have Subject header\n" unless( $m->header('Subject') );
                 warn "message doesn't have Subject header\n";  
                 return;  
         }  
443    
444          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
445    
# Line 466  Send e-mail using SMTP server at 127.0.0 Line 491  Send e-mail using SMTP server at 127.0.0
491    
492  =back  =back
493    
494    Any other driver name will try to use C<Email::Send::that_driver> module.
495    
496  Default sleep wait between two messages is 3 seconds.  Default sleep wait between two messages is 3 seconds.
497    
498    This method will return number of succesfully sent messages.
499    
500  =cut  =cut
501    
502  sub send_queued_messages {  sub send_queued_messages {
# Line 480  sub send_queued_messages { Line 509  sub send_queued_messages {
509          my $sleep = $arg->{'sleep'};          my $sleep = $arg->{'sleep'};
510          $sleep ||= 3 unless defined($sleep);          $sleep ||= 3 unless defined($sleep);
511    
512            # number of messages sent o.k.
513            my $ok = 0;
514    
515          my $email_send_driver = 'Email::Send::IO';          my $email_send_driver = 'Email::Send::IO';
516          my @email_send_options;          my @email_send_options;
517    
518          if (lc($driver) eq 'smtp') {          if (lc($driver) eq 'smtp') {
519                  $email_send_driver = 'Email::Send::SMTP';                  $email_send_driver = 'Email::Send::SMTP';
520                  @email_send_options = ['127.0.0.1'];                  @email_send_options = ['127.0.0.1'];
521            } elsif ($driver && $driver ne '') {
522                    $email_send_driver = 'Email::Send::' . $driver;
523          } else {          } else {
524                  warn "dumping all messages to STDERR\n";                  warn "dumping all messages to STDERR\n";
525          }          }
# Line 537  sub send_queued_messages { Line 571  sub send_queued_messages {
571                                  my $m_obj = Email::Simple->new($msg) || croak "can't parse message";                                  my $m_obj = Email::Simple->new($msg) || croak "can't parse message";
572    
573                                  $m_obj->header_set('Return-Path', $from_email_only) || croak "can't set Return-Path: header";                                  $m_obj->header_set('Return-Path', $from_email_only) || croak "can't set Return-Path: header";
574                                  $m_obj->header_set('Sender', $from_email_only) || croak "can't set Sender: header";                                  #$m_obj->header_set('Sender', $from_email_only) || croak "can't set Sender: header";
575                                  $m_obj->header_set('Errors-To', $from_email_only) || croak "can't set Errors-To: header";                                  $m_obj->header_set('Errors-To', $from_email_only) || croak "can't set Errors-To: header";
576                                  $m_obj->header_set('From', $from_addr) || croak "can't set From: header";                                  $m_obj->header_set('From', $from_addr) || croak "can't set From: header";
577                                  $m_obj->header_set('To', $to) || croak "can't set To: header";                                  $m_obj->header_set('To', $to) || croak "can't set To: header";
# Line 555  sub send_queued_messages { Line 589  sub send_queued_messages {
589                                  }                                  }
590    
591                                  croak "can't send e-mail: $sent_status\n\nOriginal e-mail follows:\n".$m_obj->as_string unless ($sent_status);                                  croak "can't send e-mail: $sent_status\n\nOriginal e-mail follows:\n".$m_obj->as_string unless ($sent_status);
592                                  my @bad = @{ $sent_status->prop('bad') };                                  my @bad;
593                                    @bad = @{ $sent_status->prop('bad') } if (eval { $sent_status->can('prop') });
594                                  croak "failed sending to ",join(",",@bad) if (@bad);                                  croak "failed sending to ",join(",",@bad) if (@bad);
595    
596                                  if ($sent_status) {                                  if ($sent_status) {
# Line 569  sub send_queued_messages { Line 604  sub send_queued_messages {
604    
605                                          print " - $sent_status\n";                                          print " - $sent_status\n";
606    
607                                            $ok++;
608                                  } else {                                  } else {
609                                          warn "ERROR: $sent_status\n";                                          warn "ERROR: $sent_status\n";
610                                  }                                  }
# Line 584  sub send_queued_messages { Line 620  sub send_queued_messages {
620                  $m->dbi_commit;                  $m->dbi_commit;
621          }          }
622    
623            return $ok;
624    
625  }  }
626    
627  =head2 inbox_message  =head2 inbox_message
# Line 682  sub inbox_message { Line 720  sub inbox_message {
720  #       print "message_id: ",($message_id || "not found")," -- $is_bounce\n";  #       print "message_id: ",($message_id || "not found")," -- $is_bounce\n";
721  }  }
722    
723    =head2 received_messages
724    
725    Returns all received messages for given list or user.
726    
727     my @received = $nos->received_messages(
728            list => 'My list',
729            email => "john.doe@example.com",
730            from_date => '2005-01-01 10:15:00',
731            to_date => '2005-01-01 12:00:00',
732            message => 0,
733     );
734    
735    If don't specify C<list> or C<email> it will return all received messages.
736    Results will be sorted by received date, oldest first.
737    
738    Other optional parametars include:
739    
740    =over 10
741    
742    =item from_date
743    
744    Date (in ISO format) for lower limit of dates received
745    
746    =item to_date
747    
748    Return just messages older than this date
749    
750    =item message
751    
752    Include whole received message in result. This will probably make result
753    array very large. Use with care.
754    
755    =back
756    
757    Date ranges are inclusive, so results will include messages sent on
758    particular date specified with C<date_from> or C<date_to>.
759    
760    Each element in returned array will have following structure:
761    
762     my $row = {
763            id => 42,                       # unique ID of received message
764            list => 'My list',              # useful if filtering by email
765            ext_id => 9999,                 # ext_id from message sender
766            email => 'jdoe@example.com',    # e-mail of message sender
767            bounced => 0,                   # true if message is bounce
768            date => '2005-08-24 18:57:24',  # date of receival in ISO format
769     }
770    
771    If you specified C<message> option, this hash will also have C<message> key
772    which will contain whole received message.
773    
774    =cut
775    
776    sub received_messages {
777            my $self = shift;
778    
779            my $arg = {@_} if (@_);
780    
781    #       croak "need list name or email" unless ($arg->{'list'} || $arg->{'email'});
782    
783            my $sql = qq{
784                            select
785                                    received.id as id,
786                                    lists.name as list,
787                                    users.ext_id as ext_id,
788                                    users.email as email,
789            };
790            $sql .= qq{             message,} if ($arg->{'message'});
791            $sql .= qq{
792                                    bounced,received.date as date
793                            from received
794                            join lists on lists.id = list_id
795                            join users on users.id = user_id
796            };
797    
798            my $order = qq{ order by date asc };
799    
800            my $where;
801    
802            $where->{'lists.name'} = lc($arg->{'list'}) if ($arg->{'list'});
803            $where->{'users.email'} = lc($arg->{'email'}) if ($arg->{'email'});
804            $where->{'received.date'} = { '>=', $arg->{'date_from'} } if ($arg->{'date_from'});
805            $where->{'received.date'} = { '<=', $arg->{'date_to'} } if ($arg->{'date_to'});
806    
807            # hum, yammy one-liner
808            my($stmt, @bind)  = SQL::Abstract->new->where($where);
809    
810            my $dbh = $self->{'loader'}->find_class('received')->db_Main;
811    
812            my $sth = $dbh->prepare($sql . $stmt . $order);
813            $sth->execute(@bind);
814            return $sth->fetchall_hash;
815    }
816    
817    
818  =head1 INTERNAL METHODS  =head1 INTERNAL METHODS
819    
820  Beware of dragons! You shouldn't need to call those methods directly.  Beware of dragons! You shouldn't need to call those methods directly.
821    
822    
823    =head2 _add_aliases
824    
825    Add or update alias in C</etc/aliases> (or equivalent) file for selected list
826    
827     my $ok = $nos->add_aliases(
828            list => 'My list',
829            email => 'my-list@example.com',
830            aliases => '/etc/mail/mylist',
831            archive => '/path/to/mbox/archive',
832    
833     );
834    
835    C<archive> parametar is optional.
836    
837    Return false on failure.
838    
839    =cut
840    
841    sub _add_aliases {
842            my $self = shift;
843    
844            my $arg = {@_};
845    
846            foreach my $o (qw/list email aliases/) {
847                    croak "need $o option" unless ($arg->{$o});
848            }
849    
850            my $aliases = $arg->{'aliases'};
851            my $email = $arg->{'email'};
852            my $list = $arg->{'list'};
853    
854            unless (-e $aliases) {
855                    warn "aliases file $aliases doesn't exist, creating empty\n";
856                    open(my $fh, '>', $aliases) || croak "can't create $aliases: $!";
857                    close($fh);
858                    chmod 0777, $aliases || warn "can't change permission to 0777";
859            }
860    
861            die "FATAL: aliases file $aliases is not writable\n" unless (-w $aliases);
862    
863            my $a = new Mail::Alias($aliases) || croak "can't open aliases file $aliases: $!";
864    
865            my $target = '';
866    
867            if (my $archive = $arg->{'archive'}) {
868                    $target .= "$archive, ";
869    
870                    if (! -e $archive) {
871                            warn "please make sure that file $archive is writable for your e-mail user (defaulting to bad 777 permission for now)";
872    
873                            open(my $fh, '>', $archive) || croak "can't create archive file $archive: $!";
874                            close($fh);
875                            chmod 0777, $archive || croak "can't chmod archive file $archive to 0777: $!";
876                    }
877            }
878    
879            # resolve my path to absolute one
880            my $self_path = abs_path($0);
881            $self_path =~ s#/[^/]+$##;
882            $self_path =~ s#/t/*$#/#;
883    
884            $target .= qq#"| cd $self_path && ./sender.pl --inbox='$list'"#;
885    
886            # remove hostname from email to make Postfix's postalias happy
887            $email =~ s/@.+// if (not $self->{full_hostname_in_aliases});
888    
889            if ($a->exists($email)) {
890                    $a->update($email, $target) or croak "can't update alias ".$a->error_check;
891            } else {
892                    $a->append($email, $target) or croak "can't add alias ".$a->error_check;
893            }
894    
895    #       $a->write($aliases) or croak "can't save aliases $aliases ".$a->error_check;
896    
897            return 1;
898    }
899    
900  =head2 _add_list  =head2 _add_list
901    
902  Create new list  Create new list
# Line 695  Create new list Line 905  Create new list
905          list => 'My list',          list => 'My list',
906          from => 'Outgoing from comment',          from => 'Outgoing from comment',
907          email => 'my-list@example.com',          email => 'my-list@example.com',
908            aliases => '/etc/mail/mylist',
909   );   );
910    
911  Returns C<Class::DBI> object for created list.  Returns C<Class::DBI> object for created list.
# Line 706  feed correct (and configured) return add Line 917  feed correct (and configured) return add
917    
918  =cut  =cut
919    
920    sub find_or_create {
921            my $self = shift;
922            my $obj = shift;
923            my %args = {@_};
924    
925            my ( $id, $msg ) = $obj->load_by_cols(%args);
926        unless ( $obj->{values}->{id} ) {
927                    warn "find_or_CREATE(",dump( \%args ), ")";
928                    return $obj->create(%args);
929            }
930    
931            warn "FIND_or_create(",dump( \%args ), ") = $id";
932            return $id;
933    }
934    
935    
936  sub _add_list {  sub _add_list {
937          my $self = shift;          my $self = shift;
938    
# Line 713  sub _add_list { Line 940  sub _add_list {
940    
941          my $name = lc($arg->{'list'}) || confess "can't add list without name";          my $name = lc($arg->{'list'}) || confess "can't add list without name";
942          my $email = lc($arg->{'email'}) || confess "can't add list without e-mail";          my $email = lc($arg->{'email'}) || confess "can't add list without e-mail";
943            my $aliases = lc($arg->{'aliases'}) || confess "can't add list without path to aliases file";
944    
945          my $from_addr = $arg->{'from'};          my $from_addr = $arg->{'from'};
946    
947          my $lists = $self->{'loader'}->find_class('lists');          my $lists = Nos::Lists->new( handle => $self->{h} );
948    
949          my $l = $lists->find_or_create({          $self->_add_aliases(
950                    list => $name,
951                    email => $email,
952                    aliases => $aliases,
953            ) || warn "can't add alias $email for list $name";
954    
955            my $l = $self->find_or_create($lists, {
956                  name => $name,                  name => $name,
957                  email => $email,                  email => $email,
958          });          });
# Line 736  sub _add_list { Line 971  sub _add_list {
971  }  }
972    
973    
974    
975  =head2 _get_list  =head2 _get_list
976    
977  Get list C<Class::DBI> object.  Get list C<Class::DBI> object.
# Line 756  sub _get_list { Line 992  sub _get_list {
992          return $lists->search({ name => lc($name) })->first;          return $lists->search({ name => lc($name) })->first;
993  }  }
994    
995    
996    =head2 _remove_alias
997    
998    Remove list alias
999    
1000     my $ok = $nos->_remove_alias(
1001            email => 'mylist@example.com',
1002            aliases => '/etc/mail/mylist',
1003     );
1004    
1005    Returns true if list is removed or false if list doesn't exist. Dies in case of error.
1006    
1007    =cut
1008    
1009    sub _remove_alias {
1010            my $self = shift;
1011    
1012            my $arg = {@_};
1013    
1014            my $email = lc($arg->{'email'}) || confess "can't remove alias without email";
1015            my $aliases = lc($arg->{'aliases'}) || confess "can't remove alias without list";
1016    
1017            my $a = new Mail::Alias($aliases) || croak "can't open aliases file $aliases: $!";
1018    
1019            if ($a->exists($email)) {
1020                    $a->delete($email) || croak "can't remove alias $email";
1021            } else {
1022                    return 0;
1023            }
1024    
1025            return 1;
1026    
1027    }
1028    
1029  ###  ###
1030  ### SOAP  ### SOAP
1031  ###  ###
# Line 780  methods below). Line 1050  methods below).
1050    
1051  my $nos;  my $nos;
1052    
1053    
1054    =head2 new
1055    
1056    Create new SOAP object
1057    
1058     my $soap = new Nos::SOAP(
1059            dsn => 'dbi:Pg:dbname=notices',
1060            user => 'dpavlin',
1061            passwd => '',
1062            debug => 1,
1063            verbose => 1,
1064            hash_len => 8,
1065            aliases => '/etc/aliases',
1066     );
1067    
1068    If you are writing SOAP server (like C<soap.cgi> example), you will need to
1069    call this method once to make new instance of Nos::SOAP and specify C<dsn>
1070    and options for it.
1071    
1072    =cut
1073    
1074  sub new {  sub new {
1075          my $class = shift;          my $class = shift;
1076          my $self = {@_};          my $self = {@_};
1077    
1078            croak "need aliases parametar" unless ($self->{'aliases'});
1079    
1080          bless($self, $class);          bless($self, $class);
1081    
1082          $nos = new Nos( @_ ) || die "can't create Nos object";          $nos = new Nos( @_ ) || die "can't create Nos object";
# Line 791  sub new { Line 1085  sub new {
1085  }  }
1086    
1087    
1088  =head2 NewList  =head2 CreateList
1089    
1090   $message_id = NewList(   $message_id = CreateList(
1091          list => 'My list',          list => 'My list',
1092          from => 'Name of my list',          from => 'Name of my list',
1093          email => 'my-list@example.com'          email => 'my-list@example.com'
# Line 801  sub new { Line 1095  sub new {
1095    
1096  =cut  =cut
1097    
1098  sub NewList {  sub CreateList {
1099          my $self = shift;          my $self = shift;
1100    
1101            my $aliases = $nos->{'aliases'} || croak "need 'aliases' argument to new constructor";
1102    
1103          if ($_[0] !~ m/^HASH/) {          if ($_[0] !~ m/^HASH/) {
1104                  return $nos->new_list(                  return $nos->create_list(
1105                          list => $_[0], from => $_[1], email => $_[2],                          list => $_[0], from => $_[1], email => $_[2],
1106                            aliases => $aliases,
1107                  );                  );
1108          } else {          } else {
1109                  return $nos->new_list( %{ shift @_ } );                  return $nos->create_list( %{ shift @_ }, aliases => $aliases );
1110          }          }
1111  }  }
1112    
1113    
1114  =head2 DeleteList  =head2 DropList
1115    
1116   $ok = DeleteList(   $ok = DropList(
1117          list => 'My list',          list => 'My list',
1118   );   );
1119    
1120  =cut  =cut
1121    
1122  sub DeleteList {  sub DropList {
1123          my $self = shift;          my $self = shift;
1124    
1125            my $aliases = $nos->{'aliases'} || croak "need 'aliases' argument to new constructor";
1126    
1127          if ($_[0] !~ m/^HASH/) {          if ($_[0] !~ m/^HASH/) {
1128                  return $nos->delete_list(                  return $nos->drop_list(
1129                          list => $_[0],                          list => $_[0],
1130                            aliases => $aliases,
1131                  );                  );
1132          } else {          } else {
1133                  return $nos->delete_list( %{ shift @_ } );                  return $nos->drop_list( %{ shift @_ }, aliases => $aliases );
1134          }          }
1135  }  }
1136    
# Line 850  sub AddMemberToList { Line 1150  sub AddMemberToList {
1150    
1151          if ($_[0] !~ m/^HASH/) {          if ($_[0] !~ m/^HASH/) {
1152                  return $nos->add_member_to_list(                  return $nos->add_member_to_list(
1153                          list => $_[0], email => $_[1], name => $_[2], ext_id => $_[4],                          list => $_[0], email => $_[1], name => $_[2], ext_id => $_[3],
1154                  );                  );
1155          } else {          } else {
1156                  return $nos->add_member_to_list( %{ shift @_ } );                  return $nos->add_member_to_list( %{ shift @_ } );
# Line 866  sub AddMemberToList { Line 1166  sub AddMemberToList {
1166    
1167  Returns array of hashes with user informations, see C<list_members>.  Returns array of hashes with user informations, see C<list_members>.
1168    
 Returning arrays from SOAP calls is somewhat fuzzy (at least to me). It  
 seems that SOAP::Lite client thinks that it has array with one element which  
 is array of hashes with data.  
   
1169  =cut  =cut
1170    
1171  sub ListMembers {  sub ListMembers {
# Line 930  sub AddMessageToList { Line 1226  sub AddMessageToList {
1226          }          }
1227  }  }
1228    
1229    =head2 MessagesReceived
1230    
1231    Return statistics about received messages.
1232    
1233     my @result = MessagesReceived(
1234            list => 'My list',
1235            email => 'jdoe@example.com',
1236            from_date => '2005-01-01 10:15:00',
1237            to_date => '2005-01-01 12:00:00',
1238            message => 0,
1239     );
1240    
1241    You must specify C<list> or C<email> or any combination of those two. Other
1242    parametars are optional.
1243    
1244    For format of returned array element see C<received_messages>.
1245    
1246    =cut
1247    
1248    sub MessagesReceived {
1249            my $self = shift;
1250    
1251            if ($_[0] !~ m/^HASH/) {
1252                    die "need at least list or email" unless (scalar @_ < 2);
1253                    return \@{ $nos->received_messages(
1254                            list => $_[0], email => $_[1],
1255                            from_date => $_[2], to_date => $_[3],
1256                            message => $_[4]
1257                    ) };
1258            } else {
1259                    my $arg = shift;
1260                    die "need list or email argument" unless ($arg->{'list'} || $arg->{'email'});
1261                    return \@{ $nos->received_messages( %{ $arg } ) };
1262            }
1263    }
1264    
1265  ###  ###
1266    
1267    =head1 NOTE ON ARRAYS IN SOAP
1268    
1269    Returning arrays from SOAP calls is somewhat fuzzy (at least to me). It
1270    seems that SOAP::Lite client thinks that it has array with one element which
1271    is array of hashes with data.
1272    
1273    =head1 PRIVATE METHODS
1274    
1275    Documented here because tests use them
1276    
1277    =head2 _nos_object
1278    
1279      my $nos = $nos->_nos_object;
1280    
1281    =cut
1282    
1283    sub _nos_object {
1284            return $nos;
1285    }
1286    
1287  =head1 EXPORT  =head1 EXPORT
1288    
1289  Nothing.  Nothing.
Legend:
Removed from v.65  
changed lines
  Added in v.92
  ViewVC Help
Powered by ViewVC 1.1.26