File Coverage

blib/lib/Newsletter/Html.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             package Newsletter::Html;
2              
3 1     1   3568 use warnings;
  1         2  
  1         22  
4              
5 1     1   4 use strict;
  1         1  
  1         31  
6              
7 1     1   705 use Newsletter::Html::Templ;
  0            
  0            
8             use Newsletter;
9             use base ("Newsletter::Html::Templ", "Newsletter::Html::Upload");
10             use MIME::Base64;
11             use File::Path;
12              
13             use vars qw($VERSION);
14              
15             our $VERSION = '0.02';
16              
17             sub new {
18             my $obj = shift;
19             my $newsletterObj = shift;
20             my $uploadPath = shift;
21              
22             if(!$newsletterObj) {
23             die "Newsletter Param is empty\n";
24             }
25              
26             my $self = {};
27             #$self->{'cgi'} = new CGI;
28             $self->{'nl'} = $$newsletterObj;
29             $self->{'out'} = '';
30             $self->{'persistent'} = {};
31             $self->{'tmp'} = {};
32             $self->{'info'} = undef;
33             $self->{'uploadPath'} = '/tmp';
34              
35             if( $uploadPath ) {
36             $self->{'uploadPath'} = $uploadPath;
37             if(! -d $self->{'uploadPath'} ) {
38             warn "Upload path [$uploadPath] does not exist! try to create\n";
39             mkpath( $self->{'uploadPath'} );
40             }
41             }
42              
43             bless($self,$obj);
44             $self->init;
45              
46             return($self);
47             }
48              
49              
50             sub header {
51             my ($self, %param) = @_;
52              
53             my @cookies = $self->_persistent();
54              
55             if( exists $self->{'persistent'}->{'pSection'} ) {
56             if( $self->{'persistent'}->{'pSection'} eq "home" &&
57             $self->{'cgi'}->param() == 1
58             ) {
59             @cookies = $self->_persistentClean();
60             }
61             }
62              
63             $self->_out( $self->{'cgi'}->header(
64             -cookie=>\@cookies,
65             -expires=>'now',
66             ) );
67              
68             $self->_out( $self->{'cgi'}->start_html(
69             -title=>'Newsletter Simple',
70             -author=>'hochreiter@soft.uni-linz.ac.at',
71             -meta=>{'keywords' => 'Newsletter Mail Sender Simple',
72             'copyright'=> 'Dominik Hochreiter published under GNU'},
73             %param,
74             ) );
75              
76             if(! exists $param{'-style'} ) {
77             require Newsletter::Html::CSS;
78             $self->_out( $Newsletter::Html::CSS::CSS );
79             }
80              
81             $self->_out( $self->{'cgi'}->p( {-align=>'left'}, $self->{'cgi'}->a( {-href => "?pSection=home"}, "Home" ) ) );
82             $self->_out( $self->{'cgi'}->hr );
83              
84             return $self->_outString;
85             }
86              
87              
88             sub body {
89             my ($self) = @_;
90              
91              
92              
93             if( !exists $self->{'persistent'}->{'pSection'} ) {
94             $self->startpage;
95             }
96              
97             elsif( $self->{'persistent'}->{'pSection'} eq "home" ) {
98             $self->startpage;
99             }
100              
101             elsif( $self->{'persistent'}->{"pSection"} eq "openList" ) {
102             if( $self->{'nl'}->list( list => { name => $self->{'persistent'}->{"pOpenList"} } ) ) {
103             $self->openList;
104             } else {
105             $self->_out( $self->{'nl'}->error(1) );
106             }
107             }
108              
109             elsif( $self->{'persistent'}->{"pSection"} eq "addToList" ) {
110              
111             foreach my $key ( $self->{'cgi'}->param ) {
112             if( $key =~ /newMember\d\d\d\d/ ) {
113              
114             next if( !$self->{'cgi'}->param($key) );
115              
116             if( $self->{'nl'}->list( member => {
117             listname => $self->{'persistent'}->{"pOpenList"},
118             mail => $self->{'cgi'}->param($key),
119             rereadOff => 1
120             } ) ) {
121             $self->_info( $self->{'cgi'}->param($key)." added" );
122             if( $self->{'nl'}->error ) {
123             $self->_info( $self->{'nl'}->error(1) );
124             }
125             } else {
126             $self->_info( $self->{'nl'}->error(1) );
127             }
128             }
129             }
130              
131             if( $self->{'nl'}->list( list => { name => $self->{'persistent'}->{"pOpenList"} } ) ) {
132             $self->openList;
133             } else {
134             $self->_out( $self->{'nl'}->error(1) );
135             }
136              
137             }
138              
139             #ONLY VCM [start]
140             elsif( $self->{'persistent'}->{"pSection"} eq "addToListRemote" ) {
141              
142             foreach my $key ( $self->{'cgi'}->param ) {
143             if( $key =~ /newMember\d\d\d\d/ ) {
144              
145             next if( !$self->{'cgi'}->param($key) );
146              
147             if( $self->{'nl'}->list( member => {
148             listname => $self->{'persistent'}->{"pOpenList"},
149             mail => $self->{'cgi'}->param($key),
150             rereadOff => 1
151             } ) ) {
152             #$self->_info( $self->{'cgi'}->param($key)." added" );
153             #if( $self->{'nl'}->error ) {
154             # $self->_info( $self->{'nl'}->error(1) );
155             #}
156             } else {
157             #$self->_info( $self->{'nl'}->error(1) );
158             }
159             }
160             }
161              
162             #if( $self->{'nl'}->list( list => { name => $self->{'persistent'}->{"pOpenList"} } ) ) {
163             # $self->openList;
164             #} else {
165             # $self->_out( $self->{'nl'}->error(1) );
166             #}
167              
168             }
169             #ONLY VCM [end]
170              
171              
172             elsif( $self->{'persistent'}->{"pSection"} eq "delFromList" ) {
173              
174             foreach my $member ( $self->{'cgi'}->param("openListMembers") ) {
175             if( $self->{'nl'}->list( remove => {
176             listname => $self->{'persistent'}->{"pOpenList"},
177             mail => $member
178             } ) ) {
179             $self->_info( "$member removed" );
180             if( $self->{'nl'}->error ) {
181             $self->_info( $self->{'nl'}->error(1) );
182             }
183             } else {
184             $self->_info( $self->{'nl'}->error(1) );
185             }
186             }
187              
188             if( $self->{'nl'}->list( list => { name => $self->{'persistent'}->{"pOpenList"} } ) ) {
189             $self->openList;
190             } else {
191             $self->_out( $self->{'nl'}->error(1) );
192             }
193              
194             }
195              
196             elsif( $self->{'persistent'}->{"pSection"} eq "deleteList" ) {
197             $self->{'nl'}->list(
198             remove => {
199             # remove whole list
200             listname => $self->{'cgi'}->param('listName')
201             }
202             );
203              
204             $self->{'nl'}->list( reread => 1 );
205             $self->startpage;
206             $self->_out( $self->{'nl'}->error(1) );
207             }
208              
209             elsif( $self->{'persistent'}->{"pSection"} eq "editTmpl" ) {
210            
211             foreach my $is ('tmplFilesHeader', 'tmplFilesFooter') {
212             foreach my $tmpl ( $self->{'cgi'}->param($is) ) {
213             if( $is eq 'tmplFilesHeader') {
214             $self->{'nl'}->template( use => { filename => $tmpl, is => +HEADER } );
215             }
216              
217             if( $is eq 'tmplFilesFooter') {
218             $self->{'nl'}->template( use => { filename => $tmpl, is => +FOOTER } );
219             }
220              
221             if( $self->{'cgi'}->param("tmplFilesAction") eq "open" ) {
222             if( $self->{'nl'}->{'senderHeader'}->{ +HTML_TMPL } ) {
223             $self->openTmpl($self->{'nl'}->{'senderHeader'}->{ +HTML_TMPL }, +HTML_TMPL);
224             }
225             elsif( $self->{'nl'}->{'senderHeader'}->{ +TEXT_TMPL } ) {
226             $self->openTmpl($self->{'nl'}->{'senderHeader'}->{ +TEXT_TMPL }, +TEXT_TMPL );
227             }
228             elsif( $self->{'nl'}->{'senderFooter'}->{ +HTML_TMPL } ) {
229             $self->openTmpl($self->{'nl'}->{'senderFooter'}->{ +HTML_TMPL }, +HTML_TMPL);
230             }
231             elsif( $self->{'nl'}->{'senderFooter'}->{ +TEXT_TMPL } ) {
232             $self->openTmpl($self->{'nl'}->{'senderFooter'}->{ +TEXT_TMPL }, +TEXT_TMPL );
233             }
234              
235             }
236              
237             elsif( $self->{'cgi'}->param("tmplFilesAction") eq "delete" ) {
238             if( $is eq 'tmplFilesHeader') {
239             $self->{'nl'}->template(
240             use => { is => 'header', filename => $tmpl },
241             remove => 1
242             );
243             }
244             elsif( $is eq 'tmplFilesFooter') {
245             $self->{'nl'}->template(
246             use => { is => 'footer', filename => $tmpl },
247             remove => 1
248             );
249             }
250             $self->{'nl'}->template( reread => 1 );
251             }
252              
253              
254             if( $self->{'nl'}->error ) {
255             $self->_info( $self->{'nl'}->error(1) );
256             }
257             }
258             }
259              
260             $self->editTmpl;
261             }
262              
263             elsif( $self->{'persistent'}->{"pSection"} eq "tmplFileUpload") {
264             $self->fileuploadTmpl;
265             }
266            
267             elsif( $self->{'persistent'}->{"pSection"} eq "finishTmplFileUpload" ) {
268              
269             # Upload embedded
270             my @embedded = ();
271             for( my $a = 0; $a < 10; $a++ ) {
272             if( $self->{'cgi'}->param("embFileUpload$a") ) {
273             my $filename = $self->fileUpload("embFileUpload$a");
274             push(@embedded, $self->{'uploadPath'}.'/'.$filename);
275             }
276             }
277              
278            
279             if( $self->{'cgi'}->param("tmplSchema") ) {
280             $self->{'nl'}->template(
281             file => {
282             path => $self->{'uploadPath'}.'/'.$self->{'cgi'}->param("tmplFile"),
283             type => $self->{'persistent'}->{"pTmplFileUploadType"},
284             is => $self->{'persistent'}->{"pTmplFileUploadIs"},
285             schema => $self->{'cgi'}->param("tmplSchema"),
286             embedded => \@embedded
287             }
288             );
289              
290             } else {
291              
292             $self->{'nl'}->template(
293             file => {
294             path => $self->{'uploadPath'}.'/'.$self->{'cgi'}->param("tmplFile"),
295             type => $self->{'persistent'}->{"pTmplFileUploadType"},
296             is => $self->{'persistent'}->{"pTmplFileUploadIs"},
297             embedded => \@embedded
298             }
299             );
300             }
301              
302             $self->{'nl'}->template( reread => 1 );
303              
304             $self->editTmpl;
305             $self->_out( $self->{'nl'}->error );
306             }
307              
308              
309             elsif( $self->{'persistent'}->{"pSection"} eq "sendList" ) {
310             $self->sendList;
311             }
312              
313             elsif( $self->{'persistent'}->{"pSection"} eq "sendListPreview" ) {
314             $self->sendListPreview;
315             }
316              
317             elsif( $self->{'persistent'}->{"pSection"} eq "sendListEdit" ) {
318             $self->sendListPreview;
319             }
320              
321             elsif( $self->{'persistent'}->{"pSection"} eq "sendListEmail" ) {
322             $self->sendListMail;
323             return "";
324             }
325              
326             else {
327             $self->startpage;
328             }
329              
330             return $self->_outString;
331             }
332              
333              
334             sub footer {
335             my ($self) = @_;
336              
337             if( $self->{'info'} ) {
338             $self->_out( "
".$self->{'info'}."
" );
339             }
340              
341             $self->_out( $self->{'cgi'}->hr );
342             $self->_out( $self->{'cgi'}->p( {-align=>'right'}, "HTML Newsletter Simple Version $Newsletter::VERSION") );
343             $self->_out( $self->{'cgi'}->end_html );
344              
345             return $self->_outString;
346             }
347              
348              
349             sub _out ($$) {
350             my ($self, $string) = @_;
351             if( $string ) {
352             $self->{'out'} .= $string;
353             }
354             }
355              
356              
357             sub _outString {
358             my ($self) = @_;
359             my $out = $self->{'out'};
360             $self->{'out'} = '';
361             return $out;
362             }
363              
364              
365             sub _persistent {
366             my ($self) = @_;
367              
368             my @coockies = ();
369              
370              
371             # read in
372             foreach my $key ( $self->{'cgi'}->cookie() ) {
373             if( $self->{'cgi'}->cookie($key) ) {
374             if( $key =~ /^pl/ ) {
375             foreach my $file ( $self->{'cgi'}->cookie($key) ) {
376             push( @{ $self->{'persistent'}->{$key} }, $file );
377             }
378             } else {
379             $self->{'persistent'}->{$key} = decode_base64( $self->{'cgi'}->cookie($key) );
380             }
381             } elsif( $key =~ /^p/ ) {
382             if( $key =~ /^pl/ ) {
383             $self->{'persistent'}->{$key} = [];
384             } else {
385             $self->{'persistent'}->{$key} = '';
386             }
387             }
388             }
389              
390              
391             foreach my $key ( $self->{'cgi'}->param ) {
392             if( $key =~ /^p/) {
393              
394             if( $key =~ /^pl/ ) {
395             push(@coockies,
396             $self->{'cgi'}->cookie(
397             -name => $key,
398             -value => [ $self->{'cgi'}->param($key) ]
399             )
400             );
401              
402             if( exists $self->{'persistent'}->{$key} ) {
403             $self->{'persistent'}->{$key} = [];
404             }
405              
406             foreach my $file ( $self->{'cgi'}->param($key) ) {
407             push( @{ $self->{'persistent'}->{$key} }, $file );
408             }
409              
410             } elsif( $key =~ /^p/ ) {
411              
412             push(@coockies,
413             $self->{'cgi'}->cookie(
414             -name => $key,
415             -value => encode_base64( $self->{'cgi'}->param($key) )
416             )
417             );
418             $self->{'persistent'}->{$key} = $self->{'cgi'}->param($key);
419             }
420             }
421             }
422              
423              
424             return @coockies;
425             }
426              
427              
428             sub _persistentClean {
429             my ($self) = @_;
430            
431             my @coockies = ();
432              
433             # read in
434             foreach my $key ( $self->{'cgi'}->cookie() ) {
435             if( $key =~ /^p/) {
436             push(@coockies,
437             $self->{'cgi'}->cookie(
438             -name => $key,
439             -value => ''
440             )
441             );
442              
443             if( exists $self->{'persistent'}->{$key} ) {
444             delete $self->{'persistent'}->{$key};
445             }
446             }
447             }
448              
449             return @coockies;
450             }
451              
452              
453             sub _info {
454             my ($self,$msg) = @_;
455             $self->{'info'} .= "$msg\n";
456             }
457              
458              
459              
460              
461             =head1 NAME
462              
463             Newsletter::Html - generate html!
464              
465             =head1 VERSION
466              
467             Version 0.02
468              
469             =cut
470              
471             #our $VERSION = '0.01';
472              
473             =head1 SYNOPSIS
474              
475             The Html module for Newsletter
476              
477             Perhaps a little code snippet.
478              
479             use Newsletter::Html;
480              
481             my $foo = Newsletter::Html->new( $newsletterObj, $uploadPath );
482             ...
483              
484             =head1 EXPORT
485              
486             A list of functions that can be exported. You can delete this section
487             if you don't export anything, such as for a purely object-oriented module.
488              
489             =head1 FUNCTIONS
490              
491             =head1 AUTHOR
492              
493             Dominik Hochreiter, C<< >>
494              
495             =head1 BUGS
496              
497             Please report any bugs or feature requests to
498             C, or through the web interface at
499             L.
500             I will be notified, and then you'll automatically be notified of progress on
501             your bug as I make changes.
502              
503             =head1 SUPPORT
504              
505             You can find documentation for this module with the perldoc command.
506              
507             perldoc Newsletter
508              
509             You can also look for information at:
510              
511             =over 4
512              
513             =item * AnnoCPAN: Annotated CPAN documentation
514              
515             L
516              
517             =item * CPAN Ratings
518              
519             L
520              
521             =item * RT: CPAN's request tracker
522              
523             L
524              
525             =item * Search CPAN
526              
527             L
528              
529             =back
530              
531             =head1 ACKNOWLEDGEMENTS
532              
533             =head1 COPYRIGHT & LICENSE
534              
535             Copyright 2006 Dominik Hochreiter, all rights reserved.
536              
537             This program is free software; you can redistribute it and/or modify it
538             under the same terms as Perl itself.
539              
540             =cut
541              
542             1; # End of Newsletter::Html