/[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 29 by dpavlin, Mon May 16 20:58:44 2005 UTC revision 36 by dpavlin, Tue May 17 17:49:14 2005 UTC
# Line 24  use Email::Send; Line 24  use Email::Send;
24  use Carp;  use Carp;
25  use Email::Auth::AddressHash;  use Email::Auth::AddressHash;
26  use Email::Simple;  use Email::Simple;
27    use Email::Address;
28  use Data::Dumper;  use Data::Dumper;
29    
30  =head1 NAME  =head1 NAME
# Line 51  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 73  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 97  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                  carp "SKIPPING $name <$email>\n" if ($self->{'verbose'});                  carp "SKIPPING $name <$email>\n";
145                  return 0;                  return 0;
146          }          }
147    
148          carp "# $name <$email>\n" if ($self->{'verbose'});          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 139  Adds message to one list's queue for lat Line 177  Adds message to one list's queue for lat
177    
178   $nos->add_message_to_list(   $nos->add_message_to_list(
179          list => 'My list',          list => 'My list',
180          message => 'From: My list <mylist@example.com>          message => 'Subject: welcome to list
  To: John A. Doe <john.doe@example.com>  
181    
182   This is example message   This is example message
183   ',   ',
# Line 148  Adds message to one list's queue for lat Line 185  Adds message to one list's queue for lat
185    
186  On success returns ID of newly created (or existing) message.  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  =cut
193    
194  sub add_message_to_list {  sub add_message_to_list {
# Line 158  sub add_message_to_list { Line 199  sub add_message_to_list {
199          my $list_name = $args->{'list'} || confess "need list name";          my $list_name = $args->{'list'} || confess "need list name";
200          my $message_text = $args->{'message'} || croak "need message";          my $message_text = $args->{'message'} || croak "need message";
201    
         warn Dumper($message_text);  
   
202          my $m = Email::Simple->new($message_text) || croak "can't parse message";          my $m = Email::Simple->new($message_text) || croak "can't parse message";
203    
204          croak "message doesn't have Subject header\n" unless( $m->header('Subject') );          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');          my $lists = $self->{'loader'}->find_class('lists');
210    
# Line 225  sub send_queued_messages { Line 267  sub send_queued_messages {
267                  print "sending message ",$m->message_id," enqueued on ",$m->date," to list ",$m->list_id->name,"\n";                  print "sending message ",$m->message_id," enqueued on ",$m->date," to list ",$m->list_id->name,"\n";
268                  my $msg = $m->message_id->message;                  my $msg = $m->message_id->message;
269    
                 my $auth = Email::Auth::AddressHash->new(  
                         $m->list_id->name,      # secret  
                         10,                     # hashlen  
                 );  
   
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;                          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 $to_email message allready sent\n";                                  print "SKIP $to_email message allready sent\n";
278                          } else {                          } else {
279                                  print "\t$to_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 );                                  my $hash = $auth->generate_hash( $to_email );
285    
286                                  my $from = $u->list_id->name . " <" . $u->list_id->email . "+" . $hash . ">";                                  my $from = $u->list_id->name . " <" . $from . "+" . $hash . ( $domain ? "@" . $domain : '' ). ">";
287                                  my $to = $u->user_id->full_name . " <$to_email>";                                  my $to = $u->user_id->full_name . " <$to_email>";
288    
289                                  my $m = Email::Simple->new($msg) || croak "can't parse message";                                  my $m_obj = Email::Simple->new($msg) || croak "can't parse message";
   
                                 print Dumper($m);  
290    
291                                  $m->header_set('From', $from) || croak "can't set From: header";                                  $m_obj->header_set('From', $from) || croak "can't set From: header";
292                                  $m->header_set('To', $to) || croak "can't set To: header";                                  $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 => $m->as_string;                                  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 272  sub send_queued_messages { Line 313  sub send_queued_messages {
313    
314  Receive single message for list's inbox.  Receive single message for list's inbox.
315    
316   my $ok = $nos->inbox_message($message);   my $ok = $nos->inbox_message(
317            list => 'My list',
318            message => $message,
319     );
320    
321  =cut  =cut
322    
323  sub inbox_message {  sub inbox_message {
324          my $self = shift;          my $self = shift;
325    
326          my $message = shift || return;          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    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 $m = new Email::Simple->new($message);          my $lists = $self->{'loader'}->find_class('lists') || confess "can't find lists class";
420    
421            return $lists->search({ name => $name })->first;
422  }  }
423    
424    
Legend:
Removed from v.29  
changed lines
  Added in v.36
  ViewVC Help
Powered by ViewVC 1.1.26