/[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 67 by dpavlin, Fri Jul 8 17:00:20 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.6';  our $VERSION = '0.7';
20    
21  use Class::DBI::Loader;  use Class::DBI::Loader;
22  use Email::Valid;  use Email::Valid;
# Line 120  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>, C<email> address  Create new list. Required arguments are name of C<list>, C<email> address
126  and path to C<aliases> file.  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',
# Line 139  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 158  sub new_list { Line 158  sub new_list {
158  }  }
159    
160    
161  =head2 delete_list  =head2 drop_list
162    
163  Delete list from database.  Delete list from database.
164    
165   my $ok = delete_list(   my $ok = drop_list(
166          list => 'My list'          list => 'My list'
167            aliases => '/etc/mail/mylist',
168   );   );
169    
170  Returns false if list doesn't exist.  Returns false if list doesn't exist.
171    
172  =cut  =cut
173    
174  sub delete_list {  sub drop_list {
175          my $self = shift;          my $self = shift;
176    
177          my $args = {@_};          my $args = {@_};
# Line 179  sub delete_list { Line 180  sub delete_list {
180    
181          $args->{'list'} = lc($args->{'list'});          $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');          my $lists = $self->{'loader'}->find_class('lists');
186    
187          my $this_list = $lists->search( name => $args->{'list'} )->first || return;          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";          $this_list->delete || croak "can't delete list\n";
192    
193          return $lists->dbi_commit || croak "can't commit";          return $lists->dbi_commit || croak "can't commit";
# Line 694  Beware of dragons! You shouldn't need to Line 699  Beware of dragons! You shouldn't need to
699    
700  =head2 _add_aliases  =head2 _add_aliases
701    
702  Add new list to C</etc/aliases> (or equivavlent) file  Add or update alias in C</etc/aliases> (or equivalent) file for selected list
703    
704   my $ok = $nos->add_aliases(   my $ok = $nos->add_aliases(
705          list => 'My list',          list => 'My list',
# Line 715  sub _add_aliases { Line 720  sub _add_aliases {
720    
721          my $arg = {@_};          my $arg = {@_};
722    
723          croak "need list and email options" unless ($arg->{'list'} && $arg->{'email'});          foreach my $o (qw/list email aliases/) {
724                    croak "need $o option" unless ($arg->{$o});
725            }
726    
727          my $aliases = $arg->{'aliases'} || croak "need aliases";          my $aliases = $arg->{'aliases'};
728            my $email = $arg->{'email'};
729            my $list = $arg->{'list'};
730    
731          unless (-e $aliases) {          unless (-e $aliases) {
732                  warn "aliases file $aliases doesn't exist, creating empty\n";                  warn "aliases file $aliases doesn't exist, creating empty\n";
# Line 726  sub _add_aliases { Line 735  sub _add_aliases {
735                  chmod 0777, $aliases || warn "can't change permission to 0777";                  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: $!";          my $a = new Mail::Alias($aliases) || croak "can't open aliases file $aliases: $!";
741    
742          my $target = '';          my $target = '';
# Line 747  sub _add_aliases { Line 758  sub _add_aliases {
758          $self_path =~ s#/[^/]+$##;          $self_path =~ s#/[^/]+$##;
759          $self_path =~ s#/t/*$#/#;          $self_path =~ s#/t/*$#/#;
760    
761          $target .= qq#| cd $self_path && ./sender.pl --inbox="$arg->{'list'}"#;          $target .= qq#| cd $self_path && ./sender.pl --inbox="$list"#;
762    
763          unless ($a->append($arg->{'email'}, $target)) {          if ($a->exists($email)) {
764                  croak "can't add alias ".$a->error_check;                  $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;          return 1;
772  }  }
773    
# Line 793  sub _add_list { Line 808  sub _add_list {
808                  list => $name,                  list => $name,
809                  email => $email,                  email => $email,
810                  aliases => $aliases,                  aliases => $aliases,
811          ) || croak "can't add alias $email for list $name";          ) || 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,
# Line 835  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 890  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 900  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          croak "self is not Nos::SOAP object" unless (ref($self) eq 'Nos::SOAP');          my $aliases = $nos->{'aliases'} || croak "need 'aliases' argument to new constructor";
   
         my $aliases = $self->{'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,                          aliases => $aliases,
961                  );                  );
962          } else {          } else {
963                  return $nos->new_list( %{ shift @_ }, aliases => $aliases );                  return $nos->create_list( %{ shift @_ }, aliases => $aliases );
964          }          }
965  }  }
966    
967    
968  =head2 DeleteList  =head2 DropList
969    
970   $ok = DeleteList(   $ok = DropList(
971          list => 'My list',          list => 'My list',
972   );   );
973    
974  =cut  =cut
975    
976  sub DeleteList {  sub DropList {
977          my $self = shift;          my $self = shift;
978    
979            my $aliases = $nos->{'aliases'} || croak "need 'aliases' argument to new constructor";
980    
981          if ($_[0] !~ m/^HASH/) {          if ($_[0] !~ m/^HASH/) {
982                  return $nos->delete_list(                  return $nos->drop_list(
983                          list => $_[0],                          list => $_[0],
984                            aliases => $aliases,
985                  );                  );
986          } else {          } else {
987                  return $nos->delete_list( %{ shift @_ } );                  return $nos->drop_list( %{ shift @_ }, aliases => $aliases );
988          }          }
989  }  }
990    
Legend:
Removed from v.67  
changed lines
  Added in v.72
  ViewVC Help
Powered by ViewVC 1.1.26