/[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

Annotation of /trunk/Nos.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 23 - (hide annotations)
Sun May 15 22:12:31 2005 UTC (18 years, 9 months ago) by dpavlin
File size: 4449 byte(s)
added add_member_to_list

1 dpavlin 20 package Nos;
2    
3     use 5.008;
4     use strict;
5     use warnings;
6    
7     require Exporter;
8    
9     our @ISA = qw(Exporter);
10    
11     our %EXPORT_TAGS = ( 'all' => [ qw(
12     ) ] );
13    
14     our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
15    
16     our @EXPORT = qw(
17     );
18    
19     our $VERSION = '0.1';
20    
21     use Class::DBI::Loader;
22     use Email::Valid;
23     use Email::Send;
24     use Carp;
25    
26     =head1 NAME
27    
28     Nos - Notice Sender core module
29    
30     =head1 SYNOPSIS
31    
32     use Nos;
33     my $nos = new Nos();
34    
35     =head1 DESCRIPTION
36    
37     Core module for notice sender's functionality.
38    
39     =head1 METHODS
40    
41     =head2 new
42    
43     Create new instance specifing database, user, password and options.
44    
45     my $nos = new Nos(
46     dsn => 'dbi:Pg:dbname=notices',
47     user => 'dpavlin',
48     passwd => '',
49     debug => 1,
50     verbose => 1,
51     );
52    
53     =cut
54    
55     sub new {
56     my $class = shift;
57     my $self = {@_};
58     bless($self, $class);
59    
60 dpavlin 22 croak "need at least dsn" unless ($self->{'dsn'});
61    
62 dpavlin 20 $self->{'loader'} = Class::DBI::Loader->new(
63     debug => $self->{'debug'},
64     dsn => $self->{'dsn'},
65     user => $self->{'user'},
66     password => $self->{'passwd'},
67     namespace => "Nos",
68     # additional_classes => qw/Class::DBI::AbstractSearch/,
69     # additional_base_classes => qw/My::Stuff/,
70     relationships => 1,
71 dpavlin 22 ) || croak "can't init Class::DBI::Loader";
72 dpavlin 20
73     $self ? return $self : return undef;
74     }
75    
76 dpavlin 23 =head2 add_member_to_list
77    
78     Add new member to list
79    
80     $nos->add_member_to_list(
81     list => "My list",
82     email => "john.doe@example.com",
83     name => "John A. Doe",
84     );
85    
86     C<name> parametar is optional.
87    
88     Return true if user is added.
89    
90     =cut
91    
92     sub add_member_to_list {
93     my $self = shift;
94    
95     my $arg = {@_};
96    
97     my $email = $arg->{'email'} || confess "can't add user without e-mail";
98     my $name = $arg->{'name'} || '';
99     confess "need list name" unless ($arg->{'list'});
100    
101     if (! Email::Valid->address($email)) {
102     warn "SKIPPING $name <$email>";
103     return 0;
104     }
105    
106     print "# $name <$email>\n";
107    
108     my $lists = $self->{'loader'}->find_class('lists');
109     my $users = $self->{'loader'}->find_class('users');
110     my $user_list = $self->{'loader'}->find_class('user_list');
111    
112     my $list = $lists->find_or_create({
113     name => $arg->{'list'},
114     }) || croak "can't add list ",$arg->{'list'},"\n";
115    
116     my $this_user = $users->find_or_create({
117     email => $email,
118     full_name => $name,
119     }) || croak "can't find or create member\n";
120    
121     my $user_on_list = $user_list->find_or_create({
122     user_id => $this_user->id,
123     list_id => $list->id,
124     }) || croak "can't add user to list";
125    
126     $list->dbi_commit;
127     $this_user->dbi_commit;
128     $user_on_list->dbi_commit;
129    
130     return 1;
131     }
132    
133 dpavlin 22 =head2 send_queued_messages
134 dpavlin 20
135 dpavlin 22 Send queued messages or just ones for selected list
136 dpavlin 20
137 dpavlin 22 $noc->send_queued_messages("my list");
138 dpavlin 20
139 dpavlin 21 =cut
140 dpavlin 20
141 dpavlin 22 sub send_queued_messages {
142 dpavlin 21 my $self = shift;
143 dpavlin 20
144 dpavlin 22 my $list_name = shift;
145 dpavlin 20
146 dpavlin 22 my $lists = $self->{'loader'}->find_class('lists');
147     my $queue = $self->{'loader'}->find_class('queue');
148     my $user_list = $self->{'loader'}->find_class('user_list');
149     my $sent = $self->{'loader'}->find_class('sent');
150 dpavlin 20
151 dpavlin 22 my $my_q;
152     if ($list_name ne '') {
153     my $l_id = $lists->search_like( name => $list_name )->first ||
154     croak "can't find list $list_name";
155     $my_q = $queue->search_like( list_id => $l_id ) ||
156     croak "can't find list $list_name";
157     } else {
158     $my_q = $queue->retrieve_all;
159     }
160 dpavlin 20
161 dpavlin 22 while (my $m = $my_q->next) {
162     next if ($m->all_sent);
163 dpavlin 20
164 dpavlin 22 print "sending message ",$m->message_id," enqueued on ",$m->date," to list ",$m->list_id->name,"\n";
165     my $msg = $m->message_id->message;
166 dpavlin 20
167 dpavlin 22 foreach my $u ($user_list->search(list_id => $m->list_id)) {
168 dpavlin 20
169 dpavlin 22 if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {
170     print "SKIP ",$u->user_id->email," message allready sent\n";
171     } else {
172     print "\t",$u->user_id->email,"\n";
173 dpavlin 20
174 dpavlin 22 my $hdr = "From: " . $u->list_id->name . " <" . $u->list_id->email . ">\n" .
175     "To: " . $u->user_id->full_name . " <". $u->user_id->email. ">\n";
176 dpavlin 20
177 dpavlin 22 # FIXME do real sending :-)
178     send IO => "$hdr\n$msg";
179    
180     $sent->create({
181     message_id => $m->message_id,
182     user_id => $u->user_id,
183     });
184     $sent->dbi_commit;
185     }
186     }
187     $m->all_sent(1);
188     $m->update;
189     $m->dbi_commit;
190     }
191    
192 dpavlin 20 }
193    
194     =head2 EXPORT
195    
196     None by default.
197    
198     =head1 SEE ALSO
199    
200     mailman, ezmlm, sympa, L<Mail::Salsa>
201    
202     =head1 AUTHOR
203    
204     Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
205    
206     =head1 COPYRIGHT AND LICENSE
207    
208     Copyright (C) 2005 by Dobrica Pavlinusic
209    
210     This library is free software; you can redistribute it and/or modify
211     it under the same terms as Perl itself, either Perl version 5.8.4 or,
212     at your option, any later version of Perl 5 you may have available.
213    
214    
215     =cut

  ViewVC Help
Powered by ViewVC 1.1.26