/[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 25 by dpavlin, Mon May 16 13:52:43 2005 UTC revision 32 by dpavlin, Mon May 16 22:32:58 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 Data::Dumper;
28    
29  =head1 NAME  =head1 NAME
30    
# Line 75  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 87  Add new member to list Line 89  Add new member to list
89    
90  C<name> parametar is optional.  C<name> parametar is optional.
91    
92  Return true if user is added.  Return member ID if user is added.
93    
94  =cut  =cut
95    
# Line 96  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 "# $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 129  sub add_member_to_list { Line 128  sub add_member_to_list {
128          $this_user->dbi_commit;          $this_user->dbi_commit;
129          $user_on_list->dbi_commit;          $user_on_list->dbi_commit;
130    
131          return 1;          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 149  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 157  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            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');          my $lists = $self->{'loader'}->find_class('lists');
167    
168          my $this_list = $lists->search(          my $this_list = $lists->search(
# Line 220  sub send_queued_messages { Line 226  sub send_queued_messages {
226    
227                  foreach my $u ($user_list->search(list_id => $m->list_id)) {                  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 )) {                          if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {
234                                  print "SKIP ",$u->user_id->email," message allready sent\n";                                  print "SKIP $to_email message allready sent\n";
235                          } else {                          } else {
236                                  print "\t",$u->user_id->email,"\n";                                  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 $hdr = "From: " . $u->list_id->name . " <" . $u->list_id->email . ">\n" .                                  my $m_obj = Email::Simple->new($msg) || croak "can't parse message";
247                                          "To: " . $u->user_id->full_name . " <". $u->user_id->email. ">\n";  
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 :-)                                  # FIXME do real sending :-)
252                                  send IO => "$hdr\n$msg";                                  send IO => $m_obj->as_string;
253    
254                                  $sent->create({                                  $sent->create({
255                                          message_id => $m->message_id,                                          message_id => $m->message_id,
# Line 245  sub send_queued_messages { Line 265  sub send_queued_messages {
265    
266  }  }
267    
268  =head1 EXPORT  =head2 inbox_message
269    
270    Receive single message for list's inbox.
271    
272     my $ok = $nos->inbox_message($message);
273    
274    =cut
275    
276    sub inbox_message {
277            my $self = shift;
278    
279            my $message = shift || return;
280    
281            my $m = new Email::Simple->new($message);
282    
283    }
284    
285    
286    =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  Exported methods are also available using SOAP interface. For now, those are:          $l->dbi_commit;
321    
322  =over 4          return $l;
323    
324  =item add_member_to_list  }
325    
326    
327    =head2 _get_list
328    
329    Get list C<Class::DBI> object.
330    
331  =item add_message_to_queue   my $list_obj = $nos->check_list('My list');
332    
333  =back  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    
Legend:
Removed from v.25  
changed lines
  Added in v.32
  ViewVC Help
Powered by ViewVC 1.1.26