/[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

trunk/lib/Nos.pm revision 20 by dpavlin, Sun May 15 21:19:26 2005 UTC trunk/Nos.pm revision 29 by dpavlin, Mon May 16 20:58:44 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.1';  our $VERSION = '0.3';
20    
21  use Class::DBI::Loader;  use Class::DBI::Loader;
22  use Email::Valid;  use Email::Valid;
23  use Email::Send;  use Email::Send;
24  use Carp;  use Carp;
25    use Email::Auth::AddressHash;
26    use Email::Simple;
27    use Data::Dumper;
28    
29  =head1 NAME  =head1 NAME
30    
# Line 57  sub new { Line 60  sub new {
60          my $self = {@_};          my $self = {@_};
61          bless($self, $class);          bless($self, $class);
62    
63            croak "need at least dsn" unless ($self->{'dsn'});
64    
65          $self->{'loader'} = Class::DBI::Loader->new(          $self->{'loader'} = Class::DBI::Loader->new(
66                  debug           => $self->{'debug'},                  debug           => $self->{'debug'},
67                  dsn             => $self->{'dsn'},                  dsn             => $self->{'dsn'},
# Line 66  sub new { Line 71  sub new {
71  #               additional_classes      => qw/Class::DBI::AbstractSearch/,  #               additional_classes      => qw/Class::DBI::AbstractSearch/,
72  #               additional_base_classes => qw/My::Stuff/,  #               additional_base_classes => qw/My::Stuff/,
73                  relationships   => 1,                  relationships   => 1,
74          );          ) || croak "can't init Class::DBI::Loader";
75    
76          $self ? return $self : return undef;          $self ? return $self : return undef;
77  }  }
78    
79  =head2 AUTOLOAD  =head2 add_member_to_list
80    
81    Add new member to list
82    
83     $nos->add_member_to_list(
84            list => "My list",
85            email => "john.doe@example.com",
86            name => "John A. Doe",
87     );
88    
89    C<name> parametar is optional.
90    
91    Return member ID if user is added.
92    
93    =cut
94    
95    sub add_member_to_list {
96            my $self = shift;
97    
98            my $arg = {@_};
99    
100            my $email = $arg->{'email'} || confess "can't add user without e-mail";
101            my $name = $arg->{'name'} || '';
102            confess "need list name" unless ($arg->{'list'});
103    
104            if (! Email::Valid->address($email)) {
105                    carp "SKIPPING $name <$email>\n" if ($self->{'verbose'});
106                    return 0;
107            }
108    
109            carp "# $name <$email>\n" if ($self->{'verbose'});
110    
111            my $lists = $self->{'loader'}->find_class('lists');
112            my $users = $self->{'loader'}->find_class('users');
113            my $user_list = $self->{'loader'}->find_class('user_list');
114    
115            my $list = $lists->find_or_create({
116                    name => $arg->{'list'},
117            }) || croak "can't add list ",$arg->{'list'},"\n";
118            
119            my $this_user = $users->find_or_create({
120                    email => $email,
121                    full_name => $name,
122            }) || croak "can't find or create member\n";
123    
124            my $user_on_list = $user_list->find_or_create({
125                    user_id => $this_user->id,
126                    list_id => $list->id,
127            }) || croak "can't add user to list";
128    
129            $list->dbi_commit;
130            $this_user->dbi_commit;
131            $user_on_list->dbi_commit;
132    
133            return $this_user->id;
134    }
135    
136    =head2 add_message_to_list
137    
138    Adds message to one list's queue for later sending.
139    
140     $nos->add_message_to_list(
141            list => 'My list',
142            message => 'From: My list <mylist@example.com>
143     To: John A. Doe <john.doe@example.com>
144    
145     This is example message
146     ',
147     );    
148    
149    On success returns ID of newly created (or existing) message.
150    
151    =cut
152    
153    sub add_message_to_list {
154            my $self = shift;
155    
156            my $args = {@_};
157    
158  Returns class from L<Class::DBI>.          my $list_name = $args->{'list'} || confess "need list name";
159            my $message_text = $args->{'message'} || croak "need message";
160    
161   my $lists = $nos->lists;          warn Dumper($message_text);
162    
163  is equivalent to:          my $m = Email::Simple->new($message_text) || croak "can't parse message";
164    
165   my $lists = $loader->find_class('lists');          croak "message doesn't have Subject header\n" unless( $m->header('Subject') );
166    
167            my $lists = $self->{'loader'}->find_class('lists');
168    
169            my $this_list = $lists->search(
170                    name => $list_name,
171            )->first || croak "can't find list $list_name";
172    
173            my $messages = $self->{'loader'}->find_class('messages');
174    
175            my $this_message = $messages->find_or_create({
176                    message => $message_text
177            }) || croak "can't insert message";
178    
179            $this_message->dbi_commit() || croak "can't add message";
180    
181            my $queue = $self->{'loader'}->find_class('queue');
182    
183            $queue->find_or_create({
184                    message_id => $this_message->id,
185                    list_id => $this_list->id,
186            }) || croak "can't add message ",$this_message->id," to list ",$this_list->id, ": ",$this_list->name;
187    
188            $queue->dbi_commit || croak "can't add message to list ",$this_list->name;
189    
190            return $this_message->id;
191    }
192    
193    
194    =head2 send_queued_messages
195    
196    Send queued messages or just ones for selected list
197    
198     $nos->send_queued_messages("My list");
199    
200  =cut  =cut
201    
202  #sub AUTOLOAD {  sub send_queued_messages {
203  #       return if $AUTOLOAD =~ m/DESTROY$/;          my $self = shift;
204  #       my ($name) = $AUTOLOAD =~ /([^:]+)$/;  
205  #          my $list_name = shift;
206  #       return $self->{'loader'}->find_class($AUTOLOAD) ||  
207  #               croak "unknown method '$AUTOLOAD' called";          my $lists = $self->{'loader'}->find_class('lists');
208  #}          my $queue = $self->{'loader'}->find_class('queue');
209            my $user_list = $self->{'loader'}->find_class('user_list');
210            my $sent = $self->{'loader'}->find_class('sent');
211    
212            my $my_q;
213            if ($list_name ne '') {
214                    my $l_id = $lists->search_like( name => $list_name )->first ||
215                            croak "can't find list $list_name";
216                    $my_q = $queue->search_like( list_id => $l_id ) ||
217                            croak "can't find list $list_name";
218            } else {
219                    $my_q = $queue->retrieve_all;
220            }
221    
222            while (my $m = $my_q->next) {
223                    next if ($m->all_sent);
224    
225                    print "sending message ",$m->message_id," enqueued on ",$m->date," to list ",$m->list_id->name,"\n";
226                    my $msg = $m->message_id->message;
227    
228                    my $auth = Email::Auth::AddressHash->new(
229                            $m->list_id->name,      # secret
230                            10,                     # hashlen
231                    );
232    
233                    foreach my $u ($user_list->search(list_id => $m->list_id)) {
234    
235                            my $to_email = $u->user_id->email;
236    
237                            if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {
238                                    print "SKIP $to_email message allready sent\n";
239                            } else {
240                                    print "\t$to_email\n";
241    
242                                    my $hash = $auth->generate_hash( $to_email );
243    
244                                    my $from = $u->list_id->name . " <" . $u->list_id->email . "+" . $hash . ">";
245                                    my $to = $u->user_id->full_name . " <$to_email>";
246    
247                                    my $m = Email::Simple->new($msg) || croak "can't parse message";
248    
249                                    print Dumper($m);
250    
251                                    $m->header_set('From', $from) || croak "can't set From: header";
252                                    $m->header_set('To', $to) || croak "can't set To: header";
253    
254                                    # FIXME do real sending :-)
255                                    send IO => $m->as_string;
256    
257                                    $sent->create({
258                                            message_id => $m->message_id,
259                                            user_id => $u->user_id,
260                                    });
261                                    $sent->dbi_commit;
262                            }
263                    }
264                    $m->all_sent(1);
265                    $m->update;
266                    $m->dbi_commit;
267            }
268    
269  =head2 send  }
270    
271  Send a message using configured mailer.  =head2 inbox_message
272    
273   $nos->send("message with headers");  Receive single message for list's inbox.
274    
275     my $ok = $nos->inbox_message($message);
276    
277  =cut  =cut
278    
279  sub send_email {  sub inbox_message {
280          my $self = shift;          my $self = shift;
281    
282          my $message = shift || return;          my $message = shift || return;
283    
284          send IO => $message;          my $m = new Email::Simple->new($message);
285    
286  }  }
287    
 =head2 EXPORT  
288    
289  None by default.  =head1 EXPORT
290    
291    Nothing.
292    
293  =head1 SEE ALSO  =head1 SEE ALSO
294    
295  mailman, ezmlm, sympa, L<Mail::Salsa>  mailman, ezmlm, sympa, L<Mail::Salsa>
296    
297    
298  =head1 AUTHOR  =head1 AUTHOR
299    
300  Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>  Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
301    
302    
303  =head1 COPYRIGHT AND LICENSE  =head1 COPYRIGHT AND LICENSE
304    
305  Copyright (C) 2005 by Dobrica Pavlinusic  Copyright (C) 2005 by Dobrica Pavlinusic
Legend:
Removed from v.20  
changed lines
  Added in v.29
  ViewVC Help
Powered by ViewVC 1.1.26