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

Diff of /trunk/Nos.pm

Parent Directory | Revision Log | View Patch Patch

-revision 67 by dpavlin,
Fri Jul  8 17:00:20 2005 UTC
+revision 77 by dpavlin,
Thu Aug 25 00:37:48 2005 UTC
 Line 16 
 our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'
  our @EXPORT = qw(
  );
- our $VERSION = '0.6';
+ our $VERSION = '0.8';
  use Class::DBI::Loader;
  use Email::Valid;
 Line 27 
 use Email::Simple;
  use Email::Address;
  use Mail::DeliveryStatus::BounceParser;
  use Class::DBI::AbstractSearch;
+ use SQL::Abstract;
  use Mail::Alias;
  use Cwd qw(abs_path);
-Line 62 
 encoded) or anything else.
+Line 63 
 encoded) or anything else.
  It will just queue your e-mail message to particular list (sending it to
  possibly remote Notice Sender SOAP server just once), send it out at
  reasonable rate (so that it doesn't flood your e-mail infrastructure) and
- track replies.
+ keep track replies.
- 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
  list of recipients while allowing individual responses to be examined.
  Tipical use include replacing php e-mail sending code with SOAP call to
  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 73 
 which can be used to track some unique i
  particular user.
  It comes with command-line utility C<sender.pl> which can be used to perform
- all available operation from scripts (see C<perldoc sender.pl>).
+ all available operation from scripts (see C<sender.pl --man>).
  This command is also useful for debugging while writing client SOAP
  application.
-Line 120 
 sub new {
+Line 121 
 sub new {
  }
- =head2 new_list
+ =head2 create_list
  Create new list. Required arguments are name of C<list>, C<email> address
  and path to C<aliases> file.
-  $nos->new_list(
+  $nos->create_list(
          list => 'My list',
          from => 'Outgoing from comment',
          email => 'my-list@example.com',
-Line 139 
 Calls internally C<_add_list>, see detai
+Line 140 
 Calls internally C<_add_list>, see detai
  =cut
- sub new_list {
+ sub create_list {
          my $self = shift;
          my $arg = {@_};
-Line 158 
 sub new_list {
+Line 159 
 sub new_list {
  }
- =head2 delete_list
+ =head2 drop_list
  Delete list from database.
-  my $ok = delete_list(
+  my $ok = drop_list(
          list => 'My list'
+         aliases => '/etc/mail/mylist',
   );
  Returns false if list doesn't exist.
  =cut
- sub delete_list {
+ sub drop_list {
          my $self = shift;
          my $args = {@_};
-Line 179 
 sub delete_list {
+Line 181 
 sub delete_list {
          $args->{'list'} = lc($args->{'list'});
+         my $aliases = $args->{'aliases'} || croak "need path to aliases file";
          my $lists = $self->{'loader'}->find_class('lists');
          my $this_list = $lists->search( name => $args->{'list'} )->first || return;
+         $self->_remove_alias( email => $this_list->email, aliases => $aliases);
          $this_list->delete || croak "can't delete list\n";
          return $lists->dbi_commit || croak "can't commit";
-Line 262 
 List all members of some list.
+Line 268 
 List all members of some list.
          list => 'My list',
   );
- Returns array of hashes with user informations like this:
+ Returns array of hashes with user information like this:
   $member = {
          name => 'Dobrica Pavlinusic',
-Line 470 
 Send e-mail using SMTP server at 127.0.0
+Line 476 
 Send e-mail using SMTP server at 127.0.0
  =back
+ Any other driver name will try to use C<Email::Send::that_driver> module.
  Default sleep wait between two messages is 3 seconds.
+ This method will return number of succesfully sent messages.
  =cut
  sub send_queued_messages {
-Line 484 
 sub send_queued_messages {
+Line 494 
 sub send_queued_messages {
          my $sleep = $arg->{'sleep'};
          $sleep ||= 3 unless defined($sleep);
+         # number of messages sent o.k.
+         my $ok = 0;
          my $email_send_driver = 'Email::Send::IO';
          my @email_send_options;
          if (lc($driver) eq 'smtp') {
                  $email_send_driver = 'Email::Send::SMTP';
                  @email_send_options = ['127.0.0.1'];
+         } elsif ($driver && $driver ne '') {
+                 $email_send_driver = 'Email::Send::' . $driver;
          } else {
                  warn "dumping all messages to STDERR\n";
          }
-Line 559 
 sub send_queued_messages {
+Line 574 
 sub send_queued_messages {
                                  }
                                  croak "can't send e-mail: $sent_status\n\nOriginal e-mail follows:\n".$m_obj->as_string unless ($sent_status);
-                                 my @bad = @{ $sent_status->prop('bad') };
+                                 my @bad;
+                                 @bad = @{ $sent_status->prop('bad') } if (eval { $sent_status->can('prop') });
                                  croak "failed sending to ",join(",",@bad) if (@bad);
                                  if ($sent_status) {
-Line 573 
 sub send_queued_messages {
+Line 589 
 sub send_queued_messages {
                                          print " - $sent_status\n";
+                                         $ok++;
                                  } else {
                                          warn "ERROR: $sent_status\n";
                                  }
-Line 588 
 sub send_queued_messages {
+Line 605 
 sub send_queued_messages {
                  $m->dbi_commit;
          }
+         return $ok;
  }
  =head2 inbox_message
-Line 686 
 sub inbox_message {
+Line 705 
 sub inbox_message {
  #       print "message_id: ",($message_id || "not found")," -- $is_bounce\n";
  }
+ =head2 received_messages
+ Returns all received messages for given list or user.
+  my @received = $nos->received_message(
+         list => 'My list',
+         email => "john.doe@example.com",
+  );
+ Each element in returned array will have following structure:
+  {
+         id => 42,                       # unique ID of received message
+         list => 'My list',              # useful only of filtering by email
+         ext_id => 9999,                 # ext_id from message user
+         email => 'jdoe@example.com',    # e-mail of user
+         bounced => 0,                   # true value if message is bounce
+         date => '2005-08-24 18:57:24',  # date of recival in ISO format
+  }
+ =cut
+ sub received_messages {
+         my $self = shift;
+         my $arg = {@_} if (@_);
+ #       croak "need list name or email" unless ($arg->{'list'} || $arg->{'email'});
+         my $sql = qq{
+                         select
+                                 received.id as id,
+                                 lists.name as list,
+                                 users.ext_id as ext_id,
+                                 users.email as email,
+                                 bounced,received.date as date
+                         from received
+                         join lists on lists.id = list_id
+                         join users on users.id = user_id
+         };
+         my $where;
+         $where->{'lists.name'} = lc($arg->{'list'}) if ($arg->{'list'});
+         $where->{'users.email'} = lc($arg->{'email'}) if ($arg->{'email'});
+         # hum, yammy one-liner
+         my($stmt, @bind)  = SQL::Abstract->new->where($where);
+         my $dbh = $self->{'loader'}->find_class('received')->db_Main;
+         my $sth = $dbh->prepare($sql . $stmt);
+         $sth->execute(@bind);
+         return $sth->fetchall_hash;
+ }
  =head1 INTERNAL METHODS
-Line 694 
 Beware of dragons! You shouldn't need to
+Line 770 
 Beware of dragons! You shouldn't need to
  =head2 _add_aliases
- Add new list to C</etc/aliases> (or equivavlent) file
+ Add or update alias in C</etc/aliases> (or equivalent) file for selected list
   my $ok = $nos->add_aliases(
          list => 'My list',
-Line 715 
 sub _add_aliases {
+Line 791 
 sub _add_aliases {
          my $arg = {@_};
-         croak "need list and email options" unless ($arg->{'list'} && $arg->{'email'});
+         foreach my $o (qw/list email aliases/) {
+                 croak "need $o option" unless ($arg->{$o});
+         }
-         my $aliases = $arg->{'aliases'} || croak "need aliases";
+         my $aliases = $arg->{'aliases'};
+         my $email = $arg->{'email'};
+         my $list = $arg->{'list'};
          unless (-e $aliases) {
                  warn "aliases file $aliases doesn't exist, creating empty\n";
-Line 726 
 sub _add_aliases {
+Line 806 
 sub _add_aliases {
                  chmod 0777, $aliases || warn "can't change permission to 0777";
          }
+         die "FATAL: aliases file $aliases is not writable\n" unless (-w $aliases);
          my $a = new Mail::Alias($aliases) || croak "can't open aliases file $aliases: $!";
          my $target = '';
-Line 747 
 sub _add_aliases {
+Line 829 
 sub _add_aliases {
          $self_path =~ s#/[^/]+$##;
          $self_path =~ s#/t/*$#/#;
-         $target .= qq#| cd $self_path && ./sender.pl --inbox="$arg->{'list'}"#;
+         $target .= qq#| cd $self_path && ./sender.pl --inbox="$list"#;
-         unless ($a->append($arg->{'email'}, $target)) {
+         if ($a->exists($email)) {
-                 croak "can't add alias ".$a->error_check;
+                 $a->update($email, $target) or croak "can't update alias ".$a->error_check;
+         } else {
+                 $a->append($email, $target) or croak "can't add alias ".$a->error_check;
          }
+         #$a->write($aliases) or croak "can't save aliases $aliases ".$a->error_check;
          return 1;
  }
-Line 793 
 sub _add_list {
+Line 879 
 sub _add_list {
                  list => $name,
                  email => $email,
                  aliases => $aliases,
-         ) || croak "can't add alias $email for list $name";
+         ) || warn "can't add alias $email for list $name";
          my $l = $lists->find_or_create({
                  name => $name,
-Line 835 
 sub _get_list {
+Line 921 
 sub _get_list {
          return $lists->search({ name => lc($name) })->first;
  }
+ =head2 _remove_alias
+ Remove list alias
+  my $ok = $nos->_remove_alias(
+         email => 'mylist@example.com',
+         aliases => '/etc/mail/mylist',
+  );
+ Returns true if list is removed or false if list doesn't exist. Dies in case of error.
+ =cut
+ sub _remove_alias {
+         my $self = shift;
+         my $arg = {@_};
+         my $email = lc($arg->{'email'}) || confess "can't remove alias without email";
+         my $aliases = lc($arg->{'aliases'}) || confess "can't remove alias without list";
+         my $a = new Mail::Alias($aliases) || croak "can't open aliases file $aliases: $!";
+         if ($a->exists($email)) {
+                 $a->delete($email) || croak "can't remove alias $email";
+         } else {
+                 return 0;
+         }
+         return 1;
+ }
  ###
  ### SOAP
  ###
-Line 874 
 Create new SOAP object
+Line 994 
 Create new SOAP object
          aliases => '/etc/aliases',
   );
+ If you are writing SOAP server (like C<soap.cgi> example), you will need to
+ call this method once to make new instance of Nos::SOAP and specify C<dsn>
+ and options for it.
  =cut
  sub new {
-Line 890 
 sub new {
+Line 1014 
 sub new {
  }
- =head2 NewList
+ =head2 CreateList
-  $message_id = NewList(
+  $message_id = CreateList(
          list => 'My list',
          from => 'Name of my list',
          email => 'my-list@example.com'
-Line 900 
 sub new {
+Line 1024 
 sub new {
  =cut
- sub NewList {
+ sub CreateList {
          my $self = shift;
-         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";
          if ($_[0] !~ m/^HASH/) {
-                 return $nos->new_list(
+                 return $nos->create_list(
                          list => $_[0], from => $_[1], email => $_[2],
                          aliases => $aliases,
                  );
          } else {
-                 return $nos->new_list( %{ shift @_ }, aliases => $aliases );
+                 return $nos->create_list( %{ shift @_ }, aliases => $aliases );
          }
  }
- =head2 DeleteList
+ =head2 DropList
-  $ok = DeleteList(
+  $ok = DropList(
          list => 'My list',
   );
  =cut
- sub DeleteList {
+ sub DropList {
          my $self = shift;
+         my $aliases = $nos->{'aliases'} || croak "need 'aliases' argument to new constructor";
          if ($_[0] !~ m/^HASH/) {
-                 return $nos->delete_list(
+                 return $nos->drop_list(
                          list => $_[0],
+                         aliases => $aliases,
                  );
          } else {
-                 return $nos->delete_list( %{ shift @_ } );
+                 return $nos->drop_list( %{ shift @_ }, aliases => $aliases );
          }
  }
-Line 970 
 sub AddMemberToList {
+Line 1095 
 sub AddMemberToList {
  Returns array of hashes with user informations, see C<list_members>.
- 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.
  =cut
  sub ListMembers {
-Line 1034 
 sub AddMessageToList {
+Line 1155 
 sub AddMessageToList {
          }
  }
+ =head1 UNIMPLEMENTED FUNCTIONS
+ This is a stub for documentation of unimplemented functions.
+ =head2 MessagesReceived
+  my @result = MessagesReceived(
+         list => 'My list',
+         email => 'jdoe@example.com',
+  );
+ You can specify just C<list> or C<email> or any combination of those.
+ For format of returned array element see C<received_messages>.
+ =head2 MessagesReceivedByDate
+ =head2 MessagesReceivedByDateWithContent
+ =head2 ReceivedMessasgeContent
+ Return content of received message.
+  my $mail_body = ReceivedMessageContent( id => 42 );
+ =cut
  ###
+ =head1 NOTE ON ARRAYS IN SOAP
+ 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.
  =head1 EXPORT
  Nothing.

 Legend:



Removed from v.67
 


changed lines


 
Added in v.77
 Legend:



Removed from v.67
 


changed lines


 
Added in v.77
-Removed from v.67
+Added in v.77

	ViewVC Help
Powered by ViewVC 1.1.26