/[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 37 by dpavlin, Tue May 17 19:15:27 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 56  Create new instance specifing database, Line 56  Create new instance specifing database,
56          hash_len => 8,          hash_len => 8,
57   );   );
58    
59  Parametar C<hash_len> defined length of hash which will be added to each  Parametar C<hash_len> defines length of hash which will be added to each
60  outgoing e-mail message.  outgoing e-mail message to ensure that replies can be linked with sent e-mails.
61    
62  =cut  =cut
63    
# Line 87  sub new { Line 87  sub new {
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 155  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 172  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.
# Line 179  Adds message to one list's queue for lat Line 266  Adds message to one list's queue for lat
266   $nos->add_message_to_list(   $nos->add_message_to_list(
267          list => 'My list',          list => 'My list',
268          message => 'Subject: welcome to list          message => 'Subject: welcome to list
269    
270   This is example message   This is example message
271   ',   ',
272   );       );    
# Line 285  sub send_queued_messages { Line 372  sub send_queued_messages {
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    
# Line 364  sub inbox_message { Line 454  sub inbox_message {
454                  $user_id = $sent_msg->user_id || carp "no user_id";                  $user_id = $sent_msg->user_id || carp "no user_id";
455          }          }
456    
 print "message_id: ",($message_id || "not found"),"\n";  
457    
458          my $is_bounce = 0;          my $is_bounce = 0;
459    
# Line 387  print "message_id: ",($message_id || "no Line 476  print "message_id: ",($message_id || "no
476    
477          $this_received->dbi_commit;          $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";          warn "inbox is not yet implemented";
483  }  }
484    
# Line 406  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 452  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 477  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.37  
changed lines
  Added in v.45

  ViewVC Help
Powered by ViewVC 1.1.26