/[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 75 by dpavlin, Wed Aug 24 21:27:40 2005 UTC revision 87 by dpavlin, Thu Sep 21 10:49:00 2006 UTC
# Line 27  use Email::Simple; Line 27  use Email::Simple;
27  use Email::Address;  use Email::Address;
28  use Mail::DeliveryStatus::BounceParser;  use Mail::DeliveryStatus::BounceParser;
29  use Class::DBI::AbstractSearch;  use Class::DBI::AbstractSearch;
30    use SQL::Abstract;
31  use Mail::Alias;  use Mail::Alias;
32  use Cwd qw(abs_path);  use Cwd qw(abs_path);
33    
# Line 116  sub new { Line 117  sub new {
117    
118          $self->{'hash_len'} ||= 8;          $self->{'hash_len'} ||= 8;
119    
         $self->{'loader'}->find_class('received')->set_sql(  
                 'received' => 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  
                 },  
         );  
   
120          $self ? return $self : return undef;          $self ? return $self : return undef;
121  }  }
122    
# Line 434  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 569  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 722  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  This method is used by C<sender.pl> when receiving e-mail messages.  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:
743    
744     my $row = {
745            id => 42,                       # unique ID of received message
746            list => 'My list',              # useful if filtering by email
747            ext_id => 9999,                 # ext_id from message sender
748            email => 'jdoe@example.com',    # e-mail of message sender
749            bounced => 0,                   # true if message is bounce
750            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    
758  sub received_messages {  sub received_messages {
759          my $self = shift;          my $self = shift;
760    
761          my $arg = {@_};          my $arg = {@_} if (@_);
762    
763          croak "need list name or email" unless ($arg->{'list'} || $arg->{'email'});  #       croak "need list name or email" unless ($arg->{'list'} || $arg->{'email'});
764    
765          $arg->{'list'} = lc($arg->{'list'});          my $sql = qq{
766          $arg->{'email'} = lc($arg->{'email'});                          select
767                                    received.id as id,
768                                    lists.name as list,
769                                    users.ext_id as ext_id,
770                                    users.email as email,
771            };
772            $sql .= qq{             message,} if ($arg->{'message'});
773            $sql .= qq{
774                                    bounced,received.date as date
775                            from received
776                            join lists on lists.id = list_id
777                            join users on users.id = user_id
778            };
779    
780          my $rcvd = $self->{'loader'}->find_class('received')->search_received();          my $order = qq{ order by date asc };
781    
782          return $rcvd;          my $where;
783    
784            $where->{'lists.name'} = lc($arg->{'list'}) if ($arg->{'list'});
785            $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
790            my($stmt, @bind)  = SQL::Abstract->new->where($where);
791    
792            my $dbh = $self->{'loader'}->find_class('received')->db_Main;
793    
794            my $sth = $dbh->prepare($sql . $stmt . $order);
795            $sth->execute(@bind);
796            return $sth->fetchall_hash;
797  }  }
798    
799    
# Line 813  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 1063  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 1139  sub AddMessageToList { Line 1192  sub AddMessageToList {
1192          }          }
1193  }  }
1194    
 =head1 UNIMPLEMENTED FUNCTIONS  
   
 This is a stub for documentation of unimplemented functions.  
   
1195  =head2 MessagesReceived  =head2 MessagesReceived
1196    
1197    Return statistics about received messages.
1198    
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 can specify just 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  It will return array of hashes with following structure:  For format of returned array element see C<received_messages>.
   
  {  
         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  
  }  
   
 =head2 MessagesReceivedByDate  
   
 =head2 MessagesReceivedByDateWithContent  
   
 =head2 ReceivedMessasgeContent  
   
 Return content of received message.  
   
  my $mail_body = ReceivedMessageContent( id => 42 );  
1211    
1212  =cut  =cut
1213    
1214    sub MessagesReceived {
1215            my $self = shift;
1216    
1217            if ($_[0] !~ m/^HASH/) {
1218                    die "need at least list or email" unless (scalar @_ < 2);
1219                    return \@{ $nos->received_messages(
1220                            list => $_[0], email => $_[1],
1221                            from_date => $_[2], to_date => $_[3],
1222                            message => $_[4]
1223                    ) };
1224            } else {
1225                    my $arg = shift;
1226                    die "need list or email argument" unless ($arg->{'list'} || $arg->{'email'});
1227                    return \@{ $nos->received_messages( %{ $arg } ) };
1228            }
1229    }
1230    
1231  ###  ###
1232    
Legend:
Removed from v.75  
changed lines
  Added in v.87
  ViewVC Help
Powered by ViewVC 1.1.26