/[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 68 by dpavlin, Mon Aug 1 08:59:36 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.6';
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 120  sub new { Line 122  sub new {
122    
123  =head2 new_list  =head2 new_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->new_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 154  sub new_list { Line 158  sub new_list {
158  }  }
159    
160    
161    =head2 delete_list
162    
163    Delete list from database.
164    
165     my $ok = delete_list(
166            list => 'My list'
167     );
168    
169    Returns false if list doesn't exist.
170    
171    =cut
172    
173    sub delete_list {
174            my $self = shift;
175    
176            my $args = {@_};
177    
178            croak "need list to delete" unless ($args->{'list'});
179    
180            $args->{'list'} = lc($args->{'list'});
181    
182            my $lists = $self->{'loader'}->find_class('lists');
183    
184            my $this_list = $lists->search( name => $args->{'list'} )->first || return;
185    
186            $this_list->delete || croak "can't delete list\n";
187    
188            return $lists->dbi_commit || croak "can't commit";
189    }
190    
191    
192  =head2 add_member_to_list  =head2 add_member_to_list
193    
194  Add new member to list  Add new member to list
# Line 343  sub delete_member_from_list { Line 378  sub delete_member_from_list {
378          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'};
379          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'};
380    
381          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;
382    
383          $this_user_list->delete || croak "can't delete user from list\n";          $this_user_list->delete || croak "can't delete user from list\n";
384    
# Line 489  sub send_queued_messages { Line 524  sub send_queued_messages {
524                          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 )) {
525                                  print "SKIP $to_email message allready sent\n";                                  print "SKIP $to_email message allready sent\n";
526                          } else {                          } else {
527                                  print "=> $to_email\n";                                  print "=> $to_email ";
528    
529                                  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;
530                                  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 550  sub send_queued_messages {
550                                  $m_obj->header_set('X-Nos-Hash', $hash);                                  $m_obj->header_set('X-Nos-Hash', $hash);
551    
552                                  # really send e-mail                                  # really send e-mail
553                                    my $sent_status;
554    
555                                  if (@email_send_options) {                                  if (@email_send_options) {
556                                          send $email_send_driver => $m_obj->as_string, @email_send_options;                                          $sent_status = send $email_send_driver => $m_obj->as_string, @email_send_options;
557                                  } else {                                  } else {
558                                          send $email_send_driver => $m_obj->as_string;                                          $sent_status = send $email_send_driver => $m_obj->as_string;
559                                  }                                  }
560    
561                                  $sent->create({                                  croak "can't send e-mail: $sent_status\n\nOriginal e-mail follows:\n".$m_obj->as_string unless ($sent_status);
562                                          message_id => $m->message_id,                                  my @bad = @{ $sent_status->prop('bad') };
563                                          user_id => $u->user_id,                                  croak "failed sending to ",join(",",@bad) if (@bad);
564                                          hash => $hash,  
565                                  });                                  if ($sent_status) {
566                                  $sent->dbi_commit;  
567                                            $sent->create({
568                                                    message_id => $m->message_id,
569                                                    user_id => $u->user_id,
570                                                    hash => $hash,
571                                            });
572                                            $sent->dbi_commit;
573    
574                                            print " - $sent_status\n";
575    
576                                    } else {
577                                            warn "ERROR: $sent_status\n";
578                                    }
579    
580                                  if ($sleep) {                                  if ($sleep) {
581                                          warn "sleeping $sleep seconds\n";                                          warn "sleeping $sleep seconds\n";
# Line 642  sub inbox_message { Line 691  sub inbox_message {
691    
692  Beware of dragons! You shouldn't need to call those methods directly.  Beware of dragons! You shouldn't need to call those methods directly.
693    
694    
695    =head2 _add_aliases
696    
697    Add or update alias in C</etc/aliases> (or equivavlent) file for selected list
698    
699     my $ok = $nos->add_aliases(
700            list => 'My list',
701            email => 'my-list@example.com',
702            aliases => '/etc/mail/mylist',
703            archive => '/path/to/mbox/archive',
704    
705     );
706    
707    C<archive> parametar is optional.
708    
709    Return false on failure.
710    
711    =cut
712    
713    sub _add_aliases {
714            my $self = shift;
715    
716            my $arg = {@_};
717    
718            foreach my $o (qw/list email aliases/) {
719                    croak "need $o option" unless ($arg->{$o});
720            }
721    
722            my $aliases = $arg->{'aliases'};
723            my $email = $arg->{'email'};
724            my $list = $arg->{'list'};
725    
726            unless (-e $aliases) {
727                    warn "aliases file $aliases doesn't exist, creating empty\n";
728                    open(my $fh, '>', $aliases) || croak "can't create $aliases: $!";
729                    close($fh);
730                    chmod 0777, $aliases || warn "can't change permission to 0777";
731            }
732    
733            my $a = new Mail::Alias($aliases) || croak "can't open aliases file $aliases: $!";
734    
735            my $target = '';
736    
737            if (my $archive = $arg->{'archive'}) {
738                    $target .= "$archive, ";
739    
740                    if (! -e $archive) {
741                            warn "please make sure that file $archive is writable for your e-mail user (defaulting to bad 777 permission for now)";
742    
743                            open(my $fh, '>', $archive) || croak "can't create archive file $archive: $!";
744                            close($fh);
745                            chmod 0777, $archive || croak "can't chmod archive file $archive to 0777: $!";
746                    }
747            }
748    
749            # resolve my path to absolute one
750            my $self_path = abs_path($0);
751            $self_path =~ s#/[^/]+$##;
752            $self_path =~ s#/t/*$#/#;
753    
754            $target .= qq#| cd $self_path && ./sender.pl --inbox="$list"#;
755    
756            if ($a->exists($email)) {
757                    $a->update($email, $target) or croak "can't update alias ".$a->error_check;
758            } else {
759                    $a->append($email, $target) or croak "can't add alias ".$a->error_check;
760            }
761    
762            return 1;
763    }
764    
765  =head2 _add_list  =head2 _add_list
766    
767  Create new list  Create new list
# Line 650  Create new list Line 770  Create new list
770          list => 'My list',          list => 'My list',
771          from => 'Outgoing from comment',          from => 'Outgoing from comment',
772          email => 'my-list@example.com',          email => 'my-list@example.com',
773            aliases => '/etc/mail/mylist',
774   );   );
775    
776  Returns C<Class::DBI> object for created list.  Returns C<Class::DBI> object for created list.
# Line 668  sub _add_list { Line 789  sub _add_list {
789    
790          my $name = lc($arg->{'list'}) || confess "can't add list without name";          my $name = lc($arg->{'list'}) || confess "can't add list without name";
791          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";
792            my $aliases = lc($arg->{'aliases'}) || confess "can't add list without path to aliases file";
793    
794          my $from_addr = $arg->{'from'};          my $from_addr = $arg->{'from'};
795    
796          my $lists = $self->{'loader'}->find_class('lists');          my $lists = $self->{'loader'}->find_class('lists');
797    
798            $self->_add_aliases(
799                    list => $name,
800                    email => $email,
801                    aliases => $aliases,
802            ) || warn "can't add alias $email for list $name";
803    
804          my $l = $lists->find_or_create({          my $l = $lists->find_or_create({
805                  name => $name,                  name => $name,
806                  email => $email,                  email => $email,
# Line 691  sub _add_list { Line 820  sub _add_list {
820  }  }
821    
822    
823    
824  =head2 _get_list  =head2 _get_list
825    
826  Get list C<Class::DBI> object.  Get list C<Class::DBI> object.
# Line 735  methods below). Line 865  methods below).
865    
866  my $nos;  my $nos;
867    
868    
869    =head2 new
870    
871    Create new SOAP object
872    
873     my $soap = new Nos::SOAP(
874            dsn => 'dbi:Pg:dbname=notices',
875            user => 'dpavlin',
876            passwd => '',
877            debug => 1,
878            verbose => 1,
879            hash_len => 8,
880            aliases => '/etc/aliases',
881     );
882    
883    =cut
884    
885  sub new {  sub new {
886          my $class = shift;          my $class = shift;
887          my $self = {@_};          my $self = {@_};
888    
889            croak "need aliases parametar" unless ($self->{'aliases'});
890    
891          bless($self, $class);          bless($self, $class);
892    
893          $nos = new Nos( @_ ) || die "can't create Nos object";          $nos = new Nos( @_ ) || die "can't create Nos object";
# Line 759  sub new { Line 909  sub new {
909  sub NewList {  sub NewList {
910          my $self = shift;          my $self = shift;
911    
912            my $aliases = $nos->{'aliases'} || croak "need 'aliases' argument to new constructor";
913    
914          if ($_[0] !~ m/^HASH/) {          if ($_[0] !~ m/^HASH/) {
915                  return $nos->new_list(                  return $nos->new_list(
916                          list => $_[0], from => $_[1], email => $_[2],                          list => $_[0], from => $_[1], email => $_[2],
917                            aliases => $aliases,
918                  );                  );
919          } else {          } else {
920                  return $nos->new_list( %{ shift @_ } );                  return $nos->new_list( %{ shift @_ }, aliases => $aliases );
921          }          }
922  }  }
923    
924    
925    =head2 DeleteList
926    
927     $ok = DeleteList(
928            list => 'My list',
929     );
930    
931    =cut
932    
933    sub DeleteList {
934            my $self = shift;
935    
936            if ($_[0] !~ m/^HASH/) {
937                    return $nos->delete_list(
938                            list => $_[0],
939                    );
940            } else {
941                    return $nos->delete_list( %{ shift @_ } );
942            }
943    }
944    
945  =head2 AddMemberToList  =head2 AddMemberToList
946    
947   $member_id = AddMemberToList(   $member_id = AddMemberToList(
# Line 801  sub AddMemberToList { Line 974  sub AddMemberToList {
974    
975  Returns array of hashes with user informations, see C<list_members>.  Returns array of hashes with user informations, see C<list_members>.
976    
977    Returning arrays from SOAP calls is somewhat fuzzy (at least to me). It
978    seems that SOAP::Lite client thinks that it has array with one element which
979    is array of hashes with data.
980    
981  =cut  =cut
982    
983  sub ListMembers {  sub ListMembers {
# Line 814  sub ListMembers { Line 991  sub ListMembers {
991                  $list_name = $_[0]->{'list'};                  $list_name = $_[0]->{'list'};
992          }          }
993    
994          return $nos->list_members( list => $list_name );          return [ $nos->list_members( list => $list_name ) ];
995    }
996    
997    
998    =head2 DeleteMemberFromList
999    
1000     $member_id = DeleteMemberFromList(
1001            list => 'My list',
1002            email => 'e-mail@example.com',
1003     );
1004    
1005    =cut
1006    
1007    sub DeleteMemberFromList {
1008            my $self = shift;
1009    
1010            if ($_[0] !~ m/^HASH/) {
1011                    return $nos->delete_member_from_list(
1012                            list => $_[0], email => $_[1],
1013                    );
1014            } else {
1015                    return $nos->delete_member_from_list( %{ shift @_ } );
1016            }
1017  }  }
1018    
1019    
1020  =head2 AddMessageToList  =head2 AddMessageToList
1021    
1022   $message_id = AddMessageToList(   $message_id = AddMessageToList(
Legend:
Removed from v.60  
changed lines
  Added in v.68
  ViewVC Help
Powered by ViewVC 1.1.26