File Coverage

blib/lib/Labyrinth/Plugin/Articles/Newsletters.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Labyrinth::Plugin::Articles::Newsletters;
2              
3 5     5   77666 use warnings;
  5         10  
  5         161  
4 5     5   21 use strict;
  5         6  
  5         144  
5              
6 5     5   19 use vars qw($VERSION);
  5         11  
  5         301  
7             $VERSION = '1.00';
8              
9             =head1 NAME
10              
11             Labyrinth::Plugin::Articles::Newsletters - Newsletters plugin handler for Labyrinth
12              
13             =head1 DESCRIPTION
14              
15             Contains all the article handling functionality for Newsletters.
16              
17             =cut
18              
19             # -------------------------------------
20             # Library Modules
21              
22 5     5   26 use base qw(Labyrinth::Plugin::Articles);
  5         6  
  5         1846  
23              
24 5     5   3354 use Labyrinth::Audit;
  0            
  0            
25             use Labyrinth::DTUtils;
26             use Labyrinth::Mailer;
27             use Labyrinth::MLUtils;
28             use Labyrinth::Support;
29             use Labyrinth::Variables;
30              
31             use Encode qw/encode decode/;
32             use Session::Token;
33              
34             # -------------------------------------
35             # Variables
36              
37             our $LEVEL = EDITOR;
38             my $LEVEL2 = ADMIN;
39              
40             # sectionid is used to reference different types of articles,
41             # however, the default is also a standard article.
42             my $NEWSLETTERS = 12;
43              
44             # type: 0 = optional, 1 = mandatory
45             # html: 0 = none, 1 = text, 2 = textarea
46              
47             my %fields = (
48             articleid => { type => 0, html => 0 },
49             title => { type => 1, html => 1 },
50             );
51              
52             my (@mandatory,@allfields);
53             for(keys %fields) {
54             push @mandatory, $_ if($fields{$_}->{type});
55             push @allfields, $_;
56             }
57              
58             my %email_fields = (
59             name => { type => 1, html => 1 },
60             email => { type => 1, html => 1 },
61             resend => { type => 0, html => 1 },
62             );
63              
64             my (@email_man,@email_all);
65             for(keys %email_fields) {
66             push @email_man, $_ if($email_fields{$_}->{type});
67             push @email_all, $_;
68             }
69              
70             my %code_fields = (
71             id => { type => 1, html => 1 },
72             code => { type => 1, html => 1 },
73             );
74              
75             my (@code_man,@code_all);
76             for(keys %code_fields) {
77             push @code_man, $_ if($code_fields{$_}->{type});
78             push @code_all, $_;
79             }
80              
81             my %subs_fields = (
82             subscriptions => { type => 1, html => 1 },
83             );
84              
85             my (@subs_man,@subs_all);
86             for(keys %subs_fields) {
87             push @subs_man, $_ if($subs_fields{$_}->{type});
88             push @subs_all, $_;
89             }
90              
91             my %send_fields = (
92             hFrom => { type => 1, html => 1 },
93             hSubject => { type => 1, html => 1 },
94             );
95              
96             my (@send_man,@send_all);
97             for(keys %send_fields) {
98             push @send_man, $_ if($send_fields{$_}->{type});
99             push @send_all, $_;
100             }
101              
102             my $gen = Session::Token->new(length => 24);
103              
104             # -------------------------------------
105             # The Subs
106              
107             =head1 PUBLIC INTERFACE METHODS
108              
109             =over 4
110              
111             =item Section
112              
113             Sets for Newsletter Articles within the system.
114              
115             =item Subscribe
116              
117             Single user subscription process. To be used by users who wish to sign up to
118             the newsletters. Starts the subscription process.
119              
120             =item Subscribed
121              
122             Last part of the subscription process.
123              
124             =item UnSubscribe
125              
126             Single user unsubscription process. To be used by users who have previously
127             signing up for the newsletters. Starts the unsubscription process.
128              
129             =item UnSubscribed
130              
131             Last part of the unsubscription process.
132              
133             =back
134              
135             =cut
136              
137             sub Section {
138             $cgiparams{sectionid} = $NEWSLETTERS;
139             }
140              
141             sub Subscribe {
142             # requires: name, email
143             for(keys %email_fields) {
144             if($email_fields{$_}->{html} == 1) { $cgiparams{$_} = CleanHTML($cgiparams{$_}); }
145             elsif($email_fields{$_}->{html} == 2) { $cgiparams{$_} = SafeHTML($cgiparams{$_}); }
146             }
147              
148             return if FieldCheck(\@email_all,\@email_man);
149              
150             # already exists?
151             my @email = $dbi->GetQuery('hash','CheckSubscptionEmail',$tvars{data}{email});
152             if(@email && !$tvars{data}{resend}) {
153             $tvars{resend} = 1;
154             $tvars{sub}{email} = $tvars{data}{email};
155             $tvars{sub}{name} = $tvars{data}{name};
156             return;
157             }
158              
159             my $code = $gen->get();
160             my $subscriptionid;
161              
162             if(@email) {
163             $subscriptionid = $email[0]->{subscriptionid};
164             $dbi->DoQuery('UpdateUnConfirmedEmail',$tvars{data}{email},$code,$subscriptionid);
165             } else {
166             $subscriptionid = $dbi->IDQuery('InsertSubscriptionEmail',$tvars{data}{name},$tvars{data}{email},$code);
167             }
168              
169             MailSend( template => '',
170             name => $tvars{data}{name},
171             recipient_email => $tvars{data}{email},
172             code => "$code/$subscriptionid",
173             webpath => "$tvars{docroot}$tvars{webpath}",
174             nowrap => 1
175             );
176              
177             if(!MailSent()) {
178             $tvars{failure} = 1;
179             } else {
180             $tvars{success} = 1;
181             }
182             }
183              
184             sub Subscribed {
185             # requires: keycode, id
186             for(keys %code_fields) {
187             if($code_fields{$_}->{html} == 1) { $cgiparams{$_} = CleanHTML($cgiparams{$_}); }
188             elsif($code_fields{$_}->{html} == 2) { $cgiparams{$_} = SafeHTML($cgiparams{$_}); }
189             }
190              
191             return if FieldCheck(\@code_all,\@code_man);
192              
193             my @email = $dbi->GetQuery('hash','CheckSubscriptionKey',$tvars{data}{code},$tvars{data}{id});
194             if(@email) {
195             $dbi->DoQuery('ConfirmedSubscription',$tvars{data}{id});
196             $tvars{success} = 1;
197             }
198             }
199              
200             sub UnSubscribe {
201             # requires: email
202             return unless($cgiparams{email});
203              
204             # doesn't exist?
205             my @email = $dbi->GetQuery('hash','CheckSubscptionEmail',$cgiparams{email});
206             return unless(@email);
207              
208             $dbi->DoQuery('RemoveSubscription',$email[0]->{subscriptionid});
209             $tvars{success} = 1;
210             }
211              
212             =head1 ADMIN INTERFACE METHODS
213              
214             =over 4
215              
216             =item AdminSubscription
217              
218             List current subscriptions.
219              
220             =item BulkSubscription
221              
222             Add bulk email subscriptions.
223              
224             =item DeleteSubscription
225              
226             Delete email subscriptions.
227              
228             =item PrepareNewsletter
229              
230             Prepares the selected newseletter and subscriber list.
231              
232             =item SendNewsletter
233              
234             Sends out the selected newseletter to the selected subscriber list.
235              
236             =back
237              
238             =cut
239              
240             sub AdminSubscription {
241             my $self = shift;
242              
243             return unless AccessUser($LEVEL);
244              
245             if($cgiparams{doaction}) {
246             $self->DeleteSubscription() if($cgiparams{doaction} eq 'Delete');
247             }
248              
249             my @emails = $dbi->GetQuery('hash','ListSubscptions');
250             $tvars{data} = \@emails if(@emails);
251             }
252              
253             sub BulkSubscription {
254             return unless AccessUser($LEVEL);
255              
256             # requires: subscriptions
257             for(keys %subs_fields) {
258             if($subs_fields{$_}->{html} == 1) { $cgiparams{$_} = CleanHTML($cgiparams{$_}); }
259             elsif($subs_fields{$_}->{html} == 2) { $cgiparams{$_} = SafeHTML($cgiparams{$_}); }
260             }
261              
262             return if FieldCheck(\@subs_all,\@subs_man);
263             my @subs = split(qr/\s+/,$tvars{data}{subscriptions});
264             for my $sub (@subs) {
265             my ($name,$email) = split(',',$sub);
266              
267             # already exists?
268             my @email = $dbi->GetQuery('hash','CheckSubscptionEmail',$email);
269             if(@email) {
270             $dbi->DoQuery('UpdateConfirmedEmail',$name,'',$email[0]->{subscriptionid});
271             } else {
272             $dbi->IDQuery('InsertSubscriptionEmail',$name,$email,'');
273             }
274             }
275             }
276              
277             sub DeleteSubscription {
278             return unless AccessUser($LEVEL);
279            
280             my @ids = CGIArray('LISTED');
281             $dbi->DoQuery('RemoveSubscription',$_) for(@ids);
282             }
283              
284             sub PrepareNewsletter {
285             return unless AccessUser($LEVEL);
286             my @emails = $dbi->GetQuery('hash','GetSubscribers');
287             $tvars{data} = \@emails if(@emails);
288             }
289              
290             sub SendNewsletter {
291             return unless AccessUser($LEVEL);
292              
293             for(keys %send_fields) {
294             if($send_fields{$_}->{html} == 1) { $cgiparams{$_} = CleanHTML($cgiparams{$_}); }
295             elsif($send_fields{$_}->{html} == 2) { $cgiparams{$_} = SafeHTML($cgiparams{$_}); }
296             }
297              
298             return if FieldCheck(\@send_all,\@send_man);
299              
300             # ensure we have a newsletter
301             return unless AuthorCheck('GetArticleByID','articleid',$LEVEL);
302              
303             my %opts = (
304             text => 'mailer/newsletter.txt',
305             html => 'mailer/newsletter.html',
306             nowrap => 1,
307             from => $tvars{data}{hFrom},
308             subject => $tvars{data}{hSubject}
309             );
310              
311             my @id = CGIArray('LISTED');
312             $tvars{gotusers} = scalar(@id);
313             $tvars{mailsent} = 0;
314              
315             for my $id (@id) {
316             my @users = $dbi->GetQuery('hash','CheckSubscriptionKey','',$id);
317             next unless(@users);
318             my $user = $users[0];
319             $user->{name} = encode('MIME-Q', decode('MIME-Header', $user->{name}));
320              
321             $opts{body} = $tvars{data}{body};
322             $opts{vars} = \%tvars;
323             $opts{edate} = formatDate(16);
324             $opts{email} = $user->{email};
325             $opts{recipient_email} = $user->{email};
326             $opts{ename} = $user->{name} || '';
327             $opts{mname} = $user->{name};
328              
329             for my $key (qw(from subject body)) {
330             $opts{$key} =~ s/ENAME/$user->{name}/g;
331             $opts{$key} =~ s/EMAIL/$user->{email}/g;
332             $opts{$key} =~ s/\r/ /g; # a bodge
333             }
334              
335             #use Data::Dumper;
336             #LogDebug("opts=".Dumper(\%opts));
337             HTMLSend(%opts);
338             $dbi->DoQuery('InsertNewsletterIndex',$cgiparams{articleid},$user->{subscriptionid},time());
339              
340             # if sent update index
341             $tvars{mailsent}++ if(MailSent());
342             }
343              
344             $tvars{thanks} = $tvars{mailsent} ? 2 : 3;
345             }
346              
347             1;
348              
349             __END__