/[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 74 by dpavlin, Wed Aug 24 17:19:16 2005 UTC revision 89 by dpavlin, Mon Dec 18 18:55:43 2006 UTC
# Line 16  our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all' Line 16  our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'
16  our @EXPORT = qw(  our @EXPORT = qw(
17  );  );
18    
19  our $VERSION = '0.7';  our $VERSION = '0.8';
20    
21  use Class::DBI::Loader;  use Class::DBI::Loader;
22  use Email::Valid;  use Email::Valid;
# 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 89  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 420  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 475  Send e-mail using SMTP server at 127.0.0 Line 478  Send e-mail using SMTP server at 127.0.0
478    
479  =back  =back
480    
481    Any other driver name will try to use C<Email::Send::that_driver> module.
482    
483  Default sleep wait between two messages is 3 seconds.  Default sleep wait between two messages is 3 seconds.
484    
485    This method will return number of succesfully sent messages.
486    
487  =cut  =cut
488    
489  sub send_queued_messages {  sub send_queued_messages {
# Line 489  sub send_queued_messages { Line 496  sub send_queued_messages {
496          my $sleep = $arg->{'sleep'};          my $sleep = $arg->{'sleep'};
497          $sleep ||= 3 unless defined($sleep);          $sleep ||= 3 unless defined($sleep);
498    
499            # number of messages sent o.k.
500            my $ok = 0;
501    
502          my $email_send_driver = 'Email::Send::IO';          my $email_send_driver = 'Email::Send::IO';
503          my @email_send_options;          my @email_send_options;
504    
505          if (lc($driver) eq 'smtp') {          if (lc($driver) eq 'smtp') {
506                  $email_send_driver = 'Email::Send::SMTP';                  $email_send_driver = 'Email::Send::SMTP';
507                  @email_send_options = ['127.0.0.1'];                  @email_send_options = ['127.0.0.1'];
508            } elsif ($driver && $driver ne '') {
509                    $email_send_driver = 'Email::Send::' . $driver;
510          } else {          } else {
511                  warn "dumping all messages to STDERR\n";                  warn "dumping all messages to STDERR\n";
512          }          }
# Line 546  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 564  sub send_queued_messages { Line 576  sub send_queued_messages {
576                                  }                                  }
577    
578                                  croak "can't send e-mail: $sent_status\n\nOriginal e-mail follows:\n".$m_obj->as_string unless ($sent_status);                                  croak "can't send e-mail: $sent_status\n\nOriginal e-mail follows:\n".$m_obj->as_string unless ($sent_status);
579                                  my @bad = @{ $sent_status->prop('bad') };                                  my @bad;
580                                    @bad = @{ $sent_status->prop('bad') } if (eval { $sent_status->can('prop') });
581                                  croak "failed sending to ",join(",",@bad) if (@bad);                                  croak "failed sending to ",join(",",@bad) if (@bad);
582    
583                                  if ($sent_status) {                                  if ($sent_status) {
# Line 578  sub send_queued_messages { Line 591  sub send_queued_messages {
591    
592                                          print " - $sent_status\n";                                          print " - $sent_status\n";
593    
594                                            $ok++;
595                                  } else {                                  } else {
596                                          warn "ERROR: $sent_status\n";                                          warn "ERROR: $sent_status\n";
597                                  }                                  }
# Line 593  sub send_queued_messages { Line 607  sub send_queued_messages {
607                  $m->dbi_commit;                  $m->dbi_commit;
608          }          }
609    
610            return $ok;
611    
612  }  }
613    
614  =head2 inbox_message  =head2 inbox_message
# Line 691  sub inbox_message { Line 707  sub inbox_message {
707  #       print "message_id: ",($message_id || "not found")," -- $is_bounce\n";  #       print "message_id: ",($message_id || "not found")," -- $is_bounce\n";
708  }  }
709    
710    =head2 received_messages
711    
712    Returns all received messages for given list or user.
713    
714     my @received = $nos->received_messages(
715            list => 'My list',
716            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:
748    
749     my $row = {
750            id => 42,                       # unique ID of received message
751            list => 'My list',              # useful if filtering by email
752            ext_id => 9999,                 # ext_id from message sender
753            email => 'jdoe@example.com',    # e-mail of message sender
754            bounced => 0,                   # true if message is bounce
755            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
762    
763    sub received_messages {
764            my $self = shift;
765    
766            my $arg = {@_} if (@_);
767    
768    #       croak "need list name or email" unless ($arg->{'list'} || $arg->{'email'});
769    
770            my $sql = qq{
771                            select
772                                    received.id as id,
773                                    lists.name as list,
774                                    users.ext_id as ext_id,
775                                    users.email as email,
776            };
777            $sql .= qq{             message,} if ($arg->{'message'});
778            $sql .= qq{
779                                    bounced,received.date as date
780                            from received
781                            join lists on lists.id = list_id
782                            join users on users.id = user_id
783            };
784    
785            my $order = qq{ order by date asc };
786    
787            my $where;
788    
789            $where->{'lists.name'} = lc($arg->{'list'}) if ($arg->{'list'});
790            $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
795            my($stmt, @bind)  = SQL::Abstract->new->where($where);
796    
797            my $dbh = $self->{'loader'}->find_class('received')->db_Main;
798    
799            my $sth = $dbh->prepare($sql . $stmt . $order);
800            $sth->execute(@bind);
801            return $sth->fetchall_hash;
802    }
803    
804    
805  =head1 INTERNAL METHODS  =head1 INTERNAL METHODS
806    
# Line 758  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 766  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 923  Create new SOAP object Line 1036  Create new SOAP object
1036          aliases => '/etc/aliases',          aliases => '/etc/aliases',
1037   );   );
1038    
1039    If you are writing SOAP server (like C<soap.cgi> example), you will need to
1040    call this method once to make new instance of Nos::SOAP and specify C<dsn>
1041    and options for it.
1042    
1043  =cut  =cut
1044    
1045  sub new {  sub new {
# Line 1004  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 1080  sub AddMessageToList { Line 1197  sub AddMessageToList {
1197          }          }
1198  }  }
1199    
 =head1 UNIMPLEMENTED FUNCTIONS  
   
 This is a stub for documentation of unimplemented functions.  
   
1200  =head2 MessagesReceived  =head2 MessagesReceived
1201    
1202    Return statistics about received messages.
1203    
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 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
1213    parametars are optional.
1214    
1215  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 );  
1216    
1217  =cut  =cut
1218    
1219    sub MessagesReceived {
1220            my $self = shift;
1221    
1222            if ($_[0] !~ m/^HASH/) {
1223                    die "need at least list or email" unless (scalar @_ < 2);
1224                    return \@{ $nos->received_messages(
1225                            list => $_[0], email => $_[1],
1226                            from_date => $_[2], to_date => $_[3],
1227                            message => $_[4]
1228                    ) };
1229            } else {
1230                    my $arg = shift;
1231                    die "need list or email argument" unless ($arg->{'list'} || $arg->{'email'});
1232                    return \@{ $nos->received_messages( %{ $arg } ) };
1233            }
1234    }
1235    
1236  ###  ###
1237    
Legend:
Removed from v.74  
changed lines
  Added in v.89
  ViewVC Help
Powered by ViewVC 1.1.26