/[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 89 by dpavlin, Mon Dec 18 18:55:43 2006 UTC
# Line 90  Create new instance specifing database, Line 90  Create new instance specifing database,
90          debug => 1,          debug => 1,
91          verbose => 1,          verbose => 1,
92          hash_len => 8,          hash_len => 8,
93            full_hostname_in_aliases => 0,
94   );   );
95    
96  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
97  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.
98    
99    C<full_hostname_in_aliases> will turn on old behaviour (not supported by Postfix
100    postalias) to include full hostname in aliases file.
101    
102    
103  =cut  =cut
104    
105  sub new {  sub new {
106          my $class = shift;          my $class = shift;
107          my $self = {@_};          my $self = {@_};
108          bless($self, $class);          bless($self, $class);
109    
110          croak "need at least dsn" unless ($self->{'dsn'});          croak "need at least dsn" unless ($self->{'dsn'});
# Line 421  sub add_message_to_list { Line 426  sub add_message_to_list {
426    
427          my $m = Email::Simple->new($message_text) || croak "can't parse message";          my $m = Email::Simple->new($message_text) || croak "can't parse message";
428    
429          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;  
         }  
430    
431          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
432    
# Line 556  sub send_queued_messages { Line 558  sub send_queued_messages {
558                                  my $m_obj = Email::Simple->new($msg) || croak "can't parse message";                                  my $m_obj = Email::Simple->new($msg) || croak "can't parse message";
559    
560                                  $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";
561                                  $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";
562                                  $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";
563                                  $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";
564                                  $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 711  sub inbox_message {
711    
712  Returns all received messages for given list or user.  Returns all received messages for given list or user.
713    
714   my @received = $nos->received_message(   my @received = $nos->received_messages(
715          list => 'My list',          list => 'My list',
716          email => "john.doe@example.com",          email => "john.doe@example.com",
717            from_date => '2005-01-01 10:15:00',
718            to_date => '2005-01-01 12:00:00',
719            message => 0,
720   );   );
721    
722    If don't specify C<list> or C<email> it will return all received messages.
723    Results will be sorted by received date, oldest first.
724    
725    Other optional parametars include:
726    
727    =over 10
728    
729    =item from_date
730    
731    Date (in ISO format) for lower limit of dates received
732    
733    =item to_date
734    
735    Return just messages older than this date
736    
737    =item message
738    
739    Include whole received message in result. This will probably make result
740    array very large. Use with care.
741    
742    =back
743    
744    Date ranges are inclusive, so results will include messages sent on
745    particular date specified with C<date_from> or C<date_to>.
746    
747  Each element in returned array will have following structure:  Each element in returned array will have following structure:
748    
749   {   my $row = {
750          id => 42,                       # unique ID of received message          id => 42,                       # unique ID of received message
751          list => 'My list',              # useful if filtering by email          list => 'My list',              # useful if filtering by email
752          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 755  Each element in returned array will have
755          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
756   }   }
757    
758    If you specified C<message> option, this hash will also have C<message> key
759    which will contain whole received message.
760    
761  =cut  =cut
762    
# Line 741  sub received_messages { Line 773  sub received_messages {
773                                  lists.name as list,                                  lists.name as list,
774                                  users.ext_id as ext_id,                                  users.ext_id as ext_id,
775                                  users.email as email,                                  users.email as email,
776            };
777            $sql .= qq{             message,} if ($arg->{'message'});
778            $sql .= qq{
779                                  bounced,received.date as date                                  bounced,received.date as date
780                          from received                          from received
781                          join lists on lists.id = list_id                          join lists on lists.id = list_id
782                          join users on users.id = user_id                          join users on users.id = user_id
783          };          };
784    
785            my $order = qq{ order by date asc };
786    
787          my $where;          my $where;
788    
789          $where->{'lists.name'} = lc($arg->{'list'}) if ($arg->{'list'});          $where->{'lists.name'} = lc($arg->{'list'}) if ($arg->{'list'});
790          $where->{'users.email'} = lc($arg->{'email'}) if ($arg->{'email'});          $where->{'users.email'} = lc($arg->{'email'}) if ($arg->{'email'});
791            $where->{'received.date'} = { '>=', $arg->{'date_from'} } if ($arg->{'date_from'});
792            $where->{'received.date'} = { '<=', $arg->{'date_to'} } if ($arg->{'date_to'});
793    
794          # hum, yammy one-liner          # hum, yammy one-liner
795          my($stmt, @bind)  = SQL::Abstract->new->where($where);          my($stmt, @bind)  = SQL::Abstract->new->where($where);
796    
797          my $dbh = $self->{'loader'}->find_class('received')->db_Main;          my $dbh = $self->{'loader'}->find_class('received')->db_Main;
798    
799          my $sth = $dbh->prepare($sql . $stmt);          my $sth = $dbh->prepare($sql . $stmt . $order);
800          $sth->execute(@bind);          $sth->execute(@bind);
801          return $sth->fetchall_hash;          return $sth->fetchall_hash;
802  }  }
# Line 829  sub _add_aliases { Line 868  sub _add_aliases {
868          $self_path =~ s#/[^/]+$##;          $self_path =~ s#/[^/]+$##;
869          $self_path =~ s#/t/*$#/#;          $self_path =~ s#/t/*$#/#;
870    
871          $target .= qq#| cd $self_path && ./sender.pl --inbox="$list"#;          $target .= qq#"| cd $self_path && ./sender.pl --inbox='$list'"#;
872    
873            # remove hostname from email to make Postfix's postalias happy
874            $email =~ s/@.+// if (not $self->{full_hostname_in_aliases});
875    
876          if ($a->exists($email)) {          if ($a->exists($email)) {
877                  $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 837  sub _add_aliases { Line 879  sub _add_aliases {
879                  $a->append($email, $target) or croak "can't add alias ".$a->error_check;                  $a->append($email, $target) or croak "can't add alias ".$a->error_check;
880          }          }
881    
882          #$a->write($aliases) or croak "can't save aliases $aliases ".$a->error_check;  #       $a->write($aliases) or croak "can't save aliases $aliases ".$a->error_check;
883    
884          return 1;          return 1;
885  }  }
# Line 1079  sub AddMemberToList { Line 1121  sub AddMemberToList {
1121    
1122          if ($_[0] !~ m/^HASH/) {          if ($_[0] !~ m/^HASH/) {
1123                  return $nos->add_member_to_list(                  return $nos->add_member_to_list(
1124                          list => $_[0], email => $_[1], name => $_[2], ext_id => $_[4],                          list => $_[0], email => $_[1], name => $_[2], ext_id => $_[3],
1125                  );                  );
1126          } else {          } else {
1127                  return $nos->add_member_to_list( %{ shift @_ } );                  return $nos->add_member_to_list( %{ shift @_ } );
# Line 1162  Return statistics about received message Line 1204  Return statistics about received message
1204   my @result = MessagesReceived(   my @result = MessagesReceived(
1205          list => 'My list',          list => 'My list',
1206          email => 'jdoe@example.com',          email => 'jdoe@example.com',
1207            from_date => '2005-01-01 10:15:00',
1208            to_date => '2005-01-01 12:00:00',
1209            message => 0,
1210   );   );
1211    
1212  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
1213    parametars are optional.
1214    
1215  For format of returned array element see C<received_messages>.  For format of returned array element see C<received_messages>.
1216    
# Line 1175  sub MessagesReceived { Line 1221  sub MessagesReceived {
1221    
1222          if ($_[0] !~ m/^HASH/) {          if ($_[0] !~ m/^HASH/) {
1223                  die "need at least list or email" unless (scalar @_ < 2);                  die "need at least list or email" unless (scalar @_ < 2);
1224                  return $nos->received_messages(                  return \@{ $nos->received_messages(
1225                          list => $_[0], email => $_[1],                          list => $_[0], email => $_[1],
1226                  );                          from_date => $_[2], to_date => $_[3],
1227                            message => $_[4]
1228                    ) };
1229          } else {          } else {
1230                  my $arg = shift;                  my $arg = shift;
1231                  die "need list or email argument" unless ($arg->{'list'} || $arg->{'email'});                  die "need list or email argument" unless ($arg->{'list'} || $arg->{'email'});
1232                  return $nos->received_messages( $arg );                  return \@{ $nos->received_messages( %{ $arg } ) };
1233          }          }
1234  }  }
1235    
1236  ###  ###
1237    
 =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 );  
   
   
   
   
1238  =head1 NOTE ON ARRAYS IN SOAP  =head1 NOTE ON ARRAYS IN SOAP
1239    
1240  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.89
  ViewVC Help
Powered by ViewVC 1.1.26