/[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 67 by dpavlin, Fri Jul 8 17:00:20 2005 UTC revision 74 by dpavlin, Wed Aug 24 17:19:16 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.6';  our $VERSION = '0.7';
20    
21  use Class::DBI::Loader;  use Class::DBI::Loader;
22  use Email::Valid;  use Email::Valid;
# Line 62  encoded) or anything else. Line 62  encoded) or anything else.
62  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
63  possibly remote Notice Sender SOAP server just once), send it out at  possibly remote Notice Sender SOAP server just once), send it out at
64  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
65  track replies.  keep track replies.
66    
67  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
68  list of recipients while allowing individual responses to be examined.  list of recipients while allowing individual responses to be examined.
69  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
70  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 72  which can be used to track some unique i Line 72  which can be used to track some unique i
72  particular user.  particular user.
73    
74  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
75  all available operation from scripts (see C<perldoc sender.pl>).  all available operation from scripts (see C<sender.pl --man>).
76  This command is also useful for debugging while writing client SOAP  This command is also useful for debugging while writing client SOAP
77  application.  application.
78    
# Line 120  sub new { Line 120  sub new {
120  }  }
121    
122    
123  =head2 new_list  =head2 create_list
124    
125  Create new list. Required arguments are name of C<list>, C<email> address  Create new list. Required arguments are name of C<list>, C<email> address
126  and path to C<aliases> file.  and path to C<aliases> file.
127    
128   $nos->new_list(   $nos->create_list(
129          list => 'My list',          list => 'My list',
130          from => 'Outgoing from comment',          from => 'Outgoing from comment',
131          email => 'my-list@example.com',          email => 'my-list@example.com',
# Line 139  Calls internally C<_add_list>, see detai Line 139  Calls internally C<_add_list>, see detai
139    
140  =cut  =cut
141    
142  sub new_list {  sub create_list {
143          my $self = shift;          my $self = shift;
144    
145          my $arg = {@_};          my $arg = {@_};
# Line 158  sub new_list { Line 158  sub new_list {
158  }  }
159    
160    
161  =head2 delete_list  =head2 drop_list
162    
163  Delete list from database.  Delete list from database.
164    
165   my $ok = delete_list(   my $ok = drop_list(
166          list => 'My list'          list => 'My list'
167            aliases => '/etc/mail/mylist',
168   );   );
169    
170  Returns false if list doesn't exist.  Returns false if list doesn't exist.
171    
172  =cut  =cut
173    
174  sub delete_list {  sub drop_list {
175          my $self = shift;          my $self = shift;
176    
177          my $args = {@_};          my $args = {@_};
# Line 179  sub delete_list { Line 180  sub delete_list {
180    
181          $args->{'list'} = lc($args->{'list'});          $args->{'list'} = lc($args->{'list'});
182    
183            my $aliases = $args->{'aliases'} || croak "need path to aliases file";
184    
185          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
186    
187          my $this_list = $lists->search( name => $args->{'list'} )->first || return;          my $this_list = $lists->search( name => $args->{'list'} )->first || return;
188    
189            $self->_remove_alias( email => $this_list->email, aliases => $aliases);
190    
191          $this_list->delete || croak "can't delete list\n";          $this_list->delete || croak "can't delete list\n";
192    
193          return $lists->dbi_commit || croak "can't commit";          return $lists->dbi_commit || croak "can't commit";
# Line 262  List all members of some list. Line 267  List all members of some list.
267          list => 'My list',          list => 'My list',
268   );   );
269    
270  Returns array of hashes with user informations like this:  Returns array of hashes with user information like this:
271    
272   $member = {   $member = {
273          name => 'Dobrica Pavlinusic',          name => 'Dobrica Pavlinusic',
# Line 694  Beware of dragons! You shouldn't need to Line 699  Beware of dragons! You shouldn't need to
699    
700  =head2 _add_aliases  =head2 _add_aliases
701    
702  Add new list to C</etc/aliases> (or equivavlent) file  Add or update alias in C</etc/aliases> (or equivalent) file for selected list
703    
704   my $ok = $nos->add_aliases(   my $ok = $nos->add_aliases(
705          list => 'My list',          list => 'My list',
# Line 715  sub _add_aliases { Line 720  sub _add_aliases {
720    
721          my $arg = {@_};          my $arg = {@_};
722    
723          croak "need list and email options" unless ($arg->{'list'} && $arg->{'email'});          foreach my $o (qw/list email aliases/) {
724                    croak "need $o option" unless ($arg->{$o});
725            }
726    
727          my $aliases = $arg->{'aliases'} || croak "need aliases";          my $aliases = $arg->{'aliases'};
728            my $email = $arg->{'email'};
729            my $list = $arg->{'list'};
730    
731          unless (-e $aliases) {          unless (-e $aliases) {
732                  warn "aliases file $aliases doesn't exist, creating empty\n";                  warn "aliases file $aliases doesn't exist, creating empty\n";
# Line 726  sub _add_aliases { Line 735  sub _add_aliases {
735                  chmod 0777, $aliases || warn "can't change permission to 0777";                  chmod 0777, $aliases || warn "can't change permission to 0777";
736          }          }
737    
738            die "FATAL: aliases file $aliases is not writable\n" unless (-w $aliases);
739    
740          my $a = new Mail::Alias($aliases) || croak "can't open aliases file $aliases: $!";          my $a = new Mail::Alias($aliases) || croak "can't open aliases file $aliases: $!";
741    
742          my $target = '';          my $target = '';
# Line 747  sub _add_aliases { Line 758  sub _add_aliases {
758          $self_path =~ s#/[^/]+$##;          $self_path =~ s#/[^/]+$##;
759          $self_path =~ s#/t/*$#/#;          $self_path =~ s#/t/*$#/#;
760    
761          $target .= qq#| cd $self_path && ./sender.pl --inbox="$arg->{'list'}"#;          $target .= qq#| cd $self_path && ./sender.pl --inbox="$list"#;
762    
763          unless ($a->append($arg->{'email'}, $target)) {          if ($a->exists($email)) {
764                  croak "can't add alias ".$a->error_check;                  $a->update($email, $target) or croak "can't update alias ".$a->error_check;
765            } else {
766                    $a->append($email, $target) or croak "can't add alias ".$a->error_check;
767          }          }
768    
769            #$a->write($aliases) or croak "can't save aliases $aliases ".$a->error_check;
770    
771          return 1;          return 1;
772  }  }
773    
# Line 793  sub _add_list { Line 808  sub _add_list {
808                  list => $name,                  list => $name,
809                  email => $email,                  email => $email,
810                  aliases => $aliases,                  aliases => $aliases,
811          ) || croak "can't add alias $email for list $name";          ) || warn "can't add alias $email for list $name";
812    
813          my $l = $lists->find_or_create({          my $l = $lists->find_or_create({
814                  name => $name,                  name => $name,
# Line 835  sub _get_list { Line 850  sub _get_list {
850          return $lists->search({ name => lc($name) })->first;          return $lists->search({ name => lc($name) })->first;
851  }  }
852    
853    
854    =head2 _remove_alias
855    
856    Remove list alias
857    
858     my $ok = $nos->_remove_alias(
859            email => 'mylist@example.com',
860            aliases => '/etc/mail/mylist',
861     );
862    
863    Returns true if list is removed or false if list doesn't exist. Dies in case of error.
864    
865    =cut
866    
867    sub _remove_alias {
868            my $self = shift;
869    
870            my $arg = {@_};
871    
872            my $email = lc($arg->{'email'}) || confess "can't remove alias without email";
873            my $aliases = lc($arg->{'aliases'}) || confess "can't remove alias without list";
874    
875            my $a = new Mail::Alias($aliases) || croak "can't open aliases file $aliases: $!";
876    
877            if ($a->exists($email)) {
878                    $a->delete($email) || croak "can't remove alias $email";
879            } else {
880                    return 0;
881            }
882    
883            return 1;
884    
885    }
886    
887  ###  ###
888  ### SOAP  ### SOAP
889  ###  ###
# Line 890  sub new { Line 939  sub new {
939  }  }
940    
941    
942  =head2 NewList  =head2 CreateList
943    
944   $message_id = NewList(   $message_id = CreateList(
945          list => 'My list',          list => 'My list',
946          from => 'Name of my list',          from => 'Name of my list',
947          email => 'my-list@example.com'          email => 'my-list@example.com'
# Line 900  sub new { Line 949  sub new {
949    
950  =cut  =cut
951    
952  sub NewList {  sub CreateList {
953          my $self = shift;          my $self = shift;
954    
955          croak "self is not Nos::SOAP object" unless (ref($self) eq 'Nos::SOAP');          my $aliases = $nos->{'aliases'} || croak "need 'aliases' argument to new constructor";
   
         my $aliases = $self->{'aliases'} || croak "need 'aliases' argument to new constructor";  
956    
957          if ($_[0] !~ m/^HASH/) {          if ($_[0] !~ m/^HASH/) {
958                  return $nos->new_list(                  return $nos->create_list(
959                          list => $_[0], from => $_[1], email => $_[2],                          list => $_[0], from => $_[1], email => $_[2],
960                          aliases => $aliases,                          aliases => $aliases,
961                  );                  );
962          } else {          } else {
963                  return $nos->new_list( %{ shift @_ }, aliases => $aliases );                  return $nos->create_list( %{ shift @_ }, aliases => $aliases );
964          }          }
965  }  }
966    
967    
968  =head2 DeleteList  =head2 DropList
969    
970   $ok = DeleteList(   $ok = DropList(
971          list => 'My list',          list => 'My list',
972   );   );
973    
974  =cut  =cut
975    
976  sub DeleteList {  sub DropList {
977          my $self = shift;          my $self = shift;
978    
979            my $aliases = $nos->{'aliases'} || croak "need 'aliases' argument to new constructor";
980    
981          if ($_[0] !~ m/^HASH/) {          if ($_[0] !~ m/^HASH/) {
982                  return $nos->delete_list(                  return $nos->drop_list(
983                          list => $_[0],                          list => $_[0],
984                            aliases => $aliases,
985                  );                  );
986          } else {          } else {
987                  return $nos->delete_list( %{ shift @_ } );                  return $nos->drop_list( %{ shift @_ }, aliases => $aliases );
988          }          }
989  }  }
990    
# Line 970  sub AddMemberToList { Line 1020  sub AddMemberToList {
1020    
1021  Returns array of hashes with user informations, see C<list_members>.  Returns array of hashes with user informations, see C<list_members>.
1022    
 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.  
   
1023  =cut  =cut
1024    
1025  sub ListMembers {  sub ListMembers {
# Line 1034  sub AddMessageToList { Line 1080  sub AddMessageToList {
1080          }          }
1081  }  }
1082    
1083    =head1 UNIMPLEMENTED FUNCTIONS
1084    
1085    This is a stub for documentation of unimplemented functions.
1086    
1087    =head2 MessagesReceived
1088    
1089     my @result = MessagesReceived(
1090            list => 'My list',
1091            email => 'jdoe@example.com',
1092     );
1093    
1094    You can specify just C<list> or C<email> or any combination of those.
1095    
1096    It will return array of hashes with following structure:
1097    
1098     {
1099            id => 42,                       # unique ID of received message
1100            list => 'My list',              # useful only of filtering by email
1101            ext_id => 9999,                 # ext_id from message user
1102            email => 'jdoe@example.com',    # e-mail of user
1103            bounced => 0,                   # true value if message is bounce
1104            date => '2005-08-24 18:57:24',  # date of recival in ISO format
1105     }
1106    
1107    =head2 MessagesReceivedByDate
1108    
1109    =head2 MessagesReceivedByDateWithContent
1110    
1111    =head2 ReceivedMessasgeContent
1112    
1113    Return content of received message.
1114    
1115     my $mail_body = ReceivedMessageContent( id => 42 );
1116    
1117    =cut
1118    
1119    
1120    
1121    
1122  ###  ###
1123    
1124    =head1 NOTE ON ARRAYS IN SOAP
1125    
1126    Returning arrays from SOAP calls is somewhat fuzzy (at least to me). It
1127    seems that SOAP::Lite client thinks that it has array with one element which
1128    is array of hashes with data.
1129    
1130  =head1 EXPORT  =head1 EXPORT
1131    
1132  Nothing.  Nothing.
Legend:
Removed from v.67  
changed lines
  Added in v.74
  ViewVC Help
Powered by ViewVC 1.1.26