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