/[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 32 by dpavlin,
Mon May 16 22:32:58 2005 UTC
+revision 43 by dpavlin,
Wed May 18 12:29:35 2005 UTC
 Line 24 
 use Email::Send;
  use Carp;
  use Email::Auth::AddressHash;
  use Email::Simple;
+ use Email::Address;
+ use Mail::DeliveryStatus::BounceParser;
  use Data::Dumper;
  =head1 NAME
-Line 51 
 Create new instance specifing database,
+Line 53 
 Create new instance specifing database,
          passwd => '',
          debug => 1,
          verbose => 1,
+         hash_len => 8,
   );
+ Parametar C<hash_len> defines length of hash which will be added to each
+ outgoing e-mail message to ensure that replies can be linked with sent e-mails.
  =cut
  sub new {
-Line 73 
 sub new {
+Line 79 
 sub new {
                  relationships   => 1,
          ) || croak "can't init Class::DBI::Loader";
+         $self->{'hash_len'} ||= 8;
          $self ? return $self : return undef;
  }
+ =head2 new_list
+ Create new list. Required arguments are name of C<list> and
+ C<email> address.
+  $nos->new_list(
+         list => 'My list',
+         email => 'my-list@example.com',
+  );
+ Returns ID of newly created list.
+ Calls internally L<_add_list>, see details there.
+ =cut
+ sub new_list {
+         my $self = shift;
+         my $arg = {@_};
+         confess "need list name" unless ($arg->{'list'});
+         confess "need list email" unless ($arg->{'list'});
+         my $l = $self->_get_list($arg->{'list'}) ||
+                 $self->_add_list( @_ ) ||
+                 return undef;
+         return $l->id;
+ }
  =head2 add_member_to_list
  Add new member to list
-Line 105 
 sub add_member_to_list {
+Line 145 
 sub add_member_to_list {
          my $list = $self->_get_list($list_name) || croak "list $list_name doesn't exist";
          if (! Email::Valid->address($email)) {
-                 carp "SKIPPING $name <$email>\n" if ($self->{'verbose'});
+                 carp "SKIPPING $name <$email>\n";
                  return 0;
          }
-Line 116 
 sub add_member_to_list {
+Line 156 
 sub add_member_to_list {
          my $this_user = $users->find_or_create({
                  email => $email,
-                 full_name => $name,
          }) || croak "can't find or create member\n";
+         if ($name && $this_user->full_name ne $name) {
+                 $this_user->full_name($name || '');
+                 $this_user->update;
+         }
          my $user_on_list = $user_list->find_or_create({
                  user_id => $this_user->id,
                  list_id => $list->id,
-Line 131 
 sub add_member_to_list {
+Line 175 
 sub add_member_to_list {
          return $this_user->id;
  }
+ =head2 list_members
+  my @members = list_members(
+         list => 'My list',
+  );
+ Returns array of hashes with user informations like this:
+  $member = {
+         full_name => 'Dobrica Pavlinusic',
+         email => 'dpavlin@rot13.org
+  }
+ =cut
+ sub list_members {
+         my $self = shift;
+         my $args = {@_};
+         my $list_name = $args->{'list'} || confess "need list name";
+         my $lists = $self->{'loader'}->find_class('lists');
+         my $user_list = $self->{'loader'}->find_class('user_list');
+         my $this_list = $lists->search( name => $list_name )->first || croak "can't find list $list_name\n";
+         my @results;
+         foreach my $user_on_list ($user_list->search(list_id => $this_list->id)) {
+                 my $row = {
+                         full_name => $user_on_list->user_id->full_name,
+                         email => $user_on_list->user_id->email,
+                 };
+                 push @results, $row;
+         }
+         return @results;
+ }
  =head2 add_message_to_list
  Adds message to one list's queue for later sending.
   $nos->add_message_to_list(
          list => 'My list',
-         message => 'From: My list <mylist@example.com>
+         message => 'Subject: welcome to list
-  To: John A. Doe <john.doe@example.com>
   This is example message
   ',
   );
  On success returns ID of newly created (or existing) message.
+ Only required header in e-mail is C<Subject:>. C<From:> and C<To:> headers
+ will be automatically generated, but if you want to use own headers, just
+ include them in messages.
  =cut
  sub add_message_to_list {
-Line 236 
 sub send_queued_messages {
+Line 326 
 sub send_queued_messages {
                                  print "=> $to_email\n";
                                  my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id;
-                                 my $auth = Email::Auth::AddressHash->new( $secret, 10 );
+                                 my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} );
                                  my $hash = $auth->generate_hash( $to_email );
-Line 248 
 sub send_queued_messages {
+Line 338 
 sub send_queued_messages {
                                  $m_obj->header_set('From', $from) || croak "can't set From: header";
                                  $m_obj->header_set('To', $to) || croak "can't set To: header";
+                                 $m_obj->header_set('X-Nos-Version', $VERSION);
+                                 $m_obj->header_set('X-Nos-Hash', $hash);
                                  # FIXME do real sending :-)
                                  send IO => $m_obj->as_string;
                                  $sent->create({
                                          message_id => $m->message_id,
                                          user_id => $u->user_id,
+                                         hash => $hash,
                                  });
                                  $sent->dbi_commit;
                          }
-Line 269 
 sub send_queued_messages {
+Line 363 
 sub send_queued_messages {
  Receive single message for list's inbox.
-  my $ok = $nos->inbox_message($message);
+  my $ok = $nos->inbox_message(
+         list => 'My list',
+         message => $message,
+  );
  =cut
  sub inbox_message {
          my $self = shift;
-         my $message = shift || return;
+         my $arg = {@_};
+         return unless ($arg->{'message'});
+         croak "need list name" unless ($arg->{'list'});
+         my $this_list = $self->_get_list($arg->{'list'}) || croak "can't find list ".$arg->{'list'}."\n";
+         my $m = Email::Simple->new($arg->{'message'}) || croak "can't parse message";
+         my $to = $m->header('To') || die "can't find To: address in incomming message\n";
+         my @addrs = Email::Address->parse( $to );
+         die "can't parse To: $to address\n" unless (@addrs);
+         my $hl = $self->{'hash_len'} || confess "no hash_len?";
+         my $hash;
+         foreach my $a (@addrs) {
+                 if ($a->address =~ m/\+([a-f0-9]{$hl})@/) {
+                         $hash = $1;
+                         last;
+                 }
+         }
+         croak "can't find hash in e-mail $to\n" unless ($hash);
+         my $sent = $self->{'loader'}->find_class('sent');
+         # will use null if no matching message_id is found
+         my $sent_msg = $sent->search( hash => $hash )->first;
+         my ($message_id, $user_id) = (undef, undef);    # init with NULL
+         if ($sent_msg) {
+                 $message_id = $sent_msg->message_id || carp "no message_id";
+                 $user_id = $sent_msg->user_id || carp "no user_id";
+         }
+         my $is_bounce = 0;
+         my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(
+                 $arg->{'message'}, { report_non_bounces=>1 },
+         ) };
+         carp "can't check if this message is bounce!" if ($@);
+         $is_bounce++ if ($bounce && $bounce->is_bounce);
-         my $m = new Email::Simple->new($message);
+         my $received = $self->{'loader'}->find_class('received');
+         my $this_received = $received->find_or_create({
+                 user_id => $user_id,
+                 list_id => $this_list->id,
+                 message_id => $message_id,
+                 message => $arg->{'message'},
+                 bounced => $is_bounce,
+         }) || croak "can't insert received message";
+         $this_received->dbi_commit;
+         print "message_id: ",($message_id || "not found")," -- $is_bounce\n";
+         warn "inbox is not yet implemented";
  }
-Line 298 
 Create new list
+Line 457 
 Create new list
  Returns C<Class::DBI> object for created list.
+ C<email> address can be with domain or without it if your
+ MTA appends it. There is no checking for validity of your
+ list e-mail. Flexibility comes with resposibility, so please
+ feed correct (and configured) return addresses.
  =cut
  sub _add_list {
-Line 344 
 sub _get_list {
+Line 508 
 sub _get_list {
          return $lists->search({ name => $name })->first;
  }
+ ###
+ ### SOAP
+ ###
+ package Nos::SOAP;
+ use Carp;
+ =head1 SOAP methods
+ This methods are thin wrappers to provide SOAP calls. They are grouped in
+ C<Nos::SOAP> package which is in same F<Nos.pm> module file.
+ Usually, you want to use named variables in your SOAP calls if at all
+ possible.
+ However, if you have broken SOAP library (like PHP SOAP class from PEAR)
+ you will want to use positional arguments (in same order as documented for
+ methods below).
+ =cut
+ my $nos;
+ sub new {
+         my $class = shift;
+         my $self = {@_};
+         bless($self, $class);
+         $nos = new Nos( @_ ) || die "can't create Nos object";
+         $self ? return $self : return undef;
+ }
+ =head2 NewList
+  $message_id = NewList(
+         list => 'My list',
+         email => 'my-list@example.com'
+  );
+ =cut
+ sub NewList {
+         my $self = shift;
+         if ($_[0] !~ m/^HASH/) {
+                 return $nos->new_list(
+                         list => $_[0], email => $_[1],
+                 );
+         } else {
+                 return $nos->new_list( %{ shift @_ } );
+         }
+ }
+ =head2 AddMemberToList
+  $member_id = AddMemberToList(
+         list => 'My list',
+         email => 'e-mail@example.com',
+         name => 'Full Name'
+  );
+ =cut
+ sub AddMemberToList {
+         my $self = shift;
+         if ($_[0] !~ m/^HASH/) {
+                 return $nos->add_member_to_list(
+                         list => $_[0], email => $_[1], name => $_[2],
+                 );
+         } else {
+                 return $nos->add_member_to_list( %{ shift @_ } );
+         }
+ }
+ =head2 ListMembers
+  my @members = ListMembers(
+         list => 'My list',
+  );
+ Returns array of hashes with user informations, see C<list_members>.
+ =cut
+ sub ListMembers {
+         my $self = shift;
+         my $list_name;
+         if ($_[0] !~ m/^HASH/) {
+                 $list_name = shift;
+         } else {
+                 $list_name = $_[0]->{'list'};
+         }
+         return $nos->list_members( list => $list_name );
+ }
+ =head2 AddMessageToList
+  $message_id = AddMessageToList(
+         list => 'My list',
+         message => 'From: My list...'
+  );
+ =cut
+ sub AddMessageToList {
+         my $self = shift;
+         if ($_[0] !~ m/^HASH/) {
+                 return $nos->add_message_to_list(
+                         list => $_[0], message => $_[1],
+                 );
+         } else {
+                 return $nos->add_message_to_list( %{ shift @_ } );
+         }
+ }
+ ###
  =head1 EXPORT
-Line 369 
 at your option, any later version of Per
+Line 660 
 at your option, any later version of Per
  =cut
+;

 Legend:



Removed from v.32
 


changed lines


 
Added in v.43
 Legend:



Removed from v.32
 


changed lines


 
Added in v.43
-Removed from v.32
+Added in v.43

	ViewVC Help
Powered by ViewVC 1.1.26