/[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 21 by dpavlin, Sun May 15 21:35:15 2005 UTC revision 25 by dpavlin, Mon May 16 13:52:43 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(
12            add_member_to_list
13            add_message_to_queue
14  ) ] );  ) ] );
15    
16  our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );  our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
# Line 57  sub new { Line 59  sub new {
59          my $self = {@_};          my $self = {@_};
60          bless($self, $class);          bless($self, $class);
61    
62            croak "need at least dsn" unless ($self->{'dsn'});
63    
64          $self->{'loader'} = Class::DBI::Loader->new(          $self->{'loader'} = Class::DBI::Loader->new(
65                  debug           => $self->{'debug'},                  debug           => $self->{'debug'},
66                  dsn             => $self->{'dsn'},                  dsn             => $self->{'dsn'},
# Line 66  sub new { Line 70  sub new {
70  #               additional_classes      => qw/Class::DBI::AbstractSearch/,  #               additional_classes      => qw/Class::DBI::AbstractSearch/,
71  #               additional_base_classes => qw/My::Stuff/,  #               additional_base_classes => qw/My::Stuff/,
72                  relationships   => 1,                  relationships   => 1,
73          );          ) || croak "can't init Class::DBI::Loader";
74    
75          $self ? return $self : return undef;          $self ? return $self : return undef;
76  }  }
77    
78  =head2 update_list_email  =head2 add_member_to_list
79    
80    Add new member to list
81    
82  Update list e-mail address   $nos->add_member_to_list(
83            list => "My list",
84            email => "john.doe@example.com",
85            name => "John A. Doe",
86     );
87    
88   $noc->update_list_email($list, 'foobar@example.com');  C<name> parametar is optional.
89    
90    Return true if user is added.
91    
92  =cut  =cut
93    
94  sub update_list_email {  sub add_member_to_list {
95          my $self = shift;          my $self = shift;
96    
97            my $arg = {@_};
98    
99            my $email = $arg->{'email'} || confess "can't add user without e-mail";
100            my $name = $arg->{'name'} || '';
101            confess "need list name" unless ($arg->{'list'});
102    
103            if (! Email::Valid->address($email)) {
104                    warn "SKIPPING $name <$email>";
105                    return 0;
106            }
107    
108            print "# $name <$email>\n";
109    
110            my $lists = $self->{'loader'}->find_class('lists');
111            my $users = $self->{'loader'}->find_class('users');
112            my $user_list = $self->{'loader'}->find_class('user_list');
113    
114            my $list = $lists->find_or_create({
115                    name => $arg->{'list'},
116            }) || croak "can't add list ",$arg->{'list'},"\n";
117            
118            my $this_user = $users->find_or_create({
119                    email => $email,
120                    full_name => $name,
121            }) || croak "can't find or create member\n";
122    
123            my $user_on_list = $user_list->find_or_create({
124                    user_id => $this_user->id,
125                    list_id => $list->id,
126            }) || croak "can't add user to list";
127    
128            $list->dbi_commit;
129            $this_user->dbi_commit;
130            $user_on_list->dbi_commit;
131    
132            return 1;
133    }
134    
135    =head2 add_message_to_queue
136    
137    Adds message to one list's queue for later sending.
138    
139     $nos->add_message_to_queue(
140            list => 'My list',
141            message => 'From: My list <mylist@example.com>
142     To: John A. Doe <john.doe@example.com>
143    
144     This is example message
145     ',
146     );    
147    
148    On success returns ID of newly created (or existing) message.
149    
150    =cut
151    
152    sub add_message_to_queue {
153            my $self = shift;
154    
155            my $args = {@_};
156    
157            my $list_name = $args->{'list'} || confess "need list name";
158            my $message_text = $args->{'message'} || croak "need message";
159    
160            my $lists = $self->{'loader'}->find_class('lists');
161    
162            my $this_list = $lists->search(
163                    name => $list_name,
164            )->first || croak "can't find list $list_name";
165    
166            my $messages = $self->{'loader'}->find_class('messages');
167    
168            my $this_message = $messages->find_or_create({
169                    message => $message_text
170            }) || croak "can't insert message";
171    
172            $this_message->dbi_commit() || croak "can't add message";
173    
174            my $queue = $self->{'loader'}->find_class('queue');
175    
176            $queue->find_or_create({
177                    message_id => $this_message->id,
178                    list_id => $this_list->id,
179            }) || croak "can't add message ",$this_message->id," to list ",$this_list->id, ": ",$this_list->name;
180    
181            $queue->dbi_commit || croak "can't add message to list ",$this_list->name;
182    
183            return $this_message->id;
184  }  }
185    
 =head2 send  
186    
187  Send a message using configured mailer.  =head2 send_queued_messages
188    
189    Send queued messages or just ones for selected list
190    
191   $nos->send("message with headers");   $nos->send_queued_messages("My list");
192    
193  =cut  =cut
194    
195  sub send_email {  sub send_queued_messages {
196          my $self = shift;          my $self = shift;
197    
198          my $message = shift || return;          my $list_name = shift;
199    
200            my $lists = $self->{'loader'}->find_class('lists');
201            my $queue = $self->{'loader'}->find_class('queue');
202            my $user_list = $self->{'loader'}->find_class('user_list');
203            my $sent = $self->{'loader'}->find_class('sent');
204    
205            my $my_q;
206            if ($list_name ne '') {
207                    my $l_id = $lists->search_like( name => $list_name )->first ||
208                            croak "can't find list $list_name";
209                    $my_q = $queue->search_like( list_id => $l_id ) ||
210                            croak "can't find list $list_name";
211            } else {
212                    $my_q = $queue->retrieve_all;
213            }
214    
215            while (my $m = $my_q->next) {
216                    next if ($m->all_sent);
217    
218                    print "sending message ",$m->message_id," enqueued on ",$m->date," to list ",$m->list_id->name,"\n";
219                    my $msg = $m->message_id->message;
220    
221                    foreach my $u ($user_list->search(list_id => $m->list_id)) {
222    
223                            if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {
224                                    print "SKIP ",$u->user_id->email," message allready sent\n";
225                            } else {
226                                    print "\t",$u->user_id->email,"\n";
227    
228                                    my $hdr = "From: " . $u->list_id->name . " <" . $u->list_id->email . ">\n" .
229                                            "To: " . $u->user_id->full_name . " <". $u->user_id->email. ">\n";
230    
231                                    # FIXME do real sending :-)
232                                    send IO => "$hdr\n$msg";
233    
234                                    $sent->create({
235                                            message_id => $m->message_id,
236                                            user_id => $u->user_id,
237                                    });
238                                    $sent->dbi_commit;
239                            }
240                    }
241                    $m->all_sent(1);
242                    $m->update;
243                    $m->dbi_commit;
244            }
245    
         send IO => $message;  
246  }  }
247    
248  =head2 EXPORT  =head1 EXPORT
249    
250    Exported methods are also available using SOAP interface. For now, those are:
251    
252    =over 4
253    
254    =item add_member_to_list
255    
256    =item add_message_to_queue
257    
258    =back
259    
 None by default.  
260    
261  =head1 SEE ALSO  =head1 SEE ALSO
262    
263  mailman, ezmlm, sympa, L<Mail::Salsa>  mailman, ezmlm, sympa, L<Mail::Salsa>
264    
265    
266  =head1 AUTHOR  =head1 AUTHOR
267    
268  Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>  Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
269    
270    
271  =head1 COPYRIGHT AND LICENSE  =head1 COPYRIGHT AND LICENSE
272    
273  Copyright (C) 2005 by Dobrica Pavlinusic  Copyright (C) 2005 by Dobrica Pavlinusic
Legend:
Removed from v.21  
changed lines
  Added in v.25
  ViewVC Help
Powered by ViewVC 1.1.26