/[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 79 by dpavlin, Thu Aug 25 11:58:15 2005 UTC revision 87 by dpavlin, Thu Sep 21 10:49:00 2006 UTC
# Line 421  sub add_message_to_list { Line 421  sub add_message_to_list {
421    
422          my $m = Email::Simple->new($message_text) || croak "can't parse message";          my $m = Email::Simple->new($message_text) || croak "can't parse message";
423    
424          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;  
         }  
425    
426          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
427    
# Line 556  sub send_queued_messages { Line 553  sub send_queued_messages {
553                                  my $m_obj = Email::Simple->new($msg) || croak "can't parse message";                                  my $m_obj = Email::Simple->new($msg) || croak "can't parse message";
554    
555                                  $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";
556                                  $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";
557                                  $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";
558                                  $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";
559                                  $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 709  sub inbox_message { Line 706  sub inbox_message {
706    
707  Returns all received messages for given list or user.  Returns all received messages for given list or user.
708    
709   my @received = $nos->received_message(   my @received = $nos->received_messages(
710          list => 'My list',          list => 'My list',
711          email => "john.doe@example.com",          email => "john.doe@example.com",
712            from_date => '2005-01-01 10:15:00',
713            to_date => '2005-01-01 12:00:00',
714            message => 0,
715   );   );
716    
717    If don't specify C<list> or C<email> it will return all received messages.
718    Results will be sorted by received date, oldest first.
719    
720    Other optional parametars include:
721    
722    =over 10
723    
724    =item from_date
725    
726    Date (in ISO format) for lower limit of dates received
727    
728    =item to_date
729    
730    Return just messages older than this date
731    
732    =item message
733    
734    Include whole received message in result. This will probably make result
735    array very large. Use with care.
736    
737    =back
738    
739    Date ranges are inclusive, so results will include messages sent on
740    particular date specified with C<date_from> or C<date_to>.
741    
742  Each element in returned array will have following structure:  Each element in returned array will have following structure:
743    
744   {   my $row = {
745          id => 42,                       # unique ID of received message          id => 42,                       # unique ID of received message
746          list => 'My list',              # useful if filtering by email          list => 'My list',              # useful if filtering by email
747          ext_id => 9999,                 # ext_id from message sender          ext_id => 9999,                 # ext_id from message sender
# Line 725  Each element in returned array will have Line 750  Each element in returned array will have
750          date => '2005-08-24 18:57:24',  # date of receival in ISO format          date => '2005-08-24 18:57:24',  # date of receival in ISO format
751   }   }
752    
753    If you specified C<message> option, this hash will also have C<message> key
754    which will contain whole received message.
755    
756  =cut  =cut
757    
# Line 741  sub received_messages { Line 768  sub received_messages {
768                                  lists.name as list,                                  lists.name as list,
769                                  users.ext_id as ext_id,                                  users.ext_id as ext_id,
770                                  users.email as email,                                  users.email as email,
771            };
772            $sql .= qq{             message,} if ($arg->{'message'});
773            $sql .= qq{
774                                  bounced,received.date as date                                  bounced,received.date as date
775                          from received                          from received
776                          join lists on lists.id = list_id                          join lists on lists.id = list_id
777                          join users on users.id = user_id                          join users on users.id = user_id
778          };          };
779    
780            my $order = qq{ order by date asc };
781    
782          my $where;          my $where;
783    
784          $where->{'lists.name'} = lc($arg->{'list'}) if ($arg->{'list'});          $where->{'lists.name'} = lc($arg->{'list'}) if ($arg->{'list'});
785          $where->{'users.email'} = lc($arg->{'email'}) if ($arg->{'email'});          $where->{'users.email'} = lc($arg->{'email'}) if ($arg->{'email'});
786            $where->{'received.date'} = { '>=', $arg->{'date_from'} } if ($arg->{'date_from'});
787            $where->{'received.date'} = { '<=', $arg->{'date_to'} } if ($arg->{'date_to'});
788    
789          # hum, yammy one-liner          # hum, yammy one-liner
790          my($stmt, @bind)  = SQL::Abstract->new->where($where);          my($stmt, @bind)  = SQL::Abstract->new->where($where);
791    
792          my $dbh = $self->{'loader'}->find_class('received')->db_Main;          my $dbh = $self->{'loader'}->find_class('received')->db_Main;
793    
794          my $sth = $dbh->prepare($sql . $stmt);          my $sth = $dbh->prepare($sql . $stmt . $order);
795          $sth->execute(@bind);          $sth->execute(@bind);
796          return $sth->fetchall_hash;          return $sth->fetchall_hash;
797  }  }
# Line 829  sub _add_aliases { Line 863  sub _add_aliases {
863          $self_path =~ s#/[^/]+$##;          $self_path =~ s#/[^/]+$##;
864          $self_path =~ s#/t/*$#/#;          $self_path =~ s#/t/*$#/#;
865    
866          $target .= qq#| cd $self_path && ./sender.pl --inbox="$list"#;          $target .= qq#"| cd $self_path && ./sender.pl --inbox='$list'"#;
867    
868            # remove hostname from email to make Postfix's postalias happy
869            $email =~ s/@.+//;
870    
871          if ($a->exists($email)) {          if ($a->exists($email)) {
872                  $a->update($email, $target) or croak "can't update alias ".$a->error_check;                  $a->update($email, $target) or croak "can't update alias ".$a->error_check;
# Line 1079  sub AddMemberToList { Line 1116  sub AddMemberToList {
1116    
1117          if ($_[0] !~ m/^HASH/) {          if ($_[0] !~ m/^HASH/) {
1118                  return $nos->add_member_to_list(                  return $nos->add_member_to_list(
1119                          list => $_[0], email => $_[1], name => $_[2], ext_id => $_[4],                          list => $_[0], email => $_[1], name => $_[2], ext_id => $_[3],
1120                  );                  );
1121          } else {          } else {
1122                  return $nos->add_member_to_list( %{ shift @_ } );                  return $nos->add_member_to_list( %{ shift @_ } );
# Line 1162  Return statistics about received message Line 1199  Return statistics about received message
1199   my @result = MessagesReceived(   my @result = MessagesReceived(
1200          list => 'My list',          list => 'My list',
1201          email => 'jdoe@example.com',          email => 'jdoe@example.com',
1202            from_date => '2005-01-01 10:15:00',
1203            to_date => '2005-01-01 12:00:00',
1204            message => 0,
1205   );   );
1206    
1207  You must specify C<list> or C<email> or any combination of those.  You must specify C<list> or C<email> or any combination of those two. Other
1208    parametars are optional.
1209    
1210  For format of returned array element see C<received_messages>.  For format of returned array element see C<received_messages>.
1211    
# Line 1175  sub MessagesReceived { Line 1216  sub MessagesReceived {
1216    
1217          if ($_[0] !~ m/^HASH/) {          if ($_[0] !~ m/^HASH/) {
1218                  die "need at least list or email" unless (scalar @_ < 2);                  die "need at least list or email" unless (scalar @_ < 2);
1219                  return $nos->received_messages(                  return \@{ $nos->received_messages(
1220                          list => $_[0], email => $_[1],                          list => $_[0], email => $_[1],
1221                  );                          from_date => $_[2], to_date => $_[3],
1222                            message => $_[4]
1223                    ) };
1224          } else {          } else {
1225                  my $arg = shift;                  my $arg = shift;
1226                  die "need list or email argument" unless ($arg->{'list'} || $arg->{'email'});                  die "need list or email argument" unless ($arg->{'list'} || $arg->{'email'});
1227                  return $nos->received_messages( $arg );                  return \@{ $nos->received_messages( %{ $arg } ) };
1228          }          }
1229  }  }
1230    
1231  ###  ###
1232    
 =head1 UNIMPLEMENTED SOAP FUNCTIONS  
   
 This is a stub for documentation of unimplemented functions.  
   
 =head2 MessagesReceivedByDate  
   
 =head2 MessagesReceivedByDateWithContent  
   
 =head2 ReceivedMessageContent  
   
 Return content of received message.  
   
  my $mail_body = ReceivedMessageContent( id => 42 );  
   
   
   
   
1233  =head1 NOTE ON ARRAYS IN SOAP  =head1 NOTE ON ARRAYS IN SOAP
1234    
1235  Returning arrays from SOAP calls is somewhat fuzzy (at least to me). It  Returning arrays from SOAP calls is somewhat fuzzy (at least to me). It
Legend:
Removed from v.79  
changed lines
  Added in v.87
  ViewVC Help
Powered by ViewVC 1.1.26