/[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 25 by dpavlin, Mon May 16 13:52:43 2005 UTC revision 36 by dpavlin, Tue May 17 17:49:14 2005 UTC
# Line 9  require Exporter; Line 9  require Exporter;
9  our @ISA = qw(Exporter);  our @ISA = qw(Exporter);
10    
11  our %EXPORT_TAGS = ( 'all' => [ qw(  our %EXPORT_TAGS = ( 'all' => [ qw(
         add_member_to_list  
         add_message_to_queue  
12  ) ] );  ) ] );
13    
14  our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );  our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
# Line 18  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 50  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 72  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 87  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 96  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 129  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_queue  =head2 add_message_to_list
175    
176  Adds message to one list's queue for later sending.  Adds message to one list's queue for later sending.
177    
178   $nos->add_message_to_queue(   $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 147  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_queue {  sub add_message_to_list {
195          my $self = shift;          my $self = shift;
196    
197          my $args = {@_};          my $args = {@_};
# Line 157  sub add_message_to_queue { Line 199  sub add_message_to_queue {
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    
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');          my $lists = $self->{'loader'}->find_class('lists');
210    
211          my $this_list = $lists->search(          my $this_list = $lists->search(
# Line 220  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 $hdr = "From: " . $u->list_id->name . " <" . $u->list_id->email . ">\n" .                                  my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id;
282                                          "To: " . $u->user_id->full_name . " <". $u->user_id->email. ">\n";                                  my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} );
283    
284                                    my $hash = $auth->generate_hash( $to_email );
285    
286                                    my $from = $u->list_id->name . " <" . $from . "+" . $hash . ( $domain ? "@" . $domain : '' ). ">";
287                                    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 245  sub send_queued_messages { Line 309  sub send_queued_messages {
309    
310  }  }
311    
312  =head1 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  Exported methods are also available using SOAP interface. For now, those are:          my @addrs = Email::Address->parse( $to );
336    
337  =over 4          die "can't parse To: $to address\n" unless (@addrs);
338    
339  =item add_member_to_list          my $hl = $self->{'hash_len'} || confess "no hash_len?";
340    
341  =item add_message_to_queue          my $hash;
342    
343  =back          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 $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    
Legend:
Removed from v.25  
changed lines
  Added in v.36
  ViewVC Help
Powered by ViewVC 1.1.26