/[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 31 by dpavlin, Mon May 16 22:04:40 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    
 =head2 AUTOLOAD  
79    
80  Returns class from L<Class::DBI>.  =head2 add_member_to_list
81    
82    Add new member to list
83    
84     $nos->add_member_to_list(
85            list => "My list",
86            email => "john.doe@example.com",
87            name => "John A. Doe",
88     );
89    
90    C<name> parametar is optional.
91    
92    Return member ID if user is added.
93    
94    =cut
95    
96    sub add_member_to_list {
97            my $self = shift;
98    
99            my $arg = {@_};
100    
101            my $email = $arg->{'email'} || croak "can't add user without e-mail";
102            my $name = $arg->{'name'} || '';
103            my $list_name = $arg->{'list'} || croak "need list name";
104    
105            my $list = $self->_get_list($list_name) || croak "list $list_name doesn't exist";
106    
107            if (! Email::Valid->address($email)) {
108                    carp "SKIPPING $name <$email>\n" if ($self->{'verbose'});
109                    return 0;
110            }
111    
112            carp "# $name <$email>\n" if ($self->{'verbose'});
113    
114            my $users = $self->{'loader'}->find_class('users');
115            my $user_list = $self->{'loader'}->find_class('user_list');
116    
117            my $this_user = $users->find_or_create({
118                    email => $email,
119                    full_name => $name,
120            }) || croak "can't find or create member\n";
121    
122            my $user_on_list = $user_list->find_or_create({
123                    user_id => $this_user->id,
124                    list_id => $list->id,
125            }) || croak "can't add user to list";
126    
127            $list->dbi_commit;
128            $this_user->dbi_commit;
129            $user_on_list->dbi_commit;
130    
131            return $this_user->id;
132    }
133    
134    =head2 add_message_to_list
135    
136   my $lists = $nos->lists;  Adds message to one list's queue for later sending.
137    
138  is equivalent to:   $nos->add_message_to_list(
139            list => 'My list',
140            message => 'From: My list <mylist@example.com>
141     To: John A. Doe <john.doe@example.com>
142    
143     This is example message
144     ',
145     );    
146    
147   my $lists = $loader->find_class('lists');  On success returns ID of newly created (or existing) message.
148    
149  =cut  =cut
150    
151  #sub AUTOLOAD {  sub add_message_to_list {
152  #       return if $AUTOLOAD =~ m/DESTROY$/;          my $self = shift;
153  #       my ($name) = $AUTOLOAD =~ /([^:]+)$/;  
154  #          my $args = {@_};
155  #       return $self->{'loader'}->find_class($AUTOLOAD) ||  
156  #               croak "unknown method '$AUTOLOAD' called";          my $list_name = $args->{'list'} || confess "need list name";
157  #}          my $message_text = $args->{'message'} || croak "need message";
158    
159            warn Dumper($message_text);
160    
161            my $m = Email::Simple->new($message_text) || croak "can't parse message";
162    
163            croak "message doesn't have Subject header\n" unless( $m->header('Subject') );
164    
165            my $lists = $self->{'loader'}->find_class('lists');
166    
167            my $this_list = $lists->search(
168                    name => $list_name,
169            )->first || croak "can't find list $list_name";
170    
171            my $messages = $self->{'loader'}->find_class('messages');
172    
173            my $this_message = $messages->find_or_create({
174                    message => $message_text
175            }) || croak "can't insert message";
176    
177            $this_message->dbi_commit() || croak "can't add message";
178    
179  =head2 send          my $queue = $self->{'loader'}->find_class('queue');
180    
181  Send a message using configured mailer.          $queue->find_or_create({
182                    message_id => $this_message->id,
183                    list_id => $this_list->id,
184            }) || croak "can't add message ",$this_message->id," to list ",$this_list->id, ": ",$this_list->name;
185    
186   $nos->send("message with headers");          $queue->dbi_commit || croak "can't add message to list ",$this_list->name;
187    
188            return $this_message->id;
189    }
190    
191    
192    =head2 send_queued_messages
193    
194    Send queued messages or just ones for selected list
195    
196     $nos->send_queued_messages("My list");
197    
198  =cut  =cut
199    
200  sub send_email {  sub send_queued_messages {
201            my $self = shift;
202    
203            my $list_name = shift;
204    
205            my $lists = $self->{'loader'}->find_class('lists');
206            my $queue = $self->{'loader'}->find_class('queue');
207            my $user_list = $self->{'loader'}->find_class('user_list');
208            my $sent = $self->{'loader'}->find_class('sent');
209    
210            my $my_q;
211            if ($list_name ne '') {
212                    my $l_id = $lists->search_like( name => $list_name )->first ||
213                            croak "can't find list $list_name";
214                    $my_q = $queue->search_like( list_id => $l_id ) ||
215                            croak "can't find list $list_name";
216            } else {
217                    $my_q = $queue->retrieve_all;
218            }
219    
220            while (my $m = $my_q->next) {
221                    next if ($m->all_sent);
222    
223                    print "sending message ",$m->message_id," enqueued on ",$m->date," to list ",$m->list_id->name,"\n";
224                    my $msg = $m->message_id->message;
225    
226                    my $auth = Email::Auth::AddressHash->new(
227                            $m->list_id->name,      # secret
228                            10,                     # hashlen
229                    );
230    
231                    foreach my $u ($user_list->search(list_id => $m->list_id)) {
232    
233                            my $to_email = $u->user_id->email;
234    
235                            if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {
236                                    print "SKIP $to_email message allready sent\n";
237                            } else {
238                                    print "\t$to_email\n";
239    
240                                    my $hash = $auth->generate_hash( $to_email );
241    
242                                    my $from = $u->list_id->name . " <" . $u->list_id->email . "+" . $hash . ">";
243                                    my $to = $u->user_id->full_name . " <$to_email>";
244    
245                                    my $m = Email::Simple->new($msg) || croak "can't parse message";
246    
247                                    print Dumper($m);
248    
249                                    $m->header_set('From', $from) || croak "can't set From: header";
250                                    $m->header_set('To', $to) || croak "can't set To: header";
251    
252                                    # FIXME do real sending :-)
253                                    send IO => $m->as_string;
254    
255                                    $sent->create({
256                                            message_id => $m->message_id,
257                                            user_id => $u->user_id,
258                                    });
259                                    $sent->dbi_commit;
260                            }
261                    }
262                    $m->all_sent(1);
263                    $m->update;
264                    $m->dbi_commit;
265            }
266    
267    }
268    
269    =head2 inbox_message
270    
271    Receive single message for list's inbox.
272    
273     my $ok = $nos->inbox_message($message);
274    
275    =cut
276    
277    sub inbox_message {
278          my $self = shift;          my $self = shift;
279    
280          my $message = shift || return;          my $message = shift || return;
281    
282          send IO => $message;          my $m = new Email::Simple->new($message);
283    
284  }  }
285    
 =head2 EXPORT  
286    
287  None by default.  =head1 INTERNAL METHODS
288    
289    Beware of dragons! You shouldn't need to call those methods directly.
290    
291    =head2 _add_list
292    
293    Create new list
294    
295     my $list_obj = $nos->_add_list(
296            list => 'My list',
297            email => 'my-list@example.com',
298     );
299    
300    Returns C<Class::DBI> object for created list.
301    
302    =cut
303    
304    sub _add_list {
305            my $self = shift;
306    
307            my $arg = {@_};
308    
309            my $name = $arg->{'list'} || confess "can't add list without name";
310            my $email = $arg->{'email'} || confess "can't add list without e-mail";
311    
312            my $lists = $self->{'loader'}->find_class('lists');
313    
314            my $l = $lists->find_or_create({
315                    name => $name,
316                    email => $email,
317            });
318            
319            croak "can't add list $name\n" unless ($l);
320    
321            $l->dbi_commit;
322    
323            return $l;
324    
325    }
326    
327    
328    =head2 _get_list
329    
330    Get list C<Class::DBI> object.
331    
332     my $list_obj = $nos->check_list('My list');
333    
334    Returns false on failure.
335    
336    =cut
337    
338    sub _get_list {
339            my $self = shift;
340    
341            my $name = shift || return;
342    
343            my $lists = $self->{'loader'}->find_class('lists') || confess "can't find lists class";
344    
345            return $lists->search({ name => $name })->first;
346    }
347    
348    
349    =head1 EXPORT
350    
351    Nothing.
352    
353  =head1 SEE ALSO  =head1 SEE ALSO
354    
355  mailman, ezmlm, sympa, L<Mail::Salsa>  mailman, ezmlm, sympa, L<Mail::Salsa>
356    
357    
358  =head1 AUTHOR  =head1 AUTHOR
359    
360  Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>  Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
361    
362    
363  =head1 COPYRIGHT AND LICENSE  =head1 COPYRIGHT AND LICENSE
364    
365  Copyright (C) 2005 by Dobrica Pavlinusic  Copyright (C) 2005 by Dobrica Pavlinusic
Legend:
Removed from v.20  
changed lines
  Added in v.31
  ViewVC Help
Powered by ViewVC 1.1.26