/[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 80 by dpavlin, Fri Aug 26 05:38:00 2005 UTC revision 90 by dpavlin, Mon Dec 18 19:35:04 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 739  array very large. Use with care. Line 741  array very large. Use with care.
741    
742  =back  =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 = {   my $row = {
# Line 777  sub received_messages { Line 782  sub received_messages {
782                          join users on users.id = user_id                          join users on users.id = user_id
783          };          };
784    
785          my $order = qq{ order by date desc };          my $order = qq{ order by date asc };
786    
787          my $where;          my $where;
788    
# Line 863  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 871  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 1035  and options for it. Line 1043  and options for it.
1043  =cut  =cut
1044    
1045  sub new {  sub new {
1046          my $class = shift;          my $class = shift;
1047          my $self = {@_};          my $self = {@_};
1048    
1049          croak "need aliases parametar" unless ($self->{'aliases'});          croak "need aliases parametar" unless ($self->{'aliases'});
1050    
# Line 1113  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 1213  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],                          from_date => $_[2], to_date => $_[3],
1227                          message => $_[4]                          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    
1238  =head1 UNIMPLEMENTED SOAP FUNCTIONS  =head1 NOTE ON ARRAYS IN SOAP
   
 This is a stub for documentation of unimplemented functions.  
   
 =head2 MessagesReceivedByDate  
   
 =head2 MessagesReceivedByDateWithContent  
   
 =head2 ReceivedMessageContent  
1239    
1240  Return content of received message.  Returning arrays from SOAP calls is somewhat fuzzy (at least to me). It
1241    seems that SOAP::Lite client thinks that it has array with one element which
1242    is array of hashes with data.
1243    
1244   my $mail_body = ReceivedMessageContent( id => 42 );  =head1 PRIVATE METHODS
1245    
1246    Documented here because tests use them
1247    
1248    =head2 _nos_object
1249    
1250      my $nos = $nos->_nos_object;
1251    
1252  =head1 NOTE ON ARRAYS IN SOAP  =cut
1253    
1254  Returning arrays from SOAP calls is somewhat fuzzy (at least to me). It  sub _nos_object {
1255  seems that SOAP::Lite client thinks that it has array with one element which          return $nos;
1256  is array of hashes with data.  }
1257    
1258  =head1 EXPORT  =head1 EXPORT
1259    
Legend:
Removed from v.80  
changed lines
  Added in v.90
  ViewVC Help
Powered by ViewVC 1.1.26