/[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 72 by dpavlin, Mon Aug 22 20:24:04 2005 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.5';  our $VERSION = '0.7';
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 Mail::Alias;
31    use Cwd qw(abs_path);
32    
33    
34  =head1 NAME  =head1 NAME
# Line 118  sub new { Line 120  sub new {
120  }  }
121    
122    
123  =head2 new_list  =head2 create_list
124    
125  Create new list. Required arguments are name of C<list> and  Create new list. Required arguments are name of C<list>, C<email> address
126  C<email> address.  and path to C<aliases> file.
127    
128   $nos->new_list(   $nos->create_list(
129          list => 'My list',          list => 'My list',
130          from => 'Outgoing from comment',          from => 'Outgoing from comment',
131          email => 'my-list@example.com',          email => 'my-list@example.com',
132            aliases => '/etc/mail/mylist',
133            archive => '/path/to/mbox/archive',
134   );   );
135    
136  Returns ID of newly created list.  Returns ID of newly created list.
# Line 135  Calls internally C<_add_list>, see detai Line 139  Calls internally C<_add_list>, see detai
139    
140  =cut  =cut
141    
142  sub new_list {  sub create_list {
143          my $self = shift;          my $self = shift;
144    
145          my $arg = {@_};          my $arg = {@_};
# Line 154  sub new_list { Line 158  sub new_list {
158  }  }
159    
160    
161    =head2 drop_list
162    
163    Delete list from database.
164    
165     my $ok = drop_list(
166            list => 'My list'
167            aliases => '/etc/mail/mylist',
168     );
169    
170    Returns false if list doesn't exist.
171    
172    =cut
173    
174    sub drop_list {
175            my $self = shift;
176    
177            my $args = {@_};
178    
179            croak "need list to delete" unless ($args->{'list'});
180    
181            $args->{'list'} = lc($args->{'list'});
182    
183            my $aliases = $args->{'aliases'} || croak "need path to aliases file";
184    
185            my $lists = $self->{'loader'}->find_class('lists');
186    
187            my $this_list = $lists->search( name => $args->{'list'} )->first || return;
188    
189            $self->_remove_alias( email => $this_list->email, aliases => $aliases);
190    
191            $this_list->delete || croak "can't delete list\n";
192    
193            return $lists->dbi_commit || croak "can't commit";
194    }
195    
196    
197  =head2 add_member_to_list  =head2 add_member_to_list
198    
199  Add new member to list  Add new member to list
# Line 343  sub delete_member_from_list { Line 383  sub delete_member_from_list {
383          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'};
384          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'};
385    
386          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;
387    
388          $this_user_list->delete || croak "can't delete user from list\n";          $this_user_list->delete || croak "can't delete user from list\n";
389    
# Line 489  sub send_queued_messages { Line 529  sub send_queued_messages {
529                          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 )) {
530                                  print "SKIP $to_email message allready sent\n";                                  print "SKIP $to_email message allready sent\n";
531                          } else {                          } else {
532                                  print "=> $to_email\n";                                  print "=> $to_email ";
533    
534                                  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;
535                                  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 555  sub send_queued_messages {
555                                  $m_obj->header_set('X-Nos-Hash', $hash);                                  $m_obj->header_set('X-Nos-Hash', $hash);
556    
557                                  # really send e-mail                                  # really send e-mail
558                                    my $sent_status;
559    
560                                  if (@email_send_options) {                                  if (@email_send_options) {
561                                          send $email_send_driver => $m_obj->as_string, @email_send_options;                                          $sent_status = send $email_send_driver => $m_obj->as_string, @email_send_options;
562                                  } else {                                  } else {
563                                          send $email_send_driver => $m_obj->as_string;                                          $sent_status = send $email_send_driver => $m_obj->as_string;
564                                  }                                  }
565    
566                                  $sent->create({                                  croak "can't send e-mail: $sent_status\n\nOriginal e-mail follows:\n".$m_obj->as_string unless ($sent_status);
567                                          message_id => $m->message_id,                                  my @bad = @{ $sent_status->prop('bad') };
568                                          user_id => $u->user_id,                                  croak "failed sending to ",join(",",@bad) if (@bad);
569                                          hash => $hash,  
570                                  });                                  if ($sent_status) {
571                                  $sent->dbi_commit;  
572                                            $sent->create({
573                                                    message_id => $m->message_id,
574                                                    user_id => $u->user_id,
575                                                    hash => $hash,
576                                            });
577                                            $sent->dbi_commit;
578    
579                                            print " - $sent_status\n";
580    
581                                    } else {
582                                            warn "ERROR: $sent_status\n";
583                                    }
584    
585                                  if ($sleep) {                                  if ($sleep) {
586                                          warn "sleeping $sleep seconds\n";                                          warn "sleeping $sleep seconds\n";
# Line 642  sub inbox_message { Line 696  sub inbox_message {
696    
697  Beware of dragons! You shouldn't need to call those methods directly.  Beware of dragons! You shouldn't need to call those methods directly.
698    
699    
700    =head2 _add_aliases
701    
702    Add or update alias in C</etc/aliases> (or equivalent) file for selected list
703    
704     my $ok = $nos->add_aliases(
705            list => 'My list',
706            email => 'my-list@example.com',
707            aliases => '/etc/mail/mylist',
708            archive => '/path/to/mbox/archive',
709    
710     );
711    
712    C<archive> parametar is optional.
713    
714    Return false on failure.
715    
716    =cut
717    
718    sub _add_aliases {
719            my $self = shift;
720    
721            my $arg = {@_};
722    
723            foreach my $o (qw/list email aliases/) {
724                    croak "need $o option" unless ($arg->{$o});
725            }
726    
727            my $aliases = $arg->{'aliases'};
728            my $email = $arg->{'email'};
729            my $list = $arg->{'list'};
730    
731            unless (-e $aliases) {
732                    warn "aliases file $aliases doesn't exist, creating empty\n";
733                    open(my $fh, '>', $aliases) || croak "can't create $aliases: $!";
734                    close($fh);
735                    chmod 0777, $aliases || warn "can't change permission to 0777";
736            }
737    
738            die "FATAL: aliases file $aliases is not writable\n" unless (-w $aliases);
739    
740            my $a = new Mail::Alias($aliases) || croak "can't open aliases file $aliases: $!";
741    
742            my $target = '';
743    
744            if (my $archive = $arg->{'archive'}) {
745                    $target .= "$archive, ";
746    
747                    if (! -e $archive) {
748                            warn "please make sure that file $archive is writable for your e-mail user (defaulting to bad 777 permission for now)";
749    
750                            open(my $fh, '>', $archive) || croak "can't create archive file $archive: $!";
751                            close($fh);
752                            chmod 0777, $archive || croak "can't chmod archive file $archive to 0777: $!";
753                    }
754            }
755    
756            # resolve my path to absolute one
757            my $self_path = abs_path($0);
758            $self_path =~ s#/[^/]+$##;
759            $self_path =~ s#/t/*$#/#;
760    
761            $target .= qq#| cd $self_path && ./sender.pl --inbox="$list"#;
762    
763            if ($a->exists($email)) {
764                    $a->update($email, $target) or croak "can't update alias ".$a->error_check;
765            } else {
766                    $a->append($email, $target) or croak "can't add alias ".$a->error_check;
767            }
768    
769            #$a->write($aliases) or croak "can't save aliases $aliases ".$a->error_check;
770    
771            return 1;
772    }
773    
774  =head2 _add_list  =head2 _add_list
775    
776  Create new list  Create new list
# Line 650  Create new list Line 779  Create new list
779          list => 'My list',          list => 'My list',
780          from => 'Outgoing from comment',          from => 'Outgoing from comment',
781          email => 'my-list@example.com',          email => 'my-list@example.com',
782            aliases => '/etc/mail/mylist',
783   );   );
784    
785  Returns C<Class::DBI> object for created list.  Returns C<Class::DBI> object for created list.
# Line 668  sub _add_list { Line 798  sub _add_list {
798    
799          my $name = lc($arg->{'list'}) || confess "can't add list without name";          my $name = lc($arg->{'list'}) || confess "can't add list without name";
800          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";
801            my $aliases = lc($arg->{'aliases'}) || confess "can't add list without path to aliases file";
802    
803          my $from_addr = $arg->{'from'};          my $from_addr = $arg->{'from'};
804    
805          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
806    
807            $self->_add_aliases(
808                    list => $name,
809                    email => $email,
810                    aliases => $aliases,
811            ) || warn "can't add alias $email for list $name";
812    
813          my $l = $lists->find_or_create({          my $l = $lists->find_or_create({
814                  name => $name,                  name => $name,
815                  email => $email,                  email => $email,
# Line 691  sub _add_list { Line 829  sub _add_list {
829  }  }
830    
831    
832    
833  =head2 _get_list  =head2 _get_list
834    
835  Get list C<Class::DBI> object.  Get list C<Class::DBI> object.
# Line 711  sub _get_list { Line 850  sub _get_list {
850          return $lists->search({ name => lc($name) })->first;          return $lists->search({ name => lc($name) })->first;
851  }  }
852    
853    
854    =head2 _remove_alias
855    
856    Remove list alias
857    
858     my $ok = $nos->_remove_alias(
859            email => 'mylist@example.com',
860            aliases => '/etc/mail/mylist',
861     );
862    
863    Returns true if list is removed or false if list doesn't exist. Dies in case of error.
864    
865    =cut
866    
867    sub _remove_alias {
868            my $self = shift;
869    
870            my $arg = {@_};
871    
872            my $email = lc($arg->{'email'}) || confess "can't remove alias without email";
873            my $aliases = lc($arg->{'aliases'}) || confess "can't remove alias without list";
874    
875            my $a = new Mail::Alias($aliases) || croak "can't open aliases file $aliases: $!";
876    
877            if ($a->exists($email)) {
878                    $a->delete($email) || croak "can't remove alias $email";
879            } else {
880                    return 0;
881            }
882    
883            return 1;
884    
885    }
886    
887  ###  ###
888  ### SOAP  ### SOAP
889  ###  ###
# Line 735  methods below). Line 908  methods below).
908    
909  my $nos;  my $nos;
910    
911    
912    =head2 new
913    
914    Create new SOAP object
915    
916     my $soap = new Nos::SOAP(
917            dsn => 'dbi:Pg:dbname=notices',
918            user => 'dpavlin',
919            passwd => '',
920            debug => 1,
921            verbose => 1,
922            hash_len => 8,
923            aliases => '/etc/aliases',
924     );
925    
926    =cut
927    
928  sub new {  sub new {
929          my $class = shift;          my $class = shift;
930          my $self = {@_};          my $self = {@_};
931    
932            croak "need aliases parametar" unless ($self->{'aliases'});
933    
934          bless($self, $class);          bless($self, $class);
935    
936          $nos = new Nos( @_ ) || die "can't create Nos object";          $nos = new Nos( @_ ) || die "can't create Nos object";
# Line 746  sub new { Line 939  sub new {
939  }  }
940    
941    
942  =head2 NewList  =head2 CreateList
943    
944   $message_id = NewList(   $message_id = CreateList(
945          list => 'My list',          list => 'My list',
946          from => 'Name of my list',          from => 'Name of my list',
947          email => 'my-list@example.com'          email => 'my-list@example.com'
# Line 756  sub new { Line 949  sub new {
949    
950  =cut  =cut
951    
952  sub NewList {  sub CreateList {
953          my $self = shift;          my $self = shift;
954    
955            my $aliases = $nos->{'aliases'} || croak "need 'aliases' argument to new constructor";
956    
957          if ($_[0] !~ m/^HASH/) {          if ($_[0] !~ m/^HASH/) {
958                  return $nos->new_list(                  return $nos->create_list(
959                          list => $_[0], from => $_[1], email => $_[2],                          list => $_[0], from => $_[1], email => $_[2],
960                            aliases => $aliases,
961                  );                  );
962          } else {          } else {
963                  return $nos->new_list( %{ shift @_ } );                  return $nos->create_list( %{ shift @_ }, aliases => $aliases );
964          }          }
965  }  }
966    
967    
968    =head2 DropList
969    
970     $ok = DropList(
971            list => 'My list',
972     );
973    
974    =cut
975    
976    sub DropList {
977            my $self = shift;
978    
979            my $aliases = $nos->{'aliases'} || croak "need 'aliases' argument to new constructor";
980    
981            if ($_[0] !~ m/^HASH/) {
982                    return $nos->drop_list(
983                            list => $_[0],
984                            aliases => $aliases,
985                    );
986            } else {
987                    return $nos->drop_list( %{ shift @_ }, aliases => $aliases );
988            }
989    }
990    
991  =head2 AddMemberToList  =head2 AddMemberToList
992    
993   $member_id = AddMemberToList(   $member_id = AddMemberToList(
# Line 801  sub AddMemberToList { Line 1020  sub AddMemberToList {
1020    
1021  Returns array of hashes with user informations, see C<list_members>.  Returns array of hashes with user informations, see C<list_members>.
1022    
1023    Returning arrays from SOAP calls is somewhat fuzzy (at least to me). It
1024    seems that SOAP::Lite client thinks that it has array with one element which
1025    is array of hashes with data.
1026    
1027  =cut  =cut
1028    
1029  sub ListMembers {  sub ListMembers {
# Line 814  sub ListMembers { Line 1037  sub ListMembers {
1037                  $list_name = $_[0]->{'list'};                  $list_name = $_[0]->{'list'};
1038          }          }
1039    
1040          return $nos->list_members( list => $list_name );          return [ $nos->list_members( list => $list_name ) ];
1041  }  }
1042    
1043    
1044    =head2 DeleteMemberFromList
1045    
1046     $member_id = DeleteMemberFromList(
1047            list => 'My list',
1048            email => 'e-mail@example.com',
1049     );
1050    
1051    =cut
1052    
1053    sub DeleteMemberFromList {
1054            my $self = shift;
1055    
1056            if ($_[0] !~ m/^HASH/) {
1057                    return $nos->delete_member_from_list(
1058                            list => $_[0], email => $_[1],
1059                    );
1060            } else {
1061                    return $nos->delete_member_from_list( %{ shift @_ } );
1062            }
1063    }
1064    
1065    
1066  =head2 AddMessageToList  =head2 AddMessageToList
1067    
1068   $message_id = AddMessageToList(   $message_id = AddMessageToList(
Legend:
Removed from v.60  
changed lines
  Added in v.72
  ViewVC Help
Powered by ViewVC 1.1.26