/[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 60 by dpavlin, Tue Jun 21 21:24:10 2005 UTC revision 66 by dpavlin, Fri Jul 8 11:46:35 2005 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 Mail::Alias;
31    use Cwd qw(abs_path);
32    
33    
34  =head1 NAME  =head1 NAME
# Line 154  sub new_list { Line 156  sub new_list {
156  }  }
157    
158    
159    =head2 delete_list
160    
161    Delete list from database.
162    
163     my $ok = delete_list(
164            list => 'My list'
165     );
166    
167    Returns false if list doesn't exist.
168    
169    =cut
170    
171    sub delete_list {
172            my $self = shift;
173    
174            my $args = {@_};
175    
176            croak "need list to delete" unless ($args->{'list'});
177    
178            $args->{'list'} = lc($args->{'list'});
179    
180            my $lists = $self->{'loader'}->find_class('lists');
181    
182            my $this_list = $lists->search( name => $args->{'list'} )->first || return;
183    
184            $this_list->delete || croak "can't delete list\n";
185    
186            return $lists->dbi_commit || croak "can't commit";
187    }
188    
189    
190  =head2 add_member_to_list  =head2 add_member_to_list
191    
192  Add new member to list  Add new member to list
# Line 343  sub delete_member_from_list { Line 376  sub delete_member_from_list {
376          my $this_user = $user->search( email => $args->{'email'} )->first || croak "can't find user: ".$args->{'email'};          my $this_user = $user->search( email => $args->{'email'} )->first || croak "can't find user: ".$args->{'email'};
377          my $this_list = $list->search( name => $args->{'list'} )->first || croak "can't find list: ".$args->{'list'};          my $this_list = $list->search( name => $args->{'list'} )->first || croak "can't find list: ".$args->{'list'};
378    
379          my $this_user_list = $user_list->search_where( list_id => $this_list->id, user_id => $this_list->id )->first || return;          my $this_user_list = $user_list->search_where( list_id => $this_list->id, user_id => $this_user->id )->first || return;
380    
381          $this_user_list->delete || croak "can't delete user from list\n";          $this_user_list->delete || croak "can't delete user from list\n";
382    
# Line 489  sub send_queued_messages { Line 522  sub send_queued_messages {
522                          if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {                          if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {
523                                  print "SKIP $to_email message allready sent\n";                                  print "SKIP $to_email message allready sent\n";
524                          } else {                          } else {
525                                  print "=> $to_email\n";                                  print "=> $to_email ";
526    
527                                  my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id;                                  my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id;
528                                  my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} );                                  my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} );
# Line 515  sub send_queued_messages { Line 548  sub send_queued_messages {
548                                  $m_obj->header_set('X-Nos-Hash', $hash);                                  $m_obj->header_set('X-Nos-Hash', $hash);
549    
550                                  # really send e-mail                                  # really send e-mail
551                                    my $sent_status;
552    
553                                  if (@email_send_options) {                                  if (@email_send_options) {
554                                          send $email_send_driver => $m_obj->as_string, @email_send_options;                                          $sent_status = send $email_send_driver => $m_obj->as_string, @email_send_options;
555                                  } else {                                  } else {
556                                          send $email_send_driver => $m_obj->as_string;                                          $sent_status = send $email_send_driver => $m_obj->as_string;
557                                  }                                  }
558    
559                                  $sent->create({                                  croak "can't send e-mail: $sent_status\n\nOriginal e-mail follows:\n".$m_obj->as_string unless ($sent_status);
560                                          message_id => $m->message_id,                                  my @bad = @{ $sent_status->prop('bad') };
561                                          user_id => $u->user_id,                                  croak "failed sending to ",join(",",@bad) if (@bad);
562                                          hash => $hash,  
563                                  });                                  if ($sent_status) {
564                                  $sent->dbi_commit;  
565                                            $sent->create({
566                                                    message_id => $m->message_id,
567                                                    user_id => $u->user_id,
568                                                    hash => $hash,
569                                            });
570                                            $sent->dbi_commit;
571    
572                                            print " - $sent_status\n";
573    
574                                    } else {
575                                            warn "ERROR: $sent_status\n";
576                                    }
577    
578                                  if ($sleep) {                                  if ($sleep) {
579                                          warn "sleeping $sleep seconds\n";                                          warn "sleeping $sleep seconds\n";
# Line 642  sub inbox_message { Line 689  sub inbox_message {
689    
690  Beware of dragons! You shouldn't need to call those methods directly.  Beware of dragons! You shouldn't need to call those methods directly.
691    
692    
693    =head2 _add_aliases
694    
695    Add new list to C</etc/aliases> (or equivavlent) file
696    
697     my $ok = $nos->add_aliases(
698            list => 'My list',
699            email => 'my-list@example.com',
700            aliases => '/etc/mail/mylist',
701            archive => '/path/to/mbox/archive',
702    
703     );
704    
705    C<archive> parametar is optional.
706    
707    Return false on failure.
708    
709    =cut
710    
711    sub _add_aliases {
712            my $self = shift;
713    
714            my $arg = {@_};
715    
716            croak "need list and email options" unless ($arg->{'list'} && $arg->{'email'});
717    
718            my $aliases = $arg->{'aliases'} || croak "need aliases";
719    
720            unless (-e $aliases) {
721                    warn "aliases file $aliases doesn't exist, creating empty\n";
722                    open(my $fh, '>', $aliases) || croak "can't create $aliases: $!";
723                    close($fh);
724            }
725    
726            my $a = new Mail::Alias($aliases) || croak "can't open aliases file $aliases: $!";
727    
728            my $target = '';
729    
730            if (my $archive = $arg->{'archive'}) {
731                    $target .= "$archive, ";
732    
733                    if (! -e $archive) {
734                            warn "please make sure that file $archive is writable for your e-mail user (defaulting to bad 777 permission for now)";
735    
736                            open(my $fh, '>', $archive) || croak "can't create archive file $archive: $!";
737                            close($fh);
738                            chmod 0777, $archive || croak "can't chmod archive file $archive to 0777: $!";
739                    }
740            }
741    
742            # resolve my path to absolute one
743            my $self_path = abs_path($0);
744            $self_path =~ s#/[^/]+$##;
745            $self_path =~ s#/t/*$#/#;
746    
747            $target .= qq#| cd $self_path && ./sender.pl --inbox="$arg->{'list'}"#;
748    
749            unless ($a->append($arg->{'email'}, $target)) {
750                    croak "can't add alias ".$a->error_check;
751            }
752    
753            return 1;
754    }
755    
756  =head2 _add_list  =head2 _add_list
757    
758  Create new list  Create new list
# Line 650  Create new list Line 761  Create new list
761          list => 'My list',          list => 'My list',
762          from => 'Outgoing from comment',          from => 'Outgoing from comment',
763          email => 'my-list@example.com',          email => 'my-list@example.com',
764            aliases => '/etc/mail/mylist',
765   );   );
766    
767  Returns C<Class::DBI> object for created list.  Returns C<Class::DBI> object for created list.
# Line 668  sub _add_list { Line 780  sub _add_list {
780    
781          my $name = lc($arg->{'list'}) || confess "can't add list without name";          my $name = lc($arg->{'list'}) || confess "can't add list without name";
782          my $email = lc($arg->{'email'}) || confess "can't add list without e-mail";          my $email = lc($arg->{'email'}) || confess "can't add list without e-mail";
783            my $aliases = lc($arg->{'aliases'}) || confess "can't add list without path to aliases file";
784    
785          my $from_addr = $arg->{'from'};          my $from_addr = $arg->{'from'};
786    
787          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
788    
789            $self->_add_aliases(
790                    list => $name,
791                    email => $email,
792                    aliases => $aliases,
793            ) || croak "can't add alias $email for list $name";
794    
795          my $l = $lists->find_or_create({          my $l = $lists->find_or_create({
796                  name => $name,                  name => $name,
797                  email => $email,                  email => $email,
# Line 691  sub _add_list { Line 811  sub _add_list {
811  }  }
812    
813    
814    
815  =head2 _get_list  =head2 _get_list
816    
817  Get list C<Class::DBI> object.  Get list C<Class::DBI> object.
# Line 735  methods below). Line 856  methods below).
856    
857  my $nos;  my $nos;
858    
859    
860    =head2 new
861    
862    Create new SOAP object
863    
864     my $soap = new Nos::SOAP(
865            dsn => 'dbi:Pg:dbname=notices',
866            user => 'dpavlin',
867            passwd => '',
868            debug => 1,
869            verbose => 1,
870            hash_len => 8,
871            aliases => '/etc/aliases',
872     );
873    
874    =cut
875    
876  sub new {  sub new {
877          my $class = shift;          my $class = shift;
878          my $self = {@_};          my $self = {@_};
879    
880            croak "need aliases parametar" unless ($self->{'aliases'});
881    
882          bless($self, $class);          bless($self, $class);
883    
884          $nos = new Nos( @_ ) || die "can't create Nos object";          $nos = new Nos( @_ ) || die "can't create Nos object";
# Line 759  sub new { Line 900  sub new {
900  sub NewList {  sub NewList {
901          my $self = shift;          my $self = shift;
902    
903            my $aliases = $self->{'aliases'} || croak "Nos::SOAP need 'aliases' argument to new constructor";
904    
905          if ($_[0] !~ m/^HASH/) {          if ($_[0] !~ m/^HASH/) {
906                  return $nos->new_list(                  return $nos->new_list(
907                          list => $_[0], from => $_[1], email => $_[2],                          list => $_[0], from => $_[1], email => $_[2],
908                            aliases => $aliases,
909                  );                  );
910          } else {          } else {
911                  return $nos->new_list( %{ shift @_ } );                  return $nos->new_list( %{ shift @_ }, aliases => $aliases );
912          }          }
913  }  }
914    
915    
916    =head2 DeleteList
917    
918     $ok = DeleteList(
919            list => 'My list',
920     );
921    
922    =cut
923    
924    sub DeleteList {
925            my $self = shift;
926    
927            if ($_[0] !~ m/^HASH/) {
928                    return $nos->delete_list(
929                            list => $_[0],
930                    );
931            } else {
932                    return $nos->delete_list( %{ shift @_ } );
933            }
934    }
935    
936  =head2 AddMemberToList  =head2 AddMemberToList
937    
938   $member_id = AddMemberToList(   $member_id = AddMemberToList(
# Line 801  sub AddMemberToList { Line 965  sub AddMemberToList {
965    
966  Returns array of hashes with user informations, see C<list_members>.  Returns array of hashes with user informations, see C<list_members>.
967    
968    Returning arrays from SOAP calls is somewhat fuzzy (at least to me). It
969    seems that SOAP::Lite client thinks that it has array with one element which
970    is array of hashes with data.
971    
972  =cut  =cut
973    
974  sub ListMembers {  sub ListMembers {
# Line 814  sub ListMembers { Line 982  sub ListMembers {
982                  $list_name = $_[0]->{'list'};                  $list_name = $_[0]->{'list'};
983          }          }
984    
985          return $nos->list_members( list => $list_name );          return [ $nos->list_members( list => $list_name ) ];
986    }
987    
988    
989    =head2 DeleteMemberFromList
990    
991     $member_id = DeleteMemberFromList(
992            list => 'My list',
993            email => 'e-mail@example.com',
994     );
995    
996    =cut
997    
998    sub DeleteMemberFromList {
999            my $self = shift;
1000    
1001            if ($_[0] !~ m/^HASH/) {
1002                    return $nos->delete_member_from_list(
1003                            list => $_[0], email => $_[1],
1004                    );
1005            } else {
1006                    return $nos->delete_member_from_list( %{ shift @_ } );
1007            }
1008  }  }
1009    
1010    
1011  =head2 AddMessageToList  =head2 AddMessageToList
1012    
1013   $message_id = AddMessageToList(   $message_id = AddMessageToList(
Legend:
Removed from v.60  
changed lines
  Added in v.66
  ViewVC Help
Powered by ViewVC 1.1.26