File Coverage

blib/lib/Newsletter.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;
2              
3 1     1   20609 use warnings;
  1         2  
  1         25  
4              
5 1     1   5 use Carp ();
  1         1  
  1         12  
6 1     1   358 use MIME::Lite;
  0            
  0            
7             use MIME::Explode;
8             use File::Path;
9             use File::Type;
10             use Time::HiRes;
11              
12             use POSIX qw(strftime);
13             use strict;
14             use Exporter;
15              
16             use vars qw($VERSION @ISA @EXPORT $ERR);
17             use subs qw(warn die);#die
18              
19             our $VERSION = '0.033';
20              
21             @ISA = qw(Exporter);
22             @EXPORT = qw(
23             HEADER
24             FOOTER
25             HTML_TMPL
26             TEXT_TMPL
27             );
28              
29              
30             use constant HEADER => 'HEADER';
31             use constant FOOTER => 'FOOTER';
32             use constant HTML_TMPL => 'HTML';
33             use constant TEXT_TMPL => 'TEXT';
34             use constant HTML_EMB => 'EMBEDDED';
35             use constant SUFFIX_TMPL => '.tmpl';
36              
37              
38             sub warn {
39             $ERR = $_[0];
40             }
41              
42             sub die {
43             $ERR = "FATAL:$_[0]";
44             }
45              
46              
47             sub new {
48             my $obj = shift;
49             my $self = {};
50              
51             $self->{'sender'} = undef;
52             $self->{'senderType'} = 'multipart/mixed';
53             $self->{'senderSubject'} = 'none';
54             $self->{'senderFrom'} = 'newsletter@simple.newsletter';
55             $self->{'replayTo'} = $self->{'senderFrom'};
56             $self->{'senderHeader'} = {};
57             $self->{'senderFooter'} = {};
58             $self->{'senderAddressList'} = {};
59              
60             $self->{'templatePath'} = undef;
61             $self->{'tmplHeaderHtmlFiles'} = [];
62             $self->{'tmplFooterHtmlFiles'} = [];
63             $self->{'tmplHeaderTextFiles'} = [];
64             $self->{'tmplFooterTextFiles'} = [];
65             $self->{'tmplList'} = [];
66              
67             $self->{'listPath'} = undef;
68             $self->{'listNames'} = [];
69             $self->{'listMembers'} = {};
70             $self->{'listCurrent'} = undef;
71              
72             $self->{'bodyPath'} = undef;
73             $self->{'buildMail'} = 0;
74            
75             $self->{'archivPath'} = undef;
76             $self->{'previewPath'} = undef;
77            
78             $self->{'smtpServer'} = undef;
79              
80             bless($self,$obj);
81             $self->sender( type => $self->{'senderType'} );
82              
83             return($self);
84             }
85              
86              
87             sub error {
88             my ($self,$clean) = @_;
89            
90             if($clean) {
91             my $tmp = $ERR;
92             $ERR = undef;
93             return $tmp;
94             }
95            
96             return $ERR;
97             }
98              
99              
100             sub sender {
101             my ($self, %para) = @_;
102            
103             if( exists $para{'type'} ) {
104            
105             my $type = $para{'type'};
106              
107             if( $type =~/text/i ||
108             $type =~/html/i ||
109             $type =~/multipart\/mixed/i ||
110             $type =~/multipart\/related/i
111             ) {
112              
113             $self->{'senderType'} = lc $type;
114             if( $type ne "text" ) {
115             $self->{'sender'} = MIME::Lite->new(
116             Type => $type
117             );
118             }
119            
120             } else {
121             die "Sender Type [$type] is not valid!\n";
122             }
123             }
124              
125             if( exists $para{'smtp'} ) {
126             #MIME::Lite->send( 'smtp', $para{'smtp'} );#Timeout => 60
127             $self->{'smtpServer'} = $para{'smtp'};
128             }
129              
130             if( exists $para{'replayTo'} ) {
131             $self->{'replayTo'} = $para{'replayTo'};
132             }
133              
134             if( $self->{'sender'} ) {
135             return $self->{'sender'};
136             }
137             }
138              
139              
140             sub addAddress {
141             my ($self, %para) = @_;
142              
143             if( exists $para{'addressType'} ) {
144             if( $para{'addressType'} eq 'Cc' ||
145             $para{'addressType'} eq 'Bcc' ||
146             $para{'addressType'} eq 'To'
147             ) {
148             # OK
149             } else {
150             die "addAddress: addressType unknown\n";
151             }
152             } else {
153             die "addAddress: addressType is missing\n";
154             }
155              
156             if( exists $para{'addressList'} ) {
157             foreach my $addr ( @{ $para{'addressList'} } ) {
158             $self->_lowAddAddress( $addr, $para{'addressType'});
159             }
160             }
161              
162             if( exists $para{'address'} ) {
163             $self->_lowAddAddress( $para{'address'}, $para{'addressType'} );
164             }
165              
166             if( exists $para{'empty'} ) {
167             $self->{'senderAddressList'}->{ $para{'addressType'} } = [];
168             }
169             }
170              
171              
172             sub send {
173             my ( $self, $output, $block ) = @_;
174            
175             my $saveSender = $self->{'sender'};
176              
177             #return 0 if ! $self->_lowPrepairSend();
178             if( $self->{'buildMail'} == 0) {
179             return 0 if ! $self->_lowPrepairSend();
180             }
181            
182              
183             $self->{'sender'}->add( From => $self->{'senderFrom'} );
184             $self->{'sender'}->add( 'To' => $self->{'senderFrom'} );
185             $self->{'sender'}->add( 'Reply-To' => $self->{'replayTo'} );
186              
187             # output buffering off
188             $| = 1;
189              
190             # for(my $a= 0; $a < 12000; $a++) {
191             # push(@{ $self->{'senderAddressList'}->{ 'Bcc' } }, "nobody\@soft.uni-linz.ac.A$a.at" );
192             # }
193              
194             foreach my $adrType ( 'To', 'Cc', 'Bcc' ) {
195             # foreach my $adr ( @{ $self->{'senderAddressList'}->{ $adrType } } ) {
196             # $self->{'sender'}->add( $adrType => $adr );
197             # #$self->{'sender'}->add( 'Bcc' => $adr );
198             # print "$adrType => $adr\n" if( $output );
199             # #$self->{'sender'}->send;
200             # #$self->{'sender'}->delete( $adrType );
201             # #Time::HiRes::usleep(1);
202             # }
203              
204             if( defined $self->{'senderAddressList'}->{ $adrType } ) {
205            
206             if( $block ) {
207             my $lengthToSend = @{ $self->{'senderAddressList'}->{ $adrType } };
208             my $pos = 0;
209             my $blockPos = 0;
210             my $toListStr = '';
211             while( $pos < $lengthToSend ) {
212             if( $blockPos < $block ) {
213             $toListStr .= $self->{'senderAddressList'}->{ $adrType }->[$pos].";";
214             print "$adrType => $self->{'senderAddressList'}->{ $adrType }->[$pos]\n";
215             $blockPos++;
216             $pos++;
217             } else {
218             $self->{'sender'}->add( $adrType => $toListStr);
219             $self->{'sender'}->send;
220             print "send\n";
221             $toListStr = '';
222             $blockPos = 0;
223             $self->{'sender'}->delete( $adrType );
224             }
225             }
226              
227             } else {
228              
229             $self->{'sender'}->add( $adrType => join(";", @{ $self->{'senderAddressList'}->{ $adrType } } ) );
230              
231             if( $output ) {
232             foreach my $adr ( @{ $self->{'senderAddressList'}->{ $adrType } } ) {
233             print "$adrType => $adr\n";
234             }
235             }
236             }
237             }
238             }
239              
240             if( !$block ) {
241              
242             if( defined $self->{'smtpServer'} ) {
243             $self->_lowSend( $self->{'smtpServer'}, Timeout => 3600 );
244             } else {
245             $self->{'sender'}->send;
246             }
247             }
248              
249              
250             # reset
251             $self->{'sender'} = $saveSender;
252             $self->{'buildMail'} = 0;
253             $| = 0;
254             }
255              
256              
257             sub buildMail {
258             my ($self) = @_;
259             return 0 if ! $self->_lowPrepairSend();
260             $self->{'buildMail'} = 1;
261             return $self->{'sender'};
262             }
263              
264              
265             sub previewMail {
266             my ($self) = @_;
267             my $saveSender = $self->{'sender'};
268              
269             return undef if ! $self->_lowPrepairSend();
270              
271             my $returnSender = $self->{'sender'};
272             $self->{'sender'} = $saveSender;
273              
274             return $returnSender;
275             }
276              
277              
278             sub previewMailFile {
279             my ($self, %para) = @_;
280              
281             if( exists $para{'path'} ) {
282             if( -d $para{'path'} ) {
283             $self->{'previewPath'} = $para{'path'};
284             } else {
285             $self->{'previewPath'} = $para{'path'};
286             mkpath( $para{'path'} );
287             }
288             }
289              
290             if( exists $para{'getpath'} ) {
291             return $self->{'previewPath'};
292             }
293              
294              
295             if( exists $para{'preview'} ) {
296             if( -e $self->{'previewPath'}."/preview.eml" ) {
297             unlink( $self->{'previewPath'}."/preview.eml" );
298             }
299              
300             my $saveSender = $self->{'sender'};
301              
302             return 0 if ! $self->_lowPrepairSend();
303              
304             #warn "type here:".$self->{'sender'}->as_string;
305              
306             open( FILE, ">".$self->{'previewPath'}."/preview.eml" ) or die "Could not open preview file:$!\n";
307             $self->{'sender'}->print(\*FILE);
308             close(FILE);
309            
310             #$self->previewMailFileExplode( $self->{'previewPath'}."/preview.eml" );
311              
312             $self->{'sender'} = $saveSender;
313              
314             return $self->{'previewPath'}."/preview.eml";
315             }
316             }
317              
318              
319             sub previewMailFileExplode ($$) {
320             my ($self, $path) = @_;
321              
322             my $mail = $path;
323             my $decode_subject = 1;
324             my $tmp_dir = $self->{'previewPath'}."/explode";
325             my $output = $self->{'previewPath'}."/file.tmp";
326              
327             # clean first
328             rmtree $tmp_dir;
329              
330             my $explode = MIME::Explode->new(
331             output_dir => $tmp_dir,
332             mkdir => 0755,
333             decode_subject => $decode_subject,
334             check_content_type => 1,
335             );
336              
337             open(MAIL, "<$mail") or die("Couldn't open $mail for reading: $!\n");
338             open(OUTPUT, ">$output") or die("Couldn't open $output for writing: $!\n");
339             my $headers = $explode->parse(\*MAIL, \*OUTPUT);
340             close(OUTPUT);
341             close(MAIL);
342              
343             return $headers;
344             }
345              
346              
347             sub body {
348             my ($self, %para) = @_;
349              
350             # path is tmp
351             if( exists $para{'path'} ) {
352             if( -d $para{'path'} ) {
353             $self->{'bodyPath'} = $para{'path'};
354             mkpath( $self->{'bodyPath'}.'/'.TEXT_TMPL ) if ! -d $self->{'bodyPath'}.'/'.TEXT_TMPL;
355             mkpath( $self->{'bodyPath'}.'/'.HTML_TMPL ) if ! -d $self->{'bodyPath'}.'/'.HTML_TMPL;
356             mkpath( $self->{'bodyPath'}.'/'.HTML_EMB ) if ! -d $self->{'bodyPath'}.'/'.HTML_EMB;
357             } else {
358             warn "Body: Path [$para{'path'}] does not exists. Try to create\n";
359             $self->{'bodyPath'} = $para{'path'};
360             mkpath( $para{'path'} );
361             mkpath( $self->{'bodyPath'}.'/'.TEXT_TMPL );
362             mkpath( $self->{'bodyPath'}.'/'.HTML_TMPL );
363             mkpath( $self->{'bodyPath'}.'/'.HTML_EMB );
364             }
365             }
366              
367             if( exists $para{'file'} ) {
368             if( exists $para{'file'}->{'path'} &&
369             exists $para{'file'}->{'type'}
370             ) {
371             if( $para{'file'}->{'type'} =~ /^text$/i ) {
372             $self->_lowEmptyDir( $self->{'bodyPath'}.'/'.TEXT_TMPL );
373             $self->_lowCopy( $para{'file'}->{'path'}, $self->{'bodyPath'}.'/'.TEXT_TMPL);
374             }
375             elsif( $para{'file'}->{'type'} =~ /^html$/i ) {
376             $self->_lowEmptyDir( $self->{'bodyPath'}.'/'.HTML_TMPL );
377             $self->_lowCopy( $para{'file'}->{'path'}, $self->{'bodyPath'}.'/'.HTML_TMPL);
378              
379             if ( exists $para{'file'}->{'embedded'} ) {
380             $self->_lowBodyEmbedded( $para{'file'}->{'embedded'} );
381             }
382             } else {
383             die "Body: [type] value is invalid\n";
384             }
385              
386             }
387             }
388              
389             if( exists $para{'data'} ) {
390             if( exists $para{'data'}->{'type'} &&
391             exists $para{'data'}->{'value'}
392             ) {
393             if( $para{'data'}->{'type'} =~ /^text$/i ) {
394             $self->_lowEmptyDir( $self->{'bodyPath'}.'/'.TEXT_TMPL );
395             $self->_lowWrite( $para{'data'}->{'value'}, $self->{'bodyPath'}.'/'.TEXT_TMPL.'/new.txt');
396             }
397             elsif( $para{'data'}->{'type'} =~ /^html$/i ) {
398             $self->_lowEmptyDir( $self->{'bodyPath'}.'/'.HTML_TMPL );
399             $self->_lowWrite( $para{'data'}->{'value'}, $self->{'bodyPath'}.'/'.HTML_TMPL.'/new.html');
400              
401             if ( exists $para{'data'}->{'embedded'} ) {
402             $self->_lowBodyEmbedded( $para{'data'}->{'embedded'} );
403             }
404             } else {
405             die "Body: [type] value is invalid\n";
406             }
407              
408             }
409             }
410              
411             if( exists $para{'subject'} ) {
412             $self->_lowWrite( $para{'subject'}, $self->{'bodyPath'}.'/subject.txt');
413             }
414             }
415              
416              
417             sub template {
418             my ($self, %para) = @_;
419              
420             if( exists $para{'path'} ) {
421             if( -d $para{'path'} ) {
422             $self->{'templatePath'} = $para{'path'};
423             $self->_lowReadTemplates();
424             } else {
425             warn "template: Path [$para{'path'}] does not exists. Try to create\n";
426             mkpath( $para{'path'} );
427             $self->_lowReadTemplates();
428             }
429             }
430              
431             if( exists $para{'file'} ) {
432             if( exists $para{'file'}->{'path'} &&
433             exists $para{'file'}->{'type'} &&
434             exists $para{'file'}->{'is'}
435             ) {
436              
437             my $path = '';
438              
439             if( $para{'file'}->{'type'} =~ /^text$/i ) {
440             if( $para{'file'}->{'is'} =~/^header$/i) {
441             $self->_lowCopy( $para{'file'}->{'path'}, $self->{'templatePath'}.'/'.TEXT_TMPL.'/'.HEADER);
442             $path = $self->{'templatePath'}.'/'.TEXT_TMPL.'/'.HEADER;
443             }
444             elsif( $para{'file'}->{'is'} =~/^footer$/i) {
445             $self->_lowCopy( $para{'file'}->{'path'}, $self->{'templatePath'}.'/'.TEXT_TMPL.'/'.FOOTER);
446             $path = $self->{'templatePath'}.'/'.TEXT_TMPL.'/'.FOOTER;
447             } else {
448             die "template: [is] value is invalid\n";
449             }
450             } elsif ( $para{'file'}->{'type'} =~ /^html$/i ) {
451             if( $para{'file'}->{'is'} =~/^header$/i) {
452             $self->_lowCopy( $para{'file'}->{'path'}, $self->{'templatePath'}.'/'.HTML_TMPL.'/'.HEADER);
453             $path = $self->{'templatePath'}.'/'.HTML_TMPL.'/'.HEADER;
454             }
455             elsif( $para{'file'}->{'is'} =~/^footer$/i) {
456             $self->_lowCopy( $para{'file'}->{'path'}, $self->{'templatePath'}.'/'.HTML_TMPL.'/'.FOOTER);
457             $path = $self->{'templatePath'}.'/'.HTML_TMPL.'/'.FOOTER;
458             } else {
459             die "template: [is] value is invalid\n";
460             }
461              
462             if ( exists $para{'file'}->{'embedded'} ) {
463              
464             $para{'file'}->{'path'} =~ /\/*([\w\d _\-\.]+)$/;
465             my $fileName = $1;
466              
467             my $embPath = $self->{'templatePath'}.'/'.HTML_TMPL.'/'.HTML_EMB.'/'.
468             uc $para{'file'}->{'is'}.'/'.$fileName; #.'/'.$para{'file'}->{'path'};
469              
470             mkpath( $embPath ) if( ! -d $embPath );
471              
472             if( ref $para{'file'}->{'embedded'} eq "ARRAY" ) {
473             my $embStr = '';
474             foreach my $emb ( @{ $para{'file'}->{'embedded'} } ) {
475             $self->_lowCopy( $emb, $embPath );
476             $emb =~ /\/*([\w\d _\-\.]+)$/;
477             $embStr .= "$1,";
478             }
479             $para{'file'}->{'embedded'} = $embStr;
480             } else {
481             $self->_lowCopy( $para{'file'}->{'embedded'}, $embPath );
482             $para{'file'}->{'embedded'} =~ /\/*([\w\d _\-\.]+)$/;
483             $para{'file'}->{'embedded'} = "$1,";
484             }
485             }
486              
487             } else {
488             die "template: [type] value is invalid\n";
489             }
490              
491             $para{'file'}->{'path'} =~ /\/*([\w\d _\-\.]+)$/;
492             my $fileName = $1;
493             $para{'file'}->{'fileName'} = $fileName;
494             my $fileNameTmpl = $fileName.SUFFIX_TMPL;
495            
496             if( $fileName ) {
497             $self->_lowWriteFile( $path.'/'.$fileNameTmpl, $para{'file'} );
498              
499             if( $para{'file'}->{'is'} =~/^header$/i ) {
500             $self->{'senderHeader'}->{ uc $para{'file'}->{'type'} } = $path.'/'.$fileName;
501             }
502              
503             if( $para{'file'}->{'is'} =~/^footer$/i ) {
504             $self->{'senderFooter'}->{ uc $para{'file'}->{'type'} } = $path.'/'.$fileName;
505             }
506              
507             } else {
508             die "template: Invalid File name!";
509             }
510              
511             } else {
512             die "template: File a main parameter is missing (path,type,is)!\n";
513             }
514             }
515              
516             if( exists $para{'use'} ) {
517             # use saved tmpl (Header/Footer) by name or File Name or Schema!
518             if( exists $para{'use'}->{'schema'} ) {
519            
520             my $tmpHeader = $self->{'senderHeader'};
521             my $tmpFooter = $self->{'senderFooter'};
522             $self->{'senderHeader'} = {};
523             $self->{'senderFooter'} = {};
524              
525             foreach my $listRef (
526             { list => $self->{'tmplHeaderHtmlFiles'}, is => HEADER, type => HTML_TMPL },
527             { list => $self->{'tmplFooterHtmlFiles'}, is => FOOTER, type => HTML_TMPL },
528             { list => $self->{'tmplHeaderTextFiles'}, is => HEADER, type => TEXT_TMPL },
529             { list => $self->{'tmplFooterTextFiles'}, is => FOOTER, type => TEXT_TMPL }
530             ) {
531             #next if ! $listRef->{'list'};
532             foreach my $file ( @{ $listRef->{'list'} } ) {
533             my $path = $self->{'templatePath'}.'/'.$listRef->{'type'}.'/'.$listRef->{'is'}.'/'.$file;
534             my $tupels = $self->_lowReadFile( $path.SUFFIX_TMPL );
535              
536             if( exists $tupels->{'schema'} ) {
537             if( $para{'use'}->{'schema'} eq $tupels->{'schema'} ) {
538             if( $listRef->{'is'} eq HEADER ) {
539             if( $self->{'senderHeader'}->{ $listRef->{'type'} } ) {
540             warn "The Header for this schema exists more then one time\n";
541             } else {
542             $self->{'senderHeader'}->{ $listRef->{'type'} } = $path;
543             }
544             } elsif( $listRef->{'is'} eq FOOTER ) {
545             if( $self->{'senderFooter'}->{ $listRef->{'type'} } ) {
546             warn "The Footer for this schema exists more then one time\n";
547             } else {
548             $self->{'senderFooter'}->{ $listRef->{'type'} } = $path;
549             }
550              
551             } else {
552             die "FATAL: This should never happen!\n";
553             }
554             }
555             }
556             }
557             }
558            
559             if( !$self->{'senderHeader'}->{ +HTML_TMPL } ) {
560             $self->{'senderHeader'}->{ +HTML_TMPL } = $tmpHeader->{ +HTML_TMPL };
561             }
562             if( !$self->{'senderHeader'}->{ +TEXT_TMPL } ) {
563             $self->{'senderHeader'}->{ +TEXT_TMPL } = $tmpHeader->{ +TEXT_TMPL };
564             }
565              
566              
567             if( !$self->{'senderFooter'}->{ +HTML_TMPL } ) {
568             $self->{'senderFooter'}->{ +HTML_TMPL } = $tmpFooter->{ +HTML_TMPL };
569             }
570             if( !$self->{'senderFooter'}->{ +TEXT_TMPL } ) {
571             $self->{'senderFooter'}->{ +TEXT_TMPL } = $tmpFooter->{ +TEXT_TMPL };
572             }
573              
574              
575              
576             } elsif ( exists $para{'use'}->{'is'} && ( exists $para{'use'}->{'name'} || $para{'use'}->{'filename'} ) ) {
577             foreach my $listRef (
578             { list => $self->{'tmplHeaderHtmlFiles'}, is => HEADER, type => HTML_TMPL },
579             { list => $self->{'tmplFooterHtmlFiles'}, is => FOOTER, type => HTML_TMPL },
580             { list => $self->{'tmplHeaderTextFiles'}, is => HEADER, type => TEXT_TMPL },
581             { list => $self->{'tmplFooterTextFiles'}, is => FOOTER, type => TEXT_TMPL }
582             ) {
583              
584             next if( $listRef->{'is'} !~ /$para{'use'}->{'is'}/i);
585              
586             if( exists $para{'use'}->{'name'} ) {
587             foreach my $file ( @{ $listRef->{'list'} } ) {
588             my $path = $self->{'templatePath'}.'/'.$listRef->{'type'}.'/'.$listRef->{'is'}.'/'.$file;
589             my $tupels = $self->_lowReadFile( $path.SUFFIX_TMPL );
590             if( exists $tupels->{'name'} ) {
591             if( $para{'use'}->{'name'} eq $tupels->{'name'} ) {
592             if( $listRef->{'is'} eq HEADER ) {
593             $self->{'senderHeader'}->{ $listRef->{'type'} } = $path;
594             } elsif( $listRef->{'is'} eq FOOTER ) {
595             $self->{'senderFooter'}->{ $listRef->{'type'} } = $path;
596             } else {
597             die "FATAL: This should never happen!\n";
598             }
599             }
600             }
601             }
602             }
603             if( exists $para{'use'}->{'filename'} ) {
604             foreach my $file ( @{ $listRef->{'list'} } ) {
605             my $path = $self->{'templatePath'}.'/'.$listRef->{'type'}.'/'.$listRef->{'is'}.'/'.$file;
606             if( $para{'use'}->{'filename'} eq $file ) {
607             if( $listRef->{'is'} eq HEADER ) {
608             $self->{'senderHeader'}->{ $listRef->{'type'} } = $path;
609             } elsif( $listRef->{'is'} eq FOOTER ) {
610             $self->{'senderFooter'}->{ $listRef->{'type'} } = $path;
611             } else {
612             die "FATAL: This should never happen!\n";
613             }
614             }
615             }
616             }
617             }
618             } else {
619             die "template: use a parameter is missing!\n";
620             }
621            
622             }
623              
624             if( exists $para{'get'} ) {
625              
626             # clean List, reread ...
627             $self->{'tmplList'} = [];
628              
629              
630             foreach my $listRef (
631             { list => $self->{'tmplHeaderHtmlFiles'}, is => HEADER, type => HTML_TMPL },
632             { list => $self->{'tmplFooterHtmlFiles'}, is => FOOTER, type => HTML_TMPL },
633             { list => $self->{'tmplHeaderTextFiles'}, is => HEADER, type => TEXT_TMPL },
634             { list => $self->{'tmplFooterTextFiles'}, is => FOOTER, type => TEXT_TMPL }
635             ) {
636              
637              
638             if( exists $para{'get'}->{'is'} ) {
639             next if( $para{'get'}->{'is'} ne $listRef->{'is'} );
640             }
641              
642             if( exists $para{'get'}->{'type'} ) {
643             next if( $para{'get'}->{'type'} ne $listRef->{'type'} );
644             }
645              
646             foreach my $file ( @{ $listRef->{'list'} } ) {
647             my $path = $self->{'templatePath'}.'/'.$listRef->{'type'}.'/'.$listRef->{'is'}.'/'.$file;
648             my $tupels = $self->_lowReadFile( $path.SUFFIX_TMPL );
649            
650             if( exists $para{'get'}->{'schema'} ) {
651             if( exists $tupels->{'schema'} ) {
652             if( $para{'get'}->{'schema'} ne "*" ) {
653             next if( $para{'get'}->{'schema'} ne $tupels->{'schema'} );
654             }
655             } else {
656             if( $para{'get'}->{'schema'} ne "*" ) {
657             next;
658             }
659             }
660             }
661              
662              
663             my $filename = $file;
664             my $name = 'undef';
665             my $schema = 'undef';
666              
667             if( exists $tupels->{'name'} ) {
668             $name = $tupels->{'name'};
669             }
670              
671             if( exists $tupels->{'schema'} ) {
672             $schema = $tupels->{'schema'};
673             }
674              
675             push( @{ $self->{'tmplList'} },
676             { filename => $filename, name => $name, schema => $schema, is => $listRef->{'is'}, type => $listRef->{'type'} }
677             );
678             }
679             }
680              
681              
682             return @{ $self->{'tmplList'} };
683             }
684              
685             if( exists $para{'remove'} ) {
686             if( exists $para{'use'} ) {
687             my $rm = 0;
688              
689              
690             if( $self->{'senderHeader'}->{ +HTML_TMPL } ) {
691             if( $self->_lowRemoveFile( $self->{'senderHeader'}->{ +HTML_TMPL } ) &&
692             $self->_lowRemoveFile( $self->{'senderHeader'}->{ +HTML_TMPL }.SUFFIX_TMPL ) ) {
693             $rm++;
694             $self->{'senderHeader'}->{ +HTML_TMPL } = undef;
695              
696             if( exists $para{'use'}->{'filename'} ) {
697             my $embPath = $self->{'templatePath'}.'/'.HTML_TMPL.'/'.HTML_EMB.'/'.
698             HEADER.'/'.$para{'use'}->{'filename'};
699             #HEADER.'/'.$para{'file'}->{'path'};
700             if( -d $embPath ) {
701             if( !rmtree( $embPath ) ) {
702             warn "$embPath:$!\n";
703             }
704             }
705             }
706             }
707             }
708             if( $self->{'senderHeader'}->{ +TEXT_TMPL } ) {
709             if( $self->_lowRemoveFile( $self->{'senderHeader'}->{ +TEXT_TMPL } ) &&
710             $self->_lowRemoveFile( $self->{'senderHeader'}->{ +TEXT_TMPL }.SUFFIX_TMPL ) ) {
711             $rm++;
712             $self->{'senderHeader'}->{ +TEXT_TMPL } = undef;
713             }
714             }
715              
716            
717              
718             if( $self->{'senderFooter'}->{ +HTML_TMPL } ) {
719             if( $self->_lowRemoveFile( $self->{'senderFooter'}->{ +HTML_TMPL } ) &&
720             $self->_lowRemoveFile( $self->{'senderFooter'}->{ +HTML_TMPL }.SUFFIX_TMPL ) ) {
721             $rm++;
722             $self->{'senderFooter'}->{ +HTML_TMPL } = undef;
723             if( exists $para{'use'}->{'filename'} ) {
724             my $embPath = $self->{'templatePath'}.'/'.HTML_TMPL.'/'.HTML_EMB.'/'.
725             FOOTER.'/'.$para{'use'}->{'filename'};
726             #FOOTER.'/'.$para{'file'}->{'path'};
727             if( -d $embPath ) {
728             if( !rmtree( $embPath ) ) {
729             warn "$embPath:$!\n";
730             }
731             }
732             }
733             }
734             }
735             if( $self->{'senderFooter'}->{ +TEXT_TMPL } ) {
736             if( $self->_lowRemoveFile( $self->{'senderFooter'}->{ +TEXT_TMPL } ) &&
737             $self->_lowRemoveFile( $self->{'senderFooter'}->{ +TEXT_TMPL }.SUFFIX_TMPL ) ) {
738             $rm++;
739             $self->{'senderFooter'}->{ +TEXT_TMPL } = undef;
740             }
741             }
742              
743             return $rm;
744             } else {
745             die "template: We need 'use' for 'remove'\n";
746             }
747             }
748              
749             if( exists $para{'reread'} ) {
750             $self->{'tmplHeaderHtmlFiles'} = [];
751             $self->{'tmplHeaderTextFiles'} = [];
752             $self->{'tmplFooterHtmlFiles'} = [];
753             $self->{'tmplFooterTextFiles'} = [];
754             $self->_lowReadTemplates();
755             }
756             }
757              
758              
759             sub list {
760             my ($self, %para) = @_;
761              
762             if( exists $para{'path'} ) {
763             if( -d $para{'path'} ) {
764             $self->{'listPath'} = $para{'path'};
765             $self->_lowReadLists();
766             } else {
767             warn "List: Path [$para{'path'}] does not exists. Try to create\n";
768             if( mkpath( $para{'path'} ) ) {
769             $self->{'listPath'} = $para{'path'};
770             } else {
771             warn "Failed!\n";
772             }
773             }
774             }
775              
776             if( exists $para{'list'} ) {
777             if( exists $para{'list'}->{'name'} ) {
778              
779             if(! $self->_lowValidListName( $para{'list'}->{'name'} ) ) {
780             warn "Not a valid list name\n";
781             return 0;
782             }
783              
784             if( -d $self->{'listPath'}.'/'.$para{'list'}->{'name'} ) {
785             $self->_lowReadListMembers( $para{'list'}->{'name'} );
786             $self->{'listCurrent'} = $para{'list'}->{'name'};
787             } else {
788             mkpath( $self->{'listPath'}.'/'.$para{'list'}->{'name'} );
789             $self->_lowReadLists();
790             }
791             }
792             }
793              
794             if( exists $para{'member'} ) {
795             if( exists $para{'member'}->{'listname'} &&
796             exists $para{'member'}->{'mail'}
797             ) {
798             if( -d $self->{'listPath'}.'/'.$para{'member'}->{'listname'} ) {
799             if( $self->_lowValidMailAddress( $para{'member'}->{'mail'} ) ) {
800             $self->_lowWriteFile( $self->{'listPath'}.'/'.$para{'member'}->{'listname'}.'/'.$para{'member'}->{'mail'}, $para{'member'} );
801             if( !exists $para{'member'}->{'rereadOff'} ) {
802             $self->_lowReadListMembers( $para{'member'}->{'listname'} );
803             }
804             $self->{'listCurrent'} = $para{'member'}->{'listname'};
805             } else {
806             warn "Not a valid Mail Address [$para{'member'}->{'mail'}]\n";
807             }
808             } else {
809             warn "You want add a member to a list [$para{'member'}->{'listname'}] which does not exists\n";
810             return 0;
811             }
812             }
813             }
814              
815             if( exists $para{'remove'} ) {
816             # list = value : remove whole list
817             # member = value && list = value : remove member from list
818             if( exists $para{'remove'}->{'listname'} &&
819             ! exists $para{'remove'}->{'mail'}
820             ) {
821             if( defined $para{'remove'}->{'listname'} ) {
822             if( -d $self->{'listPath'}.'/'.$para{'remove'}->{'listname'} ) {
823             if(! rmtree( $self->{'listPath'}.'/'.$para{'remove'}->{'listname'} ) ) {
824             warn "Could not remove list [$para{'remove'}->{'listname'}]\n";
825             }
826             } else {
827             warn "The list [$para{'remove'}->{'listname'}] you tried to remove does not exists\n";
828             }
829             } else {
830             warn "The listname to remove was empty!\n";
831             }
832             }
833             if( exists $para{'remove'}->{'listname'} &&
834             exists $para{'remove'}->{'mail'}
835             ) {
836             if( -e $self->{'listPath'}.'/'.$para{'remove'}->{'listname'}.'/'.$para{'remove'}->{'mail'} ) {
837             if(! unlink( $self->{'listPath'}.'/'.$para{'remove'}->{'listname'}.'/'.$para{'remove'}->{'mail'} ) ) {
838             warn "Could not remove [$para{'remove'}->{'mail'}]\n";
839             }
840             } else {
841             warn "The selected mail adr [$para{'remove'}->{'mail'}] does not exists\n";
842             }
843             $self->_lowReadListMembers( $para{'remove'}->{'listname'} );
844             }
845             }
846              
847             if( exists $para{'empty'} ) {
848             $self->_lowUnloadListMember('all');
849             }
850              
851             if( exists $para{'get'} ) {
852             if( $para{'get'} eq "listnames") {
853             return @{ $self->{'listNames'} };
854             } else {
855             if( exists $self->{'listMembers'}->{ $para{'get'} } ) {
856             return @{ $self->{'listMembers'}->{ $para{'get'} } };
857             } else {
858             warn "This [$para{'get'}] list does not exist\n";
859             return 0;
860             }
861             }
862             }
863              
864             if( exists $para{'count'} ) {
865             $para{'count'} =~ s/@/\\@/g;
866             my $str = qx "ls $self->{'listPath'}/$para{'count'} | wc -l 2>&1";
867             $str =~ s/[^\d]//g;
868             return $str;
869             }
870            
871              
872             if( exists $para{'reread'} ) {
873             $self->{'listNames'} = [];
874             $self->_lowReadLists();
875             }
876              
877             return 1;
878             }
879              
880              
881             sub archiv {
882             my ($self, %para) = @_;
883            
884             if( exists $para{'path'} ) {
885             if( -d $para{'path'} ) {
886             $self->{'archivPath'} = $para{'path'};
887             } else {
888             warn "archiv: Path [$para{'path'}] does not exists. Try to create\n";
889             if( mkpath( $para{'path'} ) ) {
890             $self->{'archivPath'} = $para{'path'};
891             } else {
892             die "Failed!\n";
893             }
894             }
895             }
896              
897             if( exists $para{'save'} ) {
898             my $now_string = strftime '%a-%b-%d-%H:%M:%S-%Y', localtime;
899             #my $now_string = strftime '%d-%m-%Y-%H:%M:%S', localtime;
900             my $subject = $self->{'senderSubject'};
901             $subject =~ s/\s/_/g;
902             $subject =~ s/\!/_/g;
903             $subject =~ s/\?/_/g;
904             if( mkpath( $self->{'archivPath'}."/".$now_string."_".$subject ) ) {
905             my $mailFile = $self->previewMailFile( preview => 1 );
906             $self->previewMailFileExplode( $mailFile );
907             $self->_lowCopy( $self->{'previewPath'}.'/*', $self->{'archivPath'}."/".$now_string."_".$subject, 1);
908              
909             if( -e $self->{'archivPath'}."/".$now_string."_".$subject."/explode/file.html") {
910             warn qx "perl -pi -e 's/cid://g;' $self->{'archivPath'}/$now_string\_$subject/explode/file.html 2>&1";
911             }
912              
913             $self->_lowWrite( time() , $self->{'archivPath'}."/".$now_string."_".$subject."/timestmp.txt" );
914             $self->_lowWrite( $self->{'listCurrent'}, $self->{'archivPath'}."/".$now_string."_".$subject."/list.txt" );
915             $self->_lowRemoveFile( $self->{'archivPath'}."/".$now_string."_".$subject."/file.tmp" );
916              
917             } else {
918             die "could not create Dir [".$now_string."_".$subject."]\n";
919             }
920             }
921              
922             if( exists $para{'get'} ) {
923             if( $para{'get'} eq "mails" ) {
924             #return $self->_lowReadDir( $self->{'archivPath'} );
925             my @mails = $self->_lowReadDir( $self->{'archivPath'} );
926             my %mailByTimeStmp = ();
927              
928             foreach my $m (@mails) {
929             my $time = $self->_lowRead( $self->{'archivPath'}."/$m/timestmp.txt" );
930             chomp $time;
931             $mailByTimeStmp{ $time } = $m;
932             }
933              
934             return %mailByTimeStmp;
935             }
936             elsif( $para{'get'} eq "archivPath" ) {
937             return $self->{'archivPath'};
938             }
939             }
940             }
941              
942              
943             sub _lowReadTemplates {
944             my ($self) = @_;
945             if( -d $self->{'templatePath'}.'/'.HTML_TMPL.'/'.HEADER ) {
946             push( @{ $self->{'tmplHeaderHtmlFiles'} }, $self->_lowReadTemplateDir( $self->{'templatePath'}.'/'.HTML_TMPL.'/'.HEADER ) );
947             } else {
948             mkpath( $self->{'templatePath'}.'/'.HTML_TMPL.'/'.HEADER );
949             }
950              
951             if( -d $self->{'templatePath'}.'/'.TEXT_TMPL.'/'.HEADER ) {
952             push( @{ $self->{'tmplHeaderTextFiles'} }, $self->_lowReadTemplateDir( $self->{'templatePath'}.'/'.TEXT_TMPL.'/'.HEADER ) );
953             } else {
954             mkpath( $self->{'templatePath'}.'/'.TEXT_TMPL.'/'.HEADER );
955             }
956              
957              
958             if( -d $self->{'templatePath'}.'/'.HTML_TMPL.'/'.FOOTER ) {
959             push( @{ $self->{'tmplFooterHtmlFiles'} }, $self->_lowReadTemplateDir( $self->{'templatePath'}.'/'.HTML_TMPL.'/'.FOOTER ) );
960             } else {
961             mkpath( $self->{'templatePath'}.'/'.HTML_TMPL.'/'.FOOTER );
962             }
963              
964             if( -d $self->{'templatePath'}.'/'.TEXT_TMPL.'/'.FOOTER ) {
965             push( @{ $self->{'tmplFooterTextFiles'} }, $self->_lowReadTemplateDir( $self->{'templatePath'}.'/'.TEXT_TMPL.'/'.FOOTER ) );
966             } else {
967             mkpath( $self->{'templatePath'}.'/'.TEXT_TMPL.'/'.FOOTER );
968             }
969              
970             # Embedded files in html
971             if(! -d $self->{'templatePath'}.'/'.HTML_TMPL.'/'.HTML_EMB ) {
972             mkpath( $self->{'templatePath'}.'/'.HTML_TMPL.'/'.HTML_EMB );
973             mkpath( $self->{'templatePath'}.'/'.HTML_TMPL.'/'.HTML_EMB.'/'.HEADER );
974             mkpath( $self->{'templatePath'}.'/'.HTML_TMPL.'/'.HTML_EMB.'/'.FOOTER );
975             }
976             }
977              
978              
979             sub _lowReadTemplateDir {
980             my ($self, $path) = @_;
981             my @files = $self->_lowReadDir( $path );
982             my @tmplFiles = ();
983             my $regExpConst = SUFFIX_TMPL;
984             foreach my $f ( @files ) {
985             if( $f !~/$regExpConst$/) {
986             push(@tmplFiles, $f);
987             }
988             }
989             return @tmplFiles;
990             }
991              
992              
993             sub _lowReadLists {
994             my ($self) = @_;
995             push( @{ $self->{'listNames'} }, $self->_lowReadDir( $self->{'listPath'} ) );
996             }
997              
998              
999             sub _lowReadListMembers {
1000             my ($self, $listname) = @_;
1001              
1002             my @member = $self->_lowReadDir( $self->{'listPath'}.'/'.$listname );
1003              
1004             # reset
1005             $self->{'listMembers'}->{ $listname } = [];
1006             $self->{'senderFrom'} = $listname;
1007              
1008             foreach my $m ( @member ) {
1009             push( @{ $self->{'listMembers'}->{ $listname } },
1010             $self->_lowReadFile( $self->{'listPath'}.'/'.$listname.'/'.$m ) );
1011             }
1012              
1013             # load Mail addr to sender
1014             if( $self->{'sender'} ) {
1015             foreach my $m ( @member ) {
1016             #$self->addAddress( address => $m, addressType => 'To' );
1017             $self->addAddress( address => $m, addressType => 'Bcc' );
1018             }
1019             }
1020             }
1021              
1022              
1023             sub _lowUnloadListMember {
1024             my ($self, $listname) = @_;
1025              
1026             if($listname eq "all") {
1027             $self->addAddress( empty => 1, addressType => 'To' );
1028             } else {
1029             #TODO
1030             }
1031             }
1032              
1033              
1034             sub _lowReadDir {
1035             my ($self, $dir) = @_;
1036             opendir( DIR, $dir ) or die "Could not open [$dir]: $!\n";
1037             my @tmp = readdir( DIR );
1038             my @ret = ();
1039             foreach my $entry ( @tmp ) {
1040             next if( $entry eq "." || $entry eq "..");
1041             push(@ret, $entry);
1042             }
1043             closedir( DIR );
1044             return @ret;
1045             }
1046              
1047              
1048             sub _lowEmptyDir {
1049             my ($self, $dir) = @_;
1050             my @files = $self->_lowReadDir($dir);
1051             foreach my $f ( @files ) {
1052             $self->_lowRemoveFile("$dir/$f");
1053             }
1054             }
1055              
1056              
1057             sub _lowReadFile ($$) {
1058             my ($self, $file) = @_;
1059             if ( open(FILE, "<$file") ) {
1060             my $firstLine = '';
1061             while( defined(my $line=) ) {
1062             $firstLine .= $line;
1063             }
1064             close(FILE);
1065              
1066             # remove special sign
1067             $firstLine =~s/\r//mg;
1068             #warn "[$firstLine]\n";
1069              
1070             my @tupels = split(/\n/, $firstLine);
1071             my $tupelHash = {};
1072             foreach my $tupel ( @tupels ) {
1073             my @keyValue = split(/=/, $tupel);
1074             $tupelHash->{ $keyValue[0] } = $keyValue[1];
1075             }
1076             return $tupelHash;
1077             } else {
1078             die "_lowReadFile [$file], $!\n";
1079             }
1080             }
1081              
1082              
1083             sub _lowWriteFile ($$$) {
1084             my ($self, $file, $refHash) = @_;
1085             if ( open(FILE, ">$file") ) {
1086             foreach my $key (keys %{ $refHash } ) {
1087             #print "$key=$refHash->{$key}\n";
1088             print FILE "$key=$refHash->{$key}\n";
1089             }
1090             close(FILE);
1091             } else {
1092             die "_lowWriteFile [$file], $!\n";
1093             }
1094             }
1095              
1096              
1097             sub _lowCopy {
1098             my ($self, $from, $to, $recursive ) = @_;
1099            
1100             if( $recursive ) {
1101             #warn "[$from] [$to]\n";
1102             warn qx "cp -r $from $to 2>&1";
1103             } else {
1104             warn qx "cp $from $to 2>&1";
1105             }
1106             }
1107              
1108              
1109             sub _lowRemoveFile ($$) {
1110             my ($self, $path ) = @_;
1111              
1112             if( -e $path ) {
1113             if( unlink( $path ) ) {
1114             return 1;
1115             } else {
1116             warn "Could not unlink [$path]\n";
1117             }
1118             } else {
1119             warn "Could not find [$path]\n";
1120             }
1121              
1122             return 0;
1123             }
1124              
1125              
1126             sub _lowPrepairSend {
1127             my ($self) = @_;
1128            
1129             if( -e $self->{'bodyPath'}.'/subject.txt' ) {
1130             $self->{'senderSubject'} = $self->_lowRead( $self->{'bodyPath'}.'/subject.txt' );
1131             } else {
1132             warn "No Subject found!\n";
1133             }
1134              
1135             #$self->{'sender'}->attach( Subject => $self->{'senderSubject'} );
1136             $self->{'sender'}->add( Subject => $self->{'senderSubject'} );
1137              
1138             if( $self->{'senderType'} eq "multipart/mixed" ) {
1139             my $msgStrText = '';
1140             my $msgStrHtml = '';
1141             my $textPart = $self->{'sender'}->attach(
1142             Type => 'multipart/alternative'
1143             );
1144              
1145              
1146             if( exists $self->{'senderHeader'}->{ +TEXT_TMPL } ) {
1147             if( $self->{'senderHeader'}->{ +TEXT_TMPL } ) {
1148             $msgStrText .= $self->_lowRead( $self->{'senderHeader'}->{ +TEXT_TMPL } );
1149             }
1150             }
1151              
1152             foreach my $bodyFile ( $self->_lowReadDir( $self->{'bodyPath'}.'/'.TEXT_TMPL ) ) {
1153             $msgStrText .= $self->_lowRead( $self->{'bodyPath'}.'/'.TEXT_TMPL.'/'.$bodyFile);
1154             }
1155              
1156             if( exists $self->{'senderFooter'}->{ +TEXT_TMPL } ) {
1157             if( $self->{'senderFooter'}->{ +TEXT_TMPL } ) {
1158             $msgStrText .= $self->_lowRead( $self->{'senderFooter'}->{ +TEXT_TMPL } );
1159             }
1160             }
1161              
1162             if( !$msgStrText ) {
1163             warn "_lowPrepairSend: try to send multipart but text part is missing!\n";
1164             return 0;
1165             }
1166              
1167             $textPart->attach(
1168             Type => 'text/plain',
1169             Data => $msgStrText,
1170             );
1171              
1172              
1173              
1174             my $htmlPart = $textPart->attach(
1175             Type => 'multipart/related'
1176             );
1177              
1178             my @imgParts = ();
1179              
1180             if( exists $self->{'senderHeader'}->{ +HTML_TMPL } ) {
1181             if( $self->{'senderHeader'}->{ +HTML_TMPL } ) {
1182             $msgStrHtml .= $self->_lowRead( $self->{'senderHeader'}->{ +HTML_TMPL } );
1183             push( @imgParts, $self->_lowReadEmbeddedFiles( $self->{'senderHeader'}->{ +HTML_TMPL }) );
1184             }
1185             }
1186              
1187             foreach my $bodyFile ( $self->_lowReadDir( $self->{'bodyPath'}.'/'.HTML_TMPL ) ) {
1188             $msgStrHtml .= $self->_lowRead( $self->{'bodyPath'}.'/'.HTML_TMPL.'/'.$bodyFile);
1189             }
1190             push( @imgParts, $self->_lowReadEmbeddedFilesBody( $self->{'bodyPath'}.'/'.HTML_EMB ) );
1191              
1192             if( exists $self->{'senderFooter'}->{ +HTML_TMPL } ) {
1193             if( $self->{'senderFooter'}->{ +HTML_TMPL } ) {
1194             $msgStrHtml .= $self->_lowRead( $self->{'senderFooter'}->{ +HTML_TMPL } );
1195             push( @imgParts, $self->_lowReadEmbeddedFiles( $self->{'senderFooter'}->{ +HTML_TMPL } ) );
1196             }
1197             }
1198              
1199              
1200             if( !$msgStrHtml ) {
1201             warn "_lowPrepairSend: try to send multipart but html part is missing!\n";
1202             return 0;
1203             }
1204              
1205             $htmlPart->attach(
1206             Type => 'text/html',
1207             Data => $msgStrHtml
1208             );
1209              
1210             foreach my $part ( @imgParts ) {
1211             $htmlPart->attach($part);
1212             }
1213              
1214             }
1215              
1216             elsif( $self->{'senderType'} eq "text" ) {
1217             my $msgStrText = '';
1218              
1219             if( exists $self->{'senderHeader'}->{ +TEXT_TMPL } ) {
1220             if( $self->{'senderHeader'}->{ +TEXT_TMPL } ) {
1221             $msgStrText .= $self->_lowRead( $self->{'senderHeader'}->{ +TEXT_TMPL } );
1222             }
1223             }
1224              
1225             foreach my $bodyFile ( $self->_lowReadDir( $self->{'bodyPath'}.'/'.TEXT_TMPL ) ) {
1226             $msgStrText .= $self->_lowRead( $self->{'bodyPath'}.'/'.TEXT_TMPL.'/'.$bodyFile);
1227             }
1228              
1229             if( exists $self->{'senderFooter'}->{ +TEXT_TMPL } ) {
1230             if( $self->{'senderFooter'}->{ +TEXT_TMPL } ) {
1231             $msgStrText .= $self->_lowRead( $self->{'senderFooter'}->{ +TEXT_TMPL } );
1232             }
1233             }
1234              
1235             if( !$msgStrText ) {
1236             warn "_lowPrepairSend: try to send but text part is missing!\n";
1237             return 0;
1238             }
1239              
1240             $self->{'sender'} = MIME::Lite->new(
1241             Type => $self->{'senderType'},
1242             Data => $msgStrText
1243             );
1244              
1245             $self->{'sender'}->add( Subject => $self->{'senderSubject'} );
1246              
1247             # $self->{'sender'}->attach(
1248             # Type => 'text/plain',
1249             # Data => $msgStrText
1250             # );
1251              
1252             }
1253              
1254             elsif( $self->{'senderType'} eq "html" || $self->{'senderType'} eq "multipart/related") {
1255             my $msgStrHtml = '';
1256             my @imgParts = ();
1257              
1258             if( exists $self->{'senderHeader'}->{ +HTML_TMPL } ) {
1259             if( $self->{'senderHeader'}->{ +HTML_TMPL } ) {
1260             $msgStrHtml .= $self->_lowRead( $self->{'senderHeader'}->{ +HTML_TMPL } );
1261             push( @imgParts, $self->_lowReadEmbeddedFiles( $self->{'senderHeader'}->{ +HTML_TMPL } ) );
1262             }
1263             }
1264              
1265             foreach my $bodyFile ( $self->_lowReadDir( $self->{'bodyPath'}.'/'.HTML_TMPL ) ) {
1266             $msgStrHtml .= $self->_lowRead( $self->{'bodyPath'}.'/'.HTML_TMPL.'/'.$bodyFile);
1267             }
1268             push( @imgParts, $self->_lowReadEmbeddedFilesBody( $self->{'bodyPath'}.'/'.HTML_EMB ) );
1269              
1270             if( exists $self->{'senderFooter'}->{ +HTML_TMPL } ) {
1271             if( $self->{'senderFooter'}->{ +HTML_TMPL } ) {
1272             $msgStrHtml .= $self->_lowRead( $self->{'senderFooter'}->{ +HTML_TMPL } );
1273             push( @imgParts, $self->_lowReadEmbeddedFiles( $self->{'senderFooter'}->{ +HTML_TMPL } ) );
1274             }
1275             }
1276              
1277             #warn "##$msgStrHtml";
1278              
1279             if( !$msgStrHtml ) {
1280             warn "_lowPrepairSend: try to send but html part is missing!\n";
1281             return 0;
1282             }
1283              
1284             $self->{'sender'}->attach(
1285             Type => 'text/html',
1286             Data => $msgStrHtml
1287             );
1288              
1289             foreach my $part ( @imgParts ) {
1290             $self->{'sender'}->attach($part);
1291             }
1292              
1293             }
1294              
1295             else {
1296             warn "Sender Type is wrong! [$self->{'senderType'}]\n";
1297             return 0;
1298             }
1299              
1300             return 1;
1301             }
1302              
1303              
1304             sub _lowReadEmbeddedFiles {
1305             my ($self, $path) = @_;
1306             my $tupels = $self->_lowReadFile($path.SUFFIX_TMPL);
1307             my @files = split(/,/, $tupels->{'embedded'} );
1308             my $ft = File::Type->new();
1309             my @attachedPart = ();
1310             foreach my $file (@files) {
1311             my $embPath = $self->{'templatePath'}.'/'.HTML_TMPL.'/'.HTML_EMB.'/'.
1312             (uc $tupels->{'is'}.'/'.$tupels->{'fileName'}).'/'.$file;
1313             push(@attachedPart,
1314             MIME::Lite->new(
1315             Type => $ft->checktype_filename( $embPath ),
1316             Id => $file,
1317             Path => $embPath
1318             )
1319             );
1320             }
1321              
1322             return @attachedPart;
1323             }
1324              
1325              
1326             sub _lowReadEmbeddedFilesBody {
1327             my ($self, $path) = @_;
1328             my $ft = File::Type->new();
1329             my @attachedPart = ();
1330             foreach my $file ( $self->_lowReadDir( $path ) ) {
1331             my $embPath = $path.'/'.$file;
1332             push(@attachedPart,
1333             MIME::Lite->new(
1334             Type => $ft->checktype_filename( $embPath ),
1335             Id => $file,
1336             Path => $embPath
1337             )
1338             );
1339              
1340             }
1341              
1342             return @attachedPart;
1343             }
1344              
1345              
1346             sub _lowRead ($$) {
1347             my ($self, $path ) = @_;
1348              
1349             if( ! $path ) {
1350             warn "_lowRead: path is empty\n";
1351             return "";
1352             }
1353              
1354             if ( open(FILE, "<$path") ) {
1355             my $buffer = '';
1356             while( defined(my $line=) ) {
1357             $buffer .= $line;
1358             }
1359             close(FILE);
1360             return $buffer;
1361             } else {
1362             warn "_lowRead: Could not open [$path],$!\n";
1363             return "";
1364             }
1365             }
1366              
1367              
1368             sub _lowWrite ($$$) {
1369             my ($self, $data, $path) = @_;
1370              
1371             if ( open(FILE, ">$path") ) {
1372             print FILE $data;
1373             close(FILE);
1374             } else {
1375             warn "_lowWite: Could not open [$path],$!\n";
1376             return 0;
1377             }
1378              
1379             }
1380              
1381              
1382             sub _lowBodyEmbedded {
1383             my ($self, $embedded) = @_;
1384              
1385             if( !$embedded ) {
1386             warn "_lowBodyEmbedded: empty parameter!\n";
1387             return 0;
1388             }
1389              
1390             my $embPath = $self->{'bodyPath'}.'/'.HTML_EMB;
1391              
1392             $self->_lowEmptyDir( $embPath );
1393            
1394             if( ref $embedded eq "ARRAY" ) {
1395             foreach my $emb ( @{ $embedded } ) {
1396             $self->_lowCopy( $emb, $embPath );
1397             }
1398             } else {
1399             $self->_lowCopy( $embedded, $embPath );
1400             }
1401              
1402             }
1403              
1404              
1405             sub _lowAddAddress {
1406             my ($self, $mail, $type) = @_;
1407              
1408             foreach my $adr ( @{ $self->{'senderAddressList'}->{ $type } } ) {
1409             if( $adr eq $mail) {
1410             #warn "_lowAddAddress: [$mail] already in Mail address list for type [$type]!\n";
1411             return 0;
1412             }
1413             }
1414             push( @{ $self->{'senderAddressList'}->{ $type } }, $mail );
1415             return 1;
1416             }
1417              
1418              
1419             sub _lowValidListName {
1420             my ($self, $name) = @_;
1421             if( $name =~ /^([\w\d_\.\-]+\@[\w\d_\.\-]+)$/i ) {
1422             #if( $name =~ /[\, ]/) {
1423             # return 0;
1424             #} else {
1425             # return 1;
1426             #}
1427             if($1) {
1428             #warn "--$1\n";
1429             return 1;
1430             } else {
1431             return 0;
1432             }
1433              
1434             } else {
1435             return 0;
1436             }
1437             }
1438              
1439              
1440             sub _lowValidMailAddress {
1441             my ($self, $name) = @_;
1442             return $self->_lowValidListName( $name );
1443             }
1444              
1445             sub _lowSend {
1446             my ($self, @args) = @_;
1447              
1448             ### We need the "From:" and "To:" headers to pass to the SMTP mailer:
1449             my $hdr = $self->{'sender'}->fields();
1450             my $from = $self->{'sender'}->get('From');
1451             my $to = $self->{'sender'}->get('To');
1452              
1453             ### Sanity check:
1454             defined($to) or Carp::croak "send_by_smtp: missing 'To:' address\n";
1455              
1456              
1457             ### Get the destinations as a simple array of addresses:
1458             my @to_all = MIME::Lite::extract_addrs($to);
1459             if ($MIME::Lite::AUTO_CC) {
1460             foreach my $field (qw(Cc Bcc)) {
1461             my $value = $self->{'sender'}->get($field);
1462             push @to_all, MIME::Lite::extract_addrs($value) if defined($value);
1463             }
1464             }
1465              
1466             ### Create SMTP client:
1467             require Net::SMTP;
1468             my $smtp = MIME::Lite::SMTP->new(@args)
1469             or Carp::croak("Failed to connect to mail server: $!\n");
1470             $smtp->mail($from)
1471             or Carp::croak("SMTP MAIL command failed: $!\n".$smtp->message."\n");
1472             #do not skip on bad
1473             #$smtp->to(@to_all)
1474             $smtp->to(@to_all, { SkipBad => 1 } )
1475             or Carp::croak("SMTP RCPT command failed: $!\n".$smtp->message."\n");
1476             $smtp->data()
1477             or Carp::croak("SMTP DATA command failed: $!\n".$smtp->message."\n");
1478              
1479             ### MIME::Lite can print() to anything with a print() method:
1480             $self->{'sender'}->print_for_smtp($smtp);
1481             $smtp->dataend();
1482             $smtp->quit;
1483             1;
1484             }
1485              
1486              
1487              
1488              
1489              
1490              
1491             =head1 NAME
1492              
1493             Newsletter - A simple newsletter module!
1494              
1495             =head1 VERSION
1496              
1497             Version 0.033
1498              
1499             =head1 SYNOPSIS
1500              
1501             The backend module for the newsletter (newsletter.cgi) web interface. This module is a BETA Version.
1502             Copy the newsletter.cgi to your /cgi-bin/ directory and adapt it. Maybe you have to change the paths
1503              
1504             Perhaps a little code snippet.
1505              
1506             use Newsletter;
1507              
1508             my $foo = Newsletter->new();
1509             ...
1510              
1511             More docu is coming ...
1512              
1513             =head1 FUNCTIONS
1514              
1515             template( %params )
1516             list( %params )
1517             body( %params )
1518             sender( %params )
1519             send( )
1520              
1521             =head1 EXAMPLE
1522              
1523             #!/usr/bin/perl -w
1524              
1525             use strict;
1526             use Newsletter;
1527              
1528             my $news = Newsletter->new;
1529              
1530             $news->template( path => '/tmp/newsletter' );
1531              
1532             $news->template(
1533             file => {
1534             # u need
1535             path => 'test/myHeader.html',
1536             type => 'html',
1537             is => 'header',
1538              
1539             # here starts the optional Params
1540             name => 'My Header Name',
1541             schema => 'My First Template',
1542             embedded => '/tmp/opera.jpg'
1543              
1544             # here starts self defined Params
1545             # ...
1546             }
1547             );
1548              
1549             $news->template(
1550             use => {
1551             schema => 'My First Template'
1552             }
1553             );
1554              
1555             $news->template(
1556             use => {
1557             is => 'header',
1558             name => 'My Header Name'
1559             }
1560             );
1561              
1562             $news->template(
1563             use => {
1564             is => 'header',
1565             filename => 'myHeader.txt'
1566             }
1567             );
1568              
1569             #print $news->template(
1570             # use => {
1571             # is => 'header',
1572             # filename => 'myHeader.html'
1573             # },
1574             # remove => 1
1575             #);
1576              
1577              
1578             #print $news->{'senderHeader'}->{'HTML'}, "\n";
1579              
1580              
1581             #######################################################
1582             # TEST List
1583             #######################################################
1584              
1585             $news->list(
1586             path => '/tmp/newsletter/list'
1587             );
1588              
1589             $news->list(
1590             list => {
1591             name => 'the-top@foo.bar'
1592             }
1593             );
1594              
1595             $news->list(
1596             member => {
1597             # u need
1598             listname => 'the-top@foo.bar',
1599             mail => 'foo@bar.bla'
1600             }
1601             );
1602              
1603             $news->list(
1604             member => {
1605             # u need
1606             listname => 'the-top@foo.bar',
1607             mail => 'hello@world.bla'
1608             }
1609             );
1610              
1611             $news->list(
1612             remove => {
1613             # remove one member
1614             listname => 'the-top@foo.bar',
1615             mail => 'hello@world.bla'
1616             }
1617             );
1618              
1619             $news->list(
1620             remove => {
1621             # remove whole list
1622             listname => 'the-top@foo.bar',
1623             }
1624             );
1625              
1626              
1627             ############################################
1628             # Test Send
1629             ############################################
1630              
1631             $news->list(
1632             empty => 1,
1633             path => '/tmp/newsletter/list'
1634             );
1635              
1636             $news->list(
1637             list => {
1638             name => 'news@vienna-marathon.com',
1639             }
1640             );
1641              
1642             $news->list(
1643             member => {
1644             # u need
1645             listname => 'news@vienna-marathon.com',
1646             mail => 'dominik@soft.uni-linz.ac.at'
1647             }
1648             );
1649              
1650             $news->body(
1651             path => '/tmp/newsletter/body'
1652             );
1653              
1654             $news->body(
1655             subject => 'A test mail!',
1656             file => {
1657             path => 'test/myBody.html',
1658             type => 'html',
1659             embedded => '/tmp/opera.jpg'
1660             }
1661             );
1662              
1663             $news->body(
1664             file => {
1665             path => 'test/myBody.txt',
1666             type => 'text',
1667             }
1668             );
1669              
1670              
1671             $news->sender(
1672             smtp => 'soft.uni-linz.ac.at'
1673             );
1674              
1675             my $sender = $news->buildMail();
1676              
1677             #print $sender->as_string;
1678             #print "\n";
1679              
1680             $news->send();
1681              
1682              
1683              
1684             =head1 ONLINE
1685              
1686             Visit:
1687              
1688             L
1689              
1690             Here you can see the example script from the cgi directory working:
1691              
1692             L
1693              
1694              
1695             =head1 AUTHOR
1696              
1697             Dominik Hochreiter, C<< >>
1698              
1699             =head1 TESTS
1700              
1701             Successfully tested on Linux (Slackware 10.2) and Solaris (SunOS 5.8).
1702             This Module got developed for www.vienna-marathon.com
1703              
1704             =head1 BUGS
1705              
1706             Please report any bugs or feature requests to
1707             C, or through the web interface at
1708             L.
1709             I will be notified, and then you'll automatically be notified of progress on
1710             your bug as I make changes.
1711              
1712             =head1 SUPPORT
1713              
1714             You can find documentation for this module with the perldoc command.
1715              
1716             perldoc Newsletter
1717              
1718             You can also look for information at:
1719              
1720             =over 4
1721              
1722             =item * AnnoCPAN: Annotated CPAN documentation
1723              
1724             L
1725              
1726             =item * CPAN Ratings
1727              
1728             L
1729              
1730             =item * RT: CPAN's request tracker
1731              
1732             L
1733              
1734             =item * Search CPAN
1735              
1736             L
1737              
1738             =back
1739              
1740             =head1 ACKNOWLEDGEMENTS
1741              
1742             =head1 COPYRIGHT & LICENSE
1743              
1744             Copyright 2006 Dominik Hochreiter, all rights reserved.
1745              
1746             This program is free software; you can redistribute it and/or modify it
1747             under the same terms as Perl itself.
1748              
1749             =cut
1750              
1751             1; # End of Newsletter