/[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 33 by dpavlin, Tue May 17 11:09:08 2005 UTC revision 45 by dpavlin, Wed May 18 13:12:54 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.3';  our $VERSION = '0.4';
20    
21  use Class::DBI::Loader;  use Class::DBI::Loader;
22  use Email::Valid;  use Email::Valid;
# 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 Mail::DeliveryStatus::BounceParser;
29  use Data::Dumper;  use Data::Dumper;
30    
31  =head1 NAME  =head1 NAME
# Line 51  Create new instance specifing database, Line 53  Create new instance specifing database,
53          passwd => '',          passwd => '',
54          debug => 1,          debug => 1,
55          verbose => 1,          verbose => 1,
56            hash_len => 8,
57   );   );
58    
59    Parametar C<hash_len> defines length of hash which will be added to each
60    outgoing e-mail message to ensure that replies can be linked with sent e-mails.
61    
62  =cut  =cut
63    
64  sub new {  sub new {
# Line 73  sub new { Line 79  sub new {
79                  relationships   => 1,                  relationships   => 1,
80          ) || croak "can't init Class::DBI::Loader";          ) || croak "can't init Class::DBI::Loader";
81    
82            $self->{'hash_len'} ||= 8;
83    
84          $self ? return $self : return undef;          $self ? return $self : return undef;
85  }  }
86    
87    
88  =head2 new_list  =head2 new_list
89    
90  Create new list  Create new list. Required arguments are name of C<list> and
91    C<email> address.
92    
93   $nos->new_list(   $nos->new_list(
94          list => 'My list",          list => 'My list',
95          email => 'my-list@example.com',          email => 'my-list@example.com',
96   );   );
97    
98  Returns ID of newly created list.  Returns ID of newly created list.
99    
100    Calls internally L<_add_list>, see details there.
101    
102  =cut  =cut
103    
104  sub new_list {  sub new_list {
# Line 147  sub add_member_to_list { Line 158  sub add_member_to_list {
158                  email => $email,                  email => $email,
159          }) || croak "can't find or create member\n";          }) || croak "can't find or create member\n";
160    
161          if ($name && $this_user->full_name ne $name) {          if ($name && $this_user->name ne $name) {
162                  $this_user->full_name($name || '');                  $this_user->name($name || '');
163                  $this_user->update;                  $this_user->update;
164          }          }
165    
# Line 164  sub add_member_to_list { Line 175  sub add_member_to_list {
175          return $this_user->id;          return $this_user->id;
176  }  }
177    
178    =head2 list_members
179    
180    List all members of some list.
181    
182     my @members = list_members(
183            list => 'My list',
184     );
185    
186    Returns array of hashes with user informations like this:
187    
188     $member = {
189            name => 'Dobrica Pavlinusic',
190            email => 'dpavlin@rot13.org
191     }
192    
193    If list is not found, returns false.
194    
195    =cut
196    
197    sub list_members {
198            my $self = shift;
199    
200            my $args = {@_};
201    
202            my $list_name = $args->{'list'} || confess "need list name";
203    
204            my $lists = $self->{'loader'}->find_class('lists');
205            my $user_list = $self->{'loader'}->find_class('user_list');
206    
207            my $this_list = $lists->search( name => $list_name )->first || return;
208    
209            my @results;
210    
211            foreach my $user_on_list ($user_list->search(list_id => $this_list->id)) {
212                    my $row = {
213                            name => $user_on_list->user_id->name,
214                            email => $user_on_list->user_id->email,
215                    };
216    
217                    push @results, $row;
218            }
219    
220            return @results;
221    
222    }
223    
224    
225    =head2 delete_member
226    
227    Delete member from database.
228    
229     my $ok = delete_member(
230            name => 'Dobrica Pavlinusic'
231     );
232    
233     my $ok = delete_member(
234            email => 'dpavlin@rot13.org'
235     );
236    
237    Returns false if user doesn't exist.
238    
239    =cut
240    
241    sub delete_member {
242            my $self = shift;
243    
244            my $args = {@_};
245    
246            croak "need name or email of user to delete" unless ($args->{'name'} || $args->{'email'});
247    
248            my $key = 'name';
249            $key = 'email' if ($args->{'email'});
250    
251            my $users = $self->{'loader'}->find_class('users');
252    
253            my $this_user = $users->search( $key => $args->{$key} )->first || return;
254    
255    print Dumper($this_user);
256    
257            $this_user->delete || croak "can't delete user\n";
258    
259            return $users->dbi_commit || croak "can't commit";
260    }
261    
262  =head2 add_message_to_list  =head2 add_message_to_list
263    
264  Adds message to one list's queue for later sending.  Adds message to one list's queue for later sending.
265    
266   $nos->add_message_to_list(   $nos->add_message_to_list(
267          list => 'My list',          list => 'My list',
268          message => 'From: My list <mylist@example.com>          message => 'Subject: welcome to list
269   To: John A. Doe <john.doe@example.com>  
   
270   This is example message   This is example message
271   ',   ',
272   );       );    
273    
274  On success returns ID of newly created (or existing) message.  On success returns ID of newly created (or existing) message.
275    
276    Only required header in e-mail is C<Subject:>. C<From:> and C<To:> headers
277    will be automatically generated, but if you want to use own headers, just
278    include them in messages.
279    
280  =cut  =cut
281    
282  sub add_message_to_list {  sub add_message_to_list {
# Line 269  sub send_queued_messages { Line 367  sub send_queued_messages {
367                                  print "=> $to_email\n";                                  print "=> $to_email\n";
368    
369                                  my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id;                                  my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id;
370                                  my $auth = Email::Auth::AddressHash->new( $secret, 10 );                                  my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} );
371    
372                                  my $hash = $auth->generate_hash( $to_email );                                  my $hash = $auth->generate_hash( $to_email );
373    
374                                  my $from = $u->list_id->name . " <" . $from . "+" . $hash . ( $domain ? "@" . $domain : '' ). ">";                                  my $from = $u->list_id->name . " <" . $from . "+" . $hash . ( $domain ? "@" . $domain : '' ). ">";
375                                  my $to = $u->user_id->full_name . " <$to_email>";                                  my $to = $u->user_id->name . " <$to_email>";
376    
377                                  my $m_obj = Email::Simple->new($msg) || croak "can't parse message";                                  my $m_obj = Email::Simple->new($msg) || croak "can't parse message";
378    
379                                  $m_obj->header_set('From', $from) || croak "can't set From: header";                                  $m_obj->header_set('From', $from) || croak "can't set From: header";
380                                  $m_obj->header_set('To', $to) || croak "can't set To: header";                                  $m_obj->header_set('To', $to) || croak "can't set To: header";
381    
382                                    $m_obj->header_set('X-Nos-Version', $VERSION);
383                                    $m_obj->header_set('X-Nos-Hash', $hash);
384    
385                                  # FIXME do real sending :-)                                  # FIXME do real sending :-)
386                                  send IO => $m_obj->as_string;                                  send IO => $m_obj->as_string;
387    
388                                  $sent->create({                                  $sent->create({
389                                          message_id => $m->message_id,                                          message_id => $m->message_id,
390                                          user_id => $u->user_id,                                          user_id => $u->user_id,
391                                            hash => $hash,
392                                  });                                  });
393                                  $sent->dbi_commit;                                  $sent->dbi_commit;
394                          }                          }
# Line 302  sub send_queued_messages { Line 404  sub send_queued_messages {
404    
405  Receive single message for list's inbox.  Receive single message for list's inbox.
406    
407   my $ok = $nos->inbox_message($message);   my $ok = $nos->inbox_message(
408            list => 'My list',
409            message => $message,
410     );
411    
412  =cut  =cut
413    
414  sub inbox_message {  sub inbox_message {
415          my $self = shift;          my $self = shift;
416    
417          my $message = shift || return;          my $arg = {@_};
418    
419            return unless ($arg->{'message'});
420            croak "need list name" unless ($arg->{'list'});
421    
422            my $this_list = $self->_get_list($arg->{'list'}) || croak "can't find list ".$arg->{'list'}."\n";
423    
424            my $m = Email::Simple->new($arg->{'message'}) || croak "can't parse message";
425    
426            my $to = $m->header('To') || die "can't find To: address in incomming message\n";
427    
428            my @addrs = Email::Address->parse( $to );
429    
430            die "can't parse To: $to address\n" unless (@addrs);
431    
432            my $hl = $self->{'hash_len'} || confess "no hash_len?";
433    
434            my $hash;
435    
436            foreach my $a (@addrs) {
437                    if ($a->address =~ m/\+([a-f0-9]{$hl})@/) {
438                            $hash = $1;
439                            last;
440                    }
441            }
442    
443            croak "can't find hash in e-mail $to\n" unless ($hash);
444    
445            my $sent = $self->{'loader'}->find_class('sent');
446    
447            # will use null if no matching message_id is found
448            my $sent_msg = $sent->search( hash => $hash )->first;
449    
450            my ($message_id, $user_id) = (undef, undef);    # init with NULL
451    
452            if ($sent_msg) {
453                    $message_id = $sent_msg->message_id || carp "no message_id";
454                    $user_id = $sent_msg->user_id || carp "no user_id";
455            }
456    
457    
458          my $m = new Email::Simple->new($message);          my $is_bounce = 0;
459    
460            my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(
461                    $arg->{'message'}, { report_non_bounces=>1 },
462            ) };
463            carp "can't check if this message is bounce!" if ($@);
464    
465            $is_bounce++ if ($bounce && $bounce->is_bounce);
466    
467            my $received = $self->{'loader'}->find_class('received');
468    
469            my $this_received = $received->find_or_create({
470                    user_id => $user_id,
471                    list_id => $this_list->id,
472                    message_id => $message_id,
473                    message => $arg->{'message'},
474                    bounced => $is_bounce,
475            }) || croak "can't insert received message";
476    
477            $this_received->dbi_commit;
478    
479            print "message_id: ",($message_id || "not found")," -- $is_bounce\n";
480    
481    
482            warn "inbox is not yet implemented";
483  }  }
484    
485    
# Line 331  Create new list Line 498  Create new list
498    
499  Returns C<Class::DBI> object for created list.  Returns C<Class::DBI> object for created list.
500    
501    C<email> address can be with domain or without it if your
502    MTA appends it. There is no checking for validity of your
503    list e-mail. Flexibility comes with resposibility, so please
504    feed correct (and configured) return addresses.
505    
506  =cut  =cut
507    
508  sub _add_list {  sub _add_list {
# Line 377  sub _get_list { Line 549  sub _get_list {
549          return $lists->search({ name => $name })->first;          return $lists->search({ name => $name })->first;
550  }  }
551    
552    ###
553    ### SOAP
554    ###
555    
556    package Nos::SOAP;
557    
558    use Carp;
559    
560    =head1 SOAP methods
561    
562    This methods are thin wrappers to provide SOAP calls. They are grouped in
563    C<Nos::SOAP> package which is in same F<Nos.pm> module file.
564    
565    Usually, you want to use named variables in your SOAP calls if at all
566    possible.
567    
568    However, if you have broken SOAP library (like PHP SOAP class from PEAR)
569    you will want to use positional arguments (in same order as documented for
570    methods below).
571    
572    =cut
573    
574    my $nos;
575    
576    sub new {
577            my $class = shift;
578            my $self = {@_};
579            bless($self, $class);
580    
581            $nos = new Nos( @_ ) || die "can't create Nos object";
582    
583            $self ? return $self : return undef;
584    }
585    
586    
587    =head2 NewList
588    
589     $message_id = NewList(
590            list => 'My list',
591            email => 'my-list@example.com'
592     );
593    
594    =cut
595    
596    sub NewList {
597            my $self = shift;
598    
599            if ($_[0] !~ m/^HASH/) {
600                    return $nos->new_list(
601                            list => $_[0], email => $_[1],
602                    );
603            } else {
604                    return $nos->new_list( %{ shift @_ } );
605            }
606    }
607    
608    
609    =head2 AddMemberToList
610    
611     $member_id = AddMemberToList(
612            list => 'My list',
613            email => 'e-mail@example.com',
614            name => 'Full Name'
615     );
616    
617    =cut
618    
619    sub AddMemberToList {
620            my $self = shift;
621    
622            if ($_[0] !~ m/^HASH/) {
623                    return $nos->add_member_to_list(
624                            list => $_[0], email => $_[1], name => $_[2],
625                    );
626            } else {
627                    return $nos->add_member_to_list( %{ shift @_ } );
628            }
629    }
630    
631    
632    =head2 ListMembers
633    
634     my @members = ListMembers(
635            list => 'My list',
636     );
637    
638    Returns array of hashes with user informations, see C<list_members>.
639    
640    =cut
641    
642    sub ListMembers {
643            my $self = shift;
644    
645            my $list_name;
646    
647            if ($_[0] !~ m/^HASH/) {
648                    $list_name = shift;
649            } else {
650                    $list_name = $_[0]->{'list'};
651            }
652    
653            return $nos->list_members( list => $list_name );
654    }
655    
656    =head2 AddMessageToList
657    
658     $message_id = AddMessageToList(
659            list => 'My list',
660            message => 'From: My list...'
661     );
662    
663    =cut
664    
665    sub AddMessageToList {
666            my $self = shift;
667    
668            if ($_[0] !~ m/^HASH/) {
669                    return $nos->add_message_to_list(
670                            list => $_[0], message => $_[1],
671                    );
672            } else {
673                    return $nos->add_message_to_list( %{ shift @_ } );
674            }
675    }
676    
677    
678    ###
679    
680  =head1 EXPORT  =head1 EXPORT
681    
# Line 402  at your option, any later version of Per Line 701  at your option, any later version of Per
701    
702    
703  =cut  =cut
704    
705    1;
Legend:
Removed from v.33  
changed lines
  Added in v.45
  ViewVC Help
Powered by ViewVC 1.1.26