/[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 27 by dpavlin, Mon May 16 16:25:14 2005 UTC revision 30 by dpavlin, Mon May 16 21:54:41 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.2';  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 73  sub new { Line 76  sub new {
76          $self ? return $self : return undef;          $self ? return $self : return undef;
77  }  }
78    
79    
80  =head2 add_member_to_list  =head2 add_member_to_list
81    
82  Add new member to list  Add new member to list
# Line 94  sub add_member_to_list { Line 98  sub add_member_to_list {
98    
99          my $arg = {@_};          my $arg = {@_};
100    
101          my $email = $arg->{'email'} || confess "can't add user without e-mail";          my $email = $arg->{'email'} || croak "can't add user without e-mail";
102          my $name = $arg->{'name'} || '';          my $name = $arg->{'name'} || '';
103          confess "need list name" unless ($arg->{'list'});          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)) {          if (! Email::Valid->address($email)) {
108                  warn "SKIPPING $name <$email>";                  carp "SKIPPING $name <$email>\n" if ($self->{'verbose'});
109                  return 0;                  return 0;
110          }          }
111    
112          print STDERR "# $name <$email>\n";          carp "# $name <$email>\n" if ($self->{'verbose'});
113    
         my $lists = $self->{'loader'}->find_class('lists');  
114          my $users = $self->{'loader'}->find_class('users');          my $users = $self->{'loader'}->find_class('users');
115          my $user_list = $self->{'loader'}->find_class('user_list');          my $user_list = $self->{'loader'}->find_class('user_list');
116    
         my $list = $lists->find_or_create({  
                 name => $arg->{'list'},  
         }) || croak "can't add list ",$arg->{'list'},"\n";  
           
117          my $this_user = $users->find_or_create({          my $this_user = $users->find_or_create({
118                  email => $email,                  email => $email,
119                  full_name => $name,                  full_name => $name,
# Line 130  sub add_member_to_list { Line 131  sub add_member_to_list {
131          return $this_user->id;          return $this_user->id;
132  }  }
133    
134  =head2 add_message_to_queue  =head2 add_message_to_list
135    
136  Adds message to one list's queue for later sending.  Adds message to one list's queue for later sending.
137    
138   $nos->add_message_to_queue(   $nos->add_message_to_list(
139          list => 'My list',          list => 'My list',
140          message => 'From: My list <mylist@example.com>          message => 'From: My list <mylist@example.com>
141   To: John A. Doe <john.doe@example.com>   To: John A. Doe <john.doe@example.com>
# Line 147  On success returns ID of newly created ( Line 148  On success returns ID of newly created (
148    
149  =cut  =cut
150    
151  sub add_message_to_queue {  sub add_message_to_list {
152          my $self = shift;          my $self = shift;
153    
154          my $args = {@_};          my $args = {@_};
# Line 155  sub add_message_to_queue { Line 156  sub add_message_to_queue {
156          my $list_name = $args->{'list'} || confess "need list name";          my $list_name = $args->{'list'} || confess "need list name";
157          my $message_text = $args->{'message'} || croak "need message";          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');          my $lists = $self->{'loader'}->find_class('lists');
166    
167          my $this_list = $lists->search(          my $this_list = $lists->search(
# Line 216  sub send_queued_messages { Line 223  sub send_queued_messages {
223                  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";
224                  my $msg = $m->message_id->message;                  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)) {                  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 )) {                          if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {
236                                  print "SKIP ",$u->user_id->email," message allready sent\n";                                  print "SKIP $to_email message allready sent\n";
237                          } else {                          } else {
238                                  print "\t",$u->user_id->email,"\n";                                  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                                  my $hdr = "From: " . $u->list_id->name . " <" . $u->list_id->email . ">\n" .                                  print Dumper($m);
248                                          "To: " . $u->user_id->full_name . " <". $u->user_id->email. ">\n";  
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 :-)                                  # FIXME do real sending :-)
253                                  send IO => "$hdr\n$msg";                                  send IO => $m->as_string;
254    
255                                  $sent->create({                                  $sent->create({
256                                          message_id => $m->message_id,                                          message_id => $m->message_id,
# Line 243  sub send_queued_messages { Line 266  sub send_queued_messages {
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;
279    
280            my $message = shift || return;
281    
282            my $m = new Email::Simple->new($message);
283    
284    }
285    
286    
287    =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');
344    
345            return $lists->search({ name => $name });
346    }
347    
348    
349  =head1 EXPORT  =head1 EXPORT
350    
351  Nothing.  Nothing.
Legend:
Removed from v.27  
changed lines
  Added in v.30
  ViewVC Help
Powered by ViewVC 1.1.26