File Coverage

blib/lib/SQLite/Work/Mail.pm
Criterion Covered Total %
statement 15 89 16.8
branch 0 26 0.0
condition 0 3 0.0
subroutine 5 9 55.5
pod 4 4 100.0
total 24 131 18.3


line stmt bran cond sub pod time code
1             package SQLite::Work::Mail;
2             $SQLite::Work::Mail::VERSION = '0.15';
3 1     1   799 use strict;
  1         1  
  1         32  
4 1     1   4 use warnings;
  1         2  
  1         28  
5              
6             =head1 NAME
7              
8             SQLite::Work::Mail - send mail with data from an SQLite table.
9              
10             =head1 VERSION
11              
12             version 0.15
13              
14             =head1 SYNOPSIS
15              
16             use SQLite::Work::Mail;
17              
18             my $obj = SQLite::Work::Mail->new(%args);
19              
20             $obj->send_mail(%args);
21              
22             =head1 DESCRIPTION
23              
24             This module is an expansion of SQLite::Work used for
25             sending email populated by row(s) from a table in
26             an SQLite database.
27              
28             =cut
29              
30 1     1   635 use File::Temp qw(tmpnam);
  1         14880  
  1         58  
31 1     1   7 use SQLite::Work;
  1         1  
  1         14  
32 1     1   3 use Text::NeatTemplate;
  1         2  
  1         822  
33              
34             our @ISA = qw(SQLite::Work);
35              
36             =head1 CLASS METHODS
37              
38             =head2 new
39              
40             my $obj = SQLite::Work::Mail->new(
41             database=>$database_file,
42             report_template=>$report_template,
43             default_format=>{
44             'episodes' => {
45             'title'=>'title',
46             'series_title'=>'title',
47             }
48             },
49             },
50             );
51              
52             Make a new report object.
53              
54             Takes the same arguments as L::new().
55              
56             =cut
57              
58             sub new {
59 0     0 1   my $class = shift;
60 0           my %parameters = (@_);
61 0           my $self = SQLite::Work->new(%parameters);
62              
63 0 0         $self->{report_template} = ''
64             if !defined $parameters{report_template};
65 0   0       bless ($self, ref ($class) || $class);
66             } # new
67              
68             =head1 OBJECT METHODS
69              
70             =head2 send_email
71              
72             $obj->send_email();
73              
74             $rep->send_email(
75             table=>$table,
76             where=>\%where,
77             not_where=>\%not_where,
78             subject=>'My Mail',
79             email_col=>$email_col,
80             email_address=>\@addresses,
81             mailer=>$mailer,
82             sort_by=>\@sort_by,
83             sort_reversed=>\%sort_reversed,
84             show=>\@show,
85             limit=>$limit,
86             page=>$page,
87             row_template=>$row_template,
88             );
89              
90             Select data from a table in the database, and send each
91             row as a separate email.
92              
93             Arguments are as follows (in alphabetical order):
94              
95             =over
96              
97             =item email_address
98              
99             An array of email addresses to send the email to. If this is given,
100             this will send an email for each matching row, to each address in the array.
101             Useful for broadcast mailing.
102              
103             Give either this option or the 'email_col' option.
104              
105             =item email_col
106              
107             The name of the column to take email addresses from. If this is given,
108             then each row is sent to the email address value in that column for
109             that row. Useful for individual notification.
110              
111             Give either this option or the 'email_address' option.
112              
113             =item limit
114              
115             The maximum number of rows to display per page. If this is zero,
116             then all rows are displayed in one page.
117              
118             =item mailer
119              
120             The name of the mailing program to use. Allowable values are
121             'mutt', sendmail, mail, and elm.
122              
123             =item not_where
124              
125             A hash containing the column names where the selection criteria
126             in L should be negated.
127              
128             =item page
129              
130             Select which page to generate, if limit is not zero.
131              
132             =item row_template
133              
134             The template for each row. This uses the same format as for L.
135             If none is given, then a default row_template will be generated,
136             depending on which columns are going to be shown (see L).
137              
138             Therefore it is important that if one provides a row_template, that
139             it matches the current layout.
140              
141             The format is as follows:
142              
143             =over
144              
145             =item {$colname}
146              
147             A variable; will display the value of the column, or nothing if
148             that value is empty.
149              
150             =item {?colname stuff [$colname] more stuff}
151              
152             A conditional. If the value of 'colname' is not empty, this will
153             display "stuff value-of-column more stuff"; otherwise it displays
154             nothing.
155              
156             {?col1 stuff [$col1] thing [$col2]}
157              
158             This would use both the values of col1 and col2 if col1 is not
159             empty.
160              
161             =item {?colname stuff [$colname] more stuff!!other stuff}
162              
163             A conditional with "else". If the value of 'colname' is not empty, this
164             will display "stuff value-of-column more stuff"; otherwise it displays
165             "other stuff".
166              
167             This version can likewise use multiple columns in its display parts.
168              
169             {?col1 stuff [$col1] thing [$col2]!![$col3]}
170              
171             =back
172              
173             =item show
174              
175             An array of columns to select; also the order in which they should
176             be shown when a L has not been given.
177              
178             =item sort_by
179              
180             An array of column names by which the result should be sorted.
181              
182             =item sort_reversed
183              
184             A hash of column names where the sorting given in L should
185             be reversed.
186              
187             =item subject
188              
189             A template for the Subject: line of the emails.
190              
191             =item table
192              
193             The table to report on. (required)
194              
195             =item where
196              
197             A hash containing selection criteria. The keys are the column names
198             and the values are strings suitable for using in a LIKE condition;
199             that is, '%' is a multi-character wildcard, and '_' is a
200             single-character wildcard. All the conditions will be ANDed together.
201              
202             Yes, this is limited and doesn't use the full power of SQL, but it's
203             useful enough for most purposes.
204              
205             =back
206              
207             =cut
208             sub send_email ($) {
209 0     0 1   my $self = shift;
210 0           my %args = (
211             table=>undef,
212             limit=>0,
213             page=>1,
214             sort_by=>[],
215             sort_reversed=>{},
216             not_where=>{},
217             where=>{},
218             show=>[],
219             row_template=>'',
220             subject=>'Notification',
221             email_col=>'',
222             email_address=>[],
223             mailer=>'mail',
224             @_
225             );
226              
227 0           my $total = $self->get_total_matching(%args);
228 0           my $limit = $args{limit};
229             # make the selection, only for one table
230 0           my ($sth1, $sth2) = $self->make_selections(%args,
231             table2=>'');
232              
233 0           my @columns = (@{$args{show}}
  0            
234 0 0         ? @{$args{show}}
235             : $self->get_colnames($args{table}));
236 0           my %show_cols = ();
237 0           for (my $i = 0; $i < @columns; $i++)
238             {
239 0           $show_cols{$columns[$i]} = 1;
240             }
241 0           my %nice_cols = $self->set_nice_cols(columns=>\@columns,
242             truncate_colnames=>$args{truncate_colnames});
243              
244 0           my $row_template = $self->get_row_template(
245             table=>$args{table},
246             row_template=>$args{row_template},
247             layout=>'fieldval',
248             report_style=>'bare',
249             columns=>\@columns,
250             show_cols=>\%show_cols,
251             nice_cols=>\%nice_cols);
252             # loop through the rows, sending email
253 0           my $row_hash;
254 0           while ($row_hash = $sth1->fetchrow_hashref)
255             {
256 0           $self->send_one_email(row_hash=>$row_hash,
257             row_template=>$row_template,
258             subject=>$args{subject},
259             show_cols=>\%show_cols,
260             email_col=>$args{email_col},
261             email_address=>$args{email_address},
262             mailer=>$args{mailer});
263             }
264              
265             } # send_email
266              
267             =head1 Private Methods
268              
269             =head2 send_one_email
270              
271             =cut
272             sub send_one_email ($%) {
273 0     0 1   my $self = shift;
274 0           my %args = (
275             row_hash=>undef,
276             row_template=>undef,
277             subject=>'Notification',
278             show_cols=>undef,
279             email_col=>'',
280             email_address=>[],
281             mailer=>'',
282             @_
283             );
284 0           my $row_hash = $args{row_hash};
285 0           my $row_template = $args{row_template};
286 0           my %show_cols = %{$args{show_cols}};
  0            
287              
288             # put output to a temporary output file
289 0           my $outfile = tmpnam();
290 0 0         open(OUTFILE, ">$outfile") || die "Can't open '$outfile' for writing.";
291              
292 0           my $rowstr = $row_template;
293 0           $rowstr =~ s/{([^}]+)}/$self->{_tobj}->do_replace(data_hash=>$row_hash,show_names=>\%show_cols,targ=>$1)/eg;
  0            
294 0           print OUTFILE $rowstr;
295              
296 0           close(OUTFILE);
297 0 0         if ($args{'debug'})
298             {
299 0           print STDERR "outfile=$outfile\n";
300             }
301              
302 0           my $subject = $args{subject};
303 0           $subject =~ s/{([^}]+)}/$self->{_tobj}->do_replace(data_hash=>$row_hash,show_names=>\%show_cols,targ=>$1)/eg;
  0            
304            
305 0 0         if ($args{'debug'})
306             {
307 0           print STDERR "subject=$subject\n";
308             }
309 0 0         if ($args{email_col})
    0          
310 0           {
311 0           $self->send_the_actual_mail(email=>$row_hash->{$args{email_col}},
312             mailer=>$args{mailer},
313             subject=>$subject,
314             mailfile=>$outfile);
315             }
316             elsif (@{$args{email_address}}) # send to list of emails
317             {
318 0           foreach my $email (@{$args{email_address}})
  0            
319             {
320 0           $self->send_the_actual_mail(email=>$email,
321             mailer=>$args{mailer},
322             subject=>$subject,
323             mailfile=>$outfile);
324             }
325             }
326 0           unlink($outfile);
327             } # send_one_email
328              
329             =head2 send_the_actual_mail
330              
331             =cut
332             sub send_the_actual_mail ($%) {
333 0     0 1   my $self = shift;
334 0           my %args = (
335             email=>'',
336             subject=>'Notification',
337             mailfile=>'',
338             mailer=>'',
339             @_
340             );
341 0           my $email = $args{email};
342 0           my $subject = $args{subject};
343 0           my $mailfile = $args{mailfile};
344 0           my $mailer = $args{mailer};
345              
346 0 0         if ($email)
347             {
348 0           my $command = '';
349 0 0         if ($mailer eq 'mutt')
    0          
    0          
    0          
350             {
351 0           $command = "mutt $email -s \"$subject\" -i $mailfile";
352 0           system($command);
353             }
354             elsif ($mailer =~ /sendmail$/)
355             {
356             # have to add the To: and the Subject:
357 0           my $tfile = tmpnam();
358 0 0         open(TOUT, ">$tfile") || die "Can't open '$tfile' for writing.";
359              
360 0           print TOUT "To: $email\n";
361 0           print TOUT "Subject: $subject\n";
362 0           close(TOUT);
363              
364 0           $command = $mailer;
365 0           $command .= " -bm -i <$tfile <$mailfile";
366 0           system($command);
367 0           unlink($tfile);
368             }
369             elsif ($mailer =~ /^mail(x)?$/)
370             {
371 0           $command = $mailer;
372 0           $command .= " $email -s \"$subject\" < $mailfile";
373 0           system($command);
374             }
375             elsif ($mailer =~ /elm$/)
376             {
377 0           $command = $mailer;
378 0           $command .= " $email -s \"$subject\" < $mailfile";
379 0           system($command);
380             }
381             }
382              
383             } # send_the_actual_mail
384              
385             =head1 REQUIRES
386              
387             SQLite::Work
388             CGI
389              
390             Test::More
391              
392             =head1 INSTALLATION
393              
394             To install this module, run the following commands:
395              
396             perl Build.PL
397             ./Build
398             ./Build test
399             ./Build install
400              
401             Or, if you're on a platform (like DOS or Windows) that doesn't like the
402             "./" notation, you can do this:
403              
404             perl Build.PL
405             perl Build
406             perl Build test
407             perl Build install
408              
409             In order to install somewhere other than the default, such as
410             in a directory under your home directory, like "/home/fred/perl"
411             go
412              
413             perl Build.PL --install_base /home/fred/perl
414              
415             as the first step instead.
416              
417             This will install the files underneath /home/fred/perl.
418              
419             You will then need to make sure that you alter the PERL5LIB variable to
420             find the modules, and the PATH variable to find the script.
421              
422             Therefore you will need to change:
423             your path, to include /home/fred/perl/script (where the script will be)
424              
425             PATH=/home/fred/perl/script:${PATH}
426              
427             the PERL5LIB variable to add /home/fred/perl/lib
428              
429             PERL5LIB=/home/fred/perl/lib:${PERL5LIB}
430              
431              
432             =head1 SEE ALSO
433              
434             perl(1).
435              
436             =head1 BUGS
437              
438             Please report any bugs or feature requests to the author.
439              
440             =head1 AUTHOR
441              
442             Kathryn Andersen (RUBYKAT)
443             perlkat AT katspace dot com
444             http://www.katspace.com
445              
446             =head1 COPYRIGHT AND LICENCE
447              
448             Copyright (c) 2005 by Kathryn Andersen
449              
450             This program is free software; you can redistribute it and/or modify it
451             under the same terms as Perl itself.
452              
453              
454             =cut
455              
456             1; # End of SQLite::Work::CGI
457             __END__