/[notice-sender]/jifty-dbi/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 /jifty-dbi/Nos.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 23 by dpavlin, Sun May 15 22:12:31 2005 UTC revision 36 by dpavlin, Tue May 17 17:49:14 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 Email::Address;
28    use Data::Dumper;
29    
30  =head1 NAME  =head1 NAME
31    
# Line 48  Create new instance specifing database, Line 52  Create new instance specifing database,
52          passwd => '',          passwd => '',
53          debug => 1,          debug => 1,
54          verbose => 1,          verbose => 1,
55            hash_len => 8,
56   );   );
57    
58    Parametar C<hash_len> defined length of hash which will be added to each
59    outgoing e-mail message.
60    
61  =cut  =cut
62    
63  sub new {  sub new {
# Line 70  sub new { Line 78  sub new {
78                  relationships   => 1,                  relationships   => 1,
79          ) || croak "can't init Class::DBI::Loader";          ) || croak "can't init Class::DBI::Loader";
80    
81            $self->{'hash_len'} ||= 8;
82    
83          $self ? return $self : return undef;          $self ? return $self : return undef;
84  }  }
85    
86    
87    =head2 new_list
88    
89    Create new list
90    
91     $nos->new_list(
92            list => 'My list",
93            email => 'my-list@example.com',
94     );
95    
96    Returns ID of newly created list.
97    
98    =cut
99    
100    sub new_list {
101            my $self = shift;
102    
103            my $arg = {@_};
104    
105            confess "need list name" unless ($arg->{'list'});
106            confess "need list email" unless ($arg->{'list'});
107    
108            my $l = $self->_get_list($arg->{'list'}) ||
109                    $self->_add_list( @_ ) ||
110                    return undef;
111    
112            return $l->id;
113    }
114    
115    
116  =head2 add_member_to_list  =head2 add_member_to_list
117    
118  Add new member to list  Add new member to list
# Line 85  Add new member to list Line 125  Add new member to list
125    
126  C<name> parametar is optional.  C<name> parametar is optional.
127    
128  Return true if user is added.  Return member ID if user is added.
129    
130  =cut  =cut
131    
# Line 94  sub add_member_to_list { Line 134  sub add_member_to_list {
134    
135          my $arg = {@_};          my $arg = {@_};
136    
137          my $email = $arg->{'email'} || confess "can't add user without e-mail";          my $email = $arg->{'email'} || croak "can't add user without e-mail";
138          my $name = $arg->{'name'} || '';          my $name = $arg->{'name'} || '';
139          confess "need list name" unless ($arg->{'list'});          my $list_name = $arg->{'list'} || croak "need list name";
140    
141            my $list = $self->_get_list($list_name) || croak "list $list_name doesn't exist";
142    
143          if (! Email::Valid->address($email)) {          if (! Email::Valid->address($email)) {
144                  warn "SKIPPING $name <$email>";                  carp "SKIPPING $name <$email>\n";
145                  return 0;                  return 0;
146          }          }
147    
148          print "# $name <$email>\n";          carp "# $name <$email>\n" if ($self->{'verbose'});
149    
         my $lists = $self->{'loader'}->find_class('lists');  
150          my $users = $self->{'loader'}->find_class('users');          my $users = $self->{'loader'}->find_class('users');
151          my $user_list = $self->{'loader'}->find_class('user_list');          my $user_list = $self->{'loader'}->find_class('user_list');
152    
         my $list = $lists->find_or_create({  
                 name => $arg->{'list'},  
         }) || croak "can't add list ",$arg->{'list'},"\n";  
           
153          my $this_user = $users->find_or_create({          my $this_user = $users->find_or_create({
154                  email => $email,                  email => $email,
                 full_name => $name,  
155          }) || croak "can't find or create member\n";          }) || croak "can't find or create member\n";
156    
157            if ($name && $this_user->full_name ne $name) {
158                    $this_user->full_name($name || '');
159                    $this_user->update;
160            }
161    
162          my $user_on_list = $user_list->find_or_create({          my $user_on_list = $user_list->find_or_create({
163                  user_id => $this_user->id,                  user_id => $this_user->id,
164                  list_id => $list->id,                  list_id => $list->id,
# Line 127  sub add_member_to_list { Line 168  sub add_member_to_list {
168          $this_user->dbi_commit;          $this_user->dbi_commit;
169          $user_on_list->dbi_commit;          $user_on_list->dbi_commit;
170    
171          return 1;          return $this_user->id;
172    }
173    
174    =head2 add_message_to_list
175    
176    Adds message to one list's queue for later sending.
177    
178     $nos->add_message_to_list(
179            list => 'My list',
180            message => 'Subject: welcome to list
181    
182     This is example message
183     ',
184     );    
185    
186    On success returns ID of newly created (or existing) message.
187    
188    Only required header in e-mail is C<Subject:>. C<From:> and C<To:> headers
189    will be automatically generated, but if you want to use own headers, just
190    include them in messages.
191    
192    =cut
193    
194    sub add_message_to_list {
195            my $self = shift;
196    
197            my $args = {@_};
198    
199            my $list_name = $args->{'list'} || confess "need list name";
200            my $message_text = $args->{'message'} || croak "need message";
201    
202            my $m = Email::Simple->new($message_text) || croak "can't parse message";
203    
204            unless( $m->header('Subject') ) {
205                    warn "message doesn't have Subject header\n";
206                    return;
207            }
208    
209            my $lists = $self->{'loader'}->find_class('lists');
210    
211            my $this_list = $lists->search(
212                    name => $list_name,
213            )->first || croak "can't find list $list_name";
214    
215            my $messages = $self->{'loader'}->find_class('messages');
216    
217            my $this_message = $messages->find_or_create({
218                    message => $message_text
219            }) || croak "can't insert message";
220    
221            $this_message->dbi_commit() || croak "can't add message";
222    
223            my $queue = $self->{'loader'}->find_class('queue');
224    
225            $queue->find_or_create({
226                    message_id => $this_message->id,
227                    list_id => $this_list->id,
228            }) || croak "can't add message ",$this_message->id," to list ",$this_list->id, ": ",$this_list->name;
229    
230            $queue->dbi_commit || croak "can't add message to list ",$this_list->name;
231    
232            return $this_message->id;
233  }  }
234    
235    
236  =head2 send_queued_messages  =head2 send_queued_messages
237    
238  Send queued messages or just ones for selected list  Send queued messages or just ones for selected list
239    
240   $noc->send_queued_messages("my list");   $nos->send_queued_messages("My list");
241    
242  =cut  =cut
243    
# Line 166  sub send_queued_messages { Line 269  sub send_queued_messages {
269    
270                  foreach my $u ($user_list->search(list_id => $m->list_id)) {                  foreach my $u ($user_list->search(list_id => $m->list_id)) {
271    
272                            my $to_email = $u->user_id->email;
273    
274                            my ($from,$domain) = split(/@/, $u->list_id->email, 2);
275    
276                          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 )) {
277                                  print "SKIP ",$u->user_id->email," message allready sent\n";                                  print "SKIP $to_email message allready sent\n";
278                          } else {                          } else {
279                                  print "\t",$u->user_id->email,"\n";                                  print "=> $to_email\n";
280    
281                                    my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id;
282                                    my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} );
283    
284                                    my $hash = $auth->generate_hash( $to_email );
285    
286                                  my $hdr = "From: " . $u->list_id->name . " <" . $u->list_id->email . ">\n" .                                  my $from = $u->list_id->name . " <" . $from . "+" . $hash . ( $domain ? "@" . $domain : '' ). ">";
287                                          "To: " . $u->user_id->full_name . " <". $u->user_id->email. ">\n";                                  my $to = $u->user_id->full_name . " <$to_email>";
288    
289                                    my $m_obj = Email::Simple->new($msg) || croak "can't parse message";
290    
291                                    $m_obj->header_set('From', $from) || croak "can't set From: header";
292                                    $m_obj->header_set('To', $to) || croak "can't set To: header";
293    
294                                  # FIXME do real sending :-)                                  # FIXME do real sending :-)
295                                  send IO => "$hdr\n$msg";                                  send IO => $m_obj->as_string;
296    
297                                  $sent->create({                                  $sent->create({
298                                          message_id => $m->message_id,                                          message_id => $m->message_id,
299                                          user_id => $u->user_id,                                          user_id => $u->user_id,
300                                            hash => $hash,
301                                  });                                  });
302                                  $sent->dbi_commit;                                  $sent->dbi_commit;
303                          }                          }
# Line 191  sub send_queued_messages { Line 309  sub send_queued_messages {
309    
310  }  }
311    
312  =head2 EXPORT  =head2 inbox_message
313    
314    Receive single message for list's inbox.
315    
316     my $ok = $nos->inbox_message(
317            list => 'My list',
318            message => $message,
319     );
320    
321    =cut
322    
323    sub inbox_message {
324            my $self = shift;
325    
326            my $arg = {@_};
327    
328            return unless ($arg->{'message'});
329            croak "need list name" unless ($arg->{'list'});
330    
331            my $m = Email::Simple->new($arg->{'message'}) || croak "can't parse message";
332    
333            my $to = $m->header('To') || die "can't find To: address in incomming message\n";
334    
335            my @addrs = Email::Address->parse( $to );
336    
337            die "can't parse To: $to address\n" unless (@addrs);
338    
339            my $hl = $self->{'hash_len'} || confess "no hash_len?";
340    
341            my $hash;
342    
343            foreach my $a (@addrs) {
344                    if ($a->address =~ m/\+([a-f0-9]{$hl})@/) {
345                            $hash = $1;
346                            last;
347                    }
348            }
349    
350            croak "can't find hash in e-mail $to\n" unless ($hash);
351    
352            my $sent = $self->{'loader'}->find_class('sent');
353    
354            # will use null if no matching message_id is found
355            my $message_id = $sent->search( hash => $hash )->first->message_id;
356    
357    print "message_id: $message_id\n";
358    
359            warn "inbox is not yet implemented";
360    }
361    
362    
363    =head1 INTERNAL METHODS
364    
365    Beware of dragons! You shouldn't need to call those methods directly.
366    
367    =head2 _add_list
368    
369    Create new list
370    
371     my $list_obj = $nos->_add_list(
372            list => 'My list',
373            email => 'my-list@example.com',
374     );
375    
376    Returns C<Class::DBI> object for created list.
377    
378    =cut
379    
380    sub _add_list {
381            my $self = shift;
382    
383            my $arg = {@_};
384    
385            my $name = $arg->{'list'} || confess "can't add list without name";
386            my $email = $arg->{'email'} || confess "can't add list without e-mail";
387    
388            my $lists = $self->{'loader'}->find_class('lists');
389    
390            my $l = $lists->find_or_create({
391                    name => $name,
392                    email => $email,
393            });
394            
395            croak "can't add list $name\n" unless ($l);
396    
397            $l->dbi_commit;
398    
399            return $l;
400    
401    }
402    
403    
404    =head2 _get_list
405    
406  None by default.  Get list C<Class::DBI> object.
407    
408     my $list_obj = $nos->check_list('My list');
409    
410    Returns false on failure.
411    
412    =cut
413    
414    sub _get_list {
415            my $self = shift;
416    
417            my $name = shift || return;
418    
419            my $lists = $self->{'loader'}->find_class('lists') || confess "can't find lists class";
420    
421            return $lists->search({ name => $name })->first;
422    }
423    
424    
425    =head1 EXPORT
426    
427    Nothing.
428    
429  =head1 SEE ALSO  =head1 SEE ALSO
430    
431  mailman, ezmlm, sympa, L<Mail::Salsa>  mailman, ezmlm, sympa, L<Mail::Salsa>
432    
433    
434  =head1 AUTHOR  =head1 AUTHOR
435    
436  Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>  Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
437    
438    
439  =head1 COPYRIGHT AND LICENSE  =head1 COPYRIGHT AND LICENSE
440    
441  Copyright (C) 2005 by Dobrica Pavlinusic  Copyright (C) 2005 by Dobrica Pavlinusic
Legend:
Removed from v.23  
changed lines
  Added in v.36
  ViewVC Help
Powered by ViewVC 1.1.26