File Coverage

blib/lib/Fsdb/Filter/dbformmail.pm
Criterion Covered Total %
statement 15 94 15.9
branch 0 42 0.0
condition 0 3 0.0
subroutine 5 15 33.3
pod 6 6 100.0
total 26 160 16.2


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             #
4             # dbformmail.pm
5             # Copyright (C) 1997-2015 by John Heidemann
6             # $Id: c8aa2b24886b06b214823a1d8477f09388c822fc $
7             #
8             # This program is distributed under terms of the GNU general
9             # public license, version 2. See the file COPYING
10             # in $dblibdir for details.
11             #
12              
13             package Fsdb::Filter::dbformmail;
14              
15             =head1 NAME
16              
17             dbformmail - write a shell script that will send e-mail to many people
18              
19             =head1 SYNOPSIS
20              
21             dbformmail [-m MECHANISM] format_file.txt
22              
23             =head1 DESCRIPTION
24              
25             Read a ``form mail'' message from the file FORMAT_FILE.TXT,
26             filling in underscore-preceded column-names with data.
27             Output a shell script which will send each message through some
28             mail transport MECHANISM.
29              
30             Do not use this program for evil or I will have to come over
31             and have words with you.
32              
33             Note that this program does NOT actually SEND the mail.
34             It writes a shell script that will send the mail for you.
35             I recommend you save it to a file, check it (one last time!),
36             then run it with sh.
37              
38             Unlike most Fsdb programs, this program does I output a FSDB file.
39              
40             =head1 OPTIONS
41              
42             =over 4
43              
44             =item B<-m MECHANISM>
45              
46             Select the mail-sending mechanism.
47             Choose "Mail" or "sendmail".
48             Defaults to "Mail".
49              
50             =back
51              
52             =for comment
53             begin_standard_fsdb_options
54              
55             This module also supports the standard fsdb options:
56              
57             =over 4
58              
59             =item B<-d>
60              
61             Enable debugging output.
62              
63             =item B<-i> or B<--input> InputSource
64              
65             Read from InputSource, typically a file name, or C<-> for standard input,
66             or (if in Perl) a IO::Handle, Fsdb::IO or Fsdb::BoundedQueue objects.
67              
68             =item B<-o> or B<--output> OutputDestination
69              
70             Write to OutputDestination, typically a file name, or C<-> for standard output,
71             or (if in Perl) a IO::Handle, Fsdb::IO or Fsdb::BoundedQueue objects.
72              
73             =item B<--autorun> or B<--noautorun>
74              
75             By default, programs process automatically,
76             but Fsdb::Filter objects in Perl do not run until you invoke
77             the run() method.
78             The C<--(no)autorun> option controls that behavior within Perl.
79              
80             =item B<--help>
81              
82             Show help.
83              
84             =item B<--man>
85              
86             Show full manual.
87              
88             =back
89              
90             =for comment
91             end_standard_fsdb_options
92              
93              
94             =head1 SAMPLE USAGE
95              
96             =head2 Input:
97              
98             #fsdb account passwd uid gid fullname homedir shell
99             johnh * 2274 134 John_Heidemann /home/johnh /bin/bash
100             greg * 2275 134 Greg_Johnson /home/greg /bin/bash
101             root * 0 0 Root /root /bin/bash
102             # this is a simple database
103              
104             Sample form (in the file form.txt):
105              
106             To: _account
107             From: the sysadmin
108             Subject: time to change your password
109              
110             Please change your password regularly.
111             Doesn't this message make you feel safer?
112              
113              
114             =head2 Command:
115              
116             cat DATA/passwd.fsdb | dbformmail form.txt >outgoing.sh
117              
118             =head2 Output (in outgoing.sh):
119              
120             #!/bin/sh
121             sendmail 'johnh' <<'END'
122             To: johnh
123             From: the sysadmin
124             Subject: time to change your password
125            
126             Please change your password regularly.
127             Doesn't this message make you feel safer?
128              
129             END
130             sendmail 'greg' <<'END'
131             (etc.)
132              
133             And to send the mail, run
134              
135             sh outgoing.sh
136              
137             =head1 SEE ALSO
138              
139             L.
140              
141              
142             =head1 CLASS FUNCTIONS
143              
144             =cut
145              
146             @ISA = qw(Fsdb::Filter);
147             $VERSION = 2.0;
148              
149 1     1   7267 use strict;
  1         2  
  1         29  
150 1     1   4 use Carp;
  1         2  
  1         56  
151 1     1   5 use Pod::Usage;
  1         2  
  1         82  
152              
153 1     1   6 use Fsdb::Filter;
  1         2  
  1         18  
154 1     1   4 use Fsdb::IO::Reader;
  1         2  
  1         994  
155              
156              
157             =head2 new
158              
159             $filter = new Fsdb::Filter::dbformmail(@arguments);
160              
161             Create a new dbformmail object, taking command-line arguments.
162              
163             =cut
164              
165             sub new ($@) {
166 0     0 1   my $class = shift @_;
167 0           my $self = $class->SUPER::new(@_);
168 0           bless $self, $class;
169 0           $self->set_defaults;
170 0           $self->parse_options(@_);
171 0           $self->SUPER::post_new();
172 0           return $self;
173             }
174              
175              
176             =head2 set_defaults
177              
178             $filter->set_defaults();
179              
180             Internal: set up defaults.
181              
182             =cut
183              
184             sub set_defaults ($) {
185 0     0 1   my($self) = @_;
186 0           $self->SUPER::set_defaults();
187 0           $self->{_mechanism} = 'Mail';
188 0           $self->{_format_file} = undef;
189             }
190              
191             =head2 parse_options
192              
193             $filter->parse_options(@ARGV);
194              
195             Internal: parse command-line arguments.
196              
197             =cut
198              
199             sub parse_options ($@) {
200 0     0 1   my $self = shift @_;
201              
202 0           my(@argv) = @_;
203             $self->get_options(
204             \@argv,
205 0     0     'help|?' => sub { pod2usage(1); },
206 0     0     'man' => sub { pod2usage(-verbose => 2); },
207             'autorun!' => \$self->{_autorun},
208             'close!' => \$self->{_close},
209             'd|debug+' => \$self->{_debug},
210 0     0     'i|input=s' => sub { $self->parse_io_option('input', @_); },
211             'log!' => \$self->{_logprog},
212             'm|mechanism=s' => \$self->{_mechanism},
213 0     0     'o|output=s' => sub { $self->parse_io_option('output', @_); },
214 0 0         ) or pod2usage(2);
215 0 0         if ($#argv >= 0) {
216             croak $self->{_prog} . ": format file already defined as " . $self->{_format_file} . "\n"
217 0 0         if (defined($self->{_format_file}));
218 0           $self->{_format_file} = $argv[0];
219             };
220             }
221              
222             =head2 setup
223              
224             $filter->setup();
225              
226             Internal: setup, parse headers.
227              
228             =cut
229              
230             sub setup ($) {
231 0     0 1   my($self) = @_;
232              
233             croak($self->{_prog} . ": unknown mail mechanism $self->{_mechanism}.\n")
234 0 0 0       if (!($self->{_mechanism} eq 'Mail' || $self->{_mechanism} eq 'sendmail'));
235             croak($self->{_prog} . ": no format file specified.\n")
236 0 0         if (!defined($self->{_format_file}));
237              
238 0           $self->finish_io_option('input', -comment_handler => $self->create_delay_comments_sub);
239             }
240              
241             =head2 run
242              
243             $filter->run();
244              
245             Internal: run over each rows.
246              
247             =cut
248             sub run ($) {
249 0     0 1   my($self) = @_;
250              
251             #
252             # Read the form.
253             #
254             open(FORM, "<" . $self->{_format_file})
255 0 0         or croak $self->{_prog} . ": cannot open " . $self->{_format_file} . ".\n";
256 0           my @form = ();
257 0           while (
) {
258 0           s/\@/\\\@/g; # quote @'s
259 0           push(@form, $_);
260             };
261 0           close FORM;
262              
263 0 0         croak ($self->{_prog} . ": no To: line in form.\n")
264             if (!grep(/^To:/i, @form));
265              
266             # find an end-of-form marker
267 0           my($end_of_form_marker) = undef;
268 0           foreach my $try (qw(END END2378END END_99243_END)) {
269 0           my(@hits) = grep(/^$try$/, @form);
270 0 0         if ($#hits == -1) {
271 0           $end_of_form_marker = $try;
272 0           last;
273             };
274             };
275 0 0         croak $self->{_prog} . ": cannot find an end-of-form marker that's not already in the data.\n" if (!defined($end_of_form_marker));
276              
277             #
278             # Generate the code.
279             #
280 0           my($code) = $self->{_in}->codify("<<$end_of_form_marker;\n" . join("", @form) . "$end_of_form_marker\n");
281 0 0         print $code if ($self->{_debug});
282              
283             #
284             # Do it.
285             #
286 0           my $fref;
287 0           my $read_fastpath_sub = $self->{_in}->fastpath_sub();
288 0           print "#!/bin/sh\n";
289              
290 0           while ($fref = &$read_fastpath_sub()) {
291 0           my $result = eval $code;
292 0 0         $@ && die ($self->{_prog} . ": internal eval error ``$@''.\n");
293              
294             # This is not a very elegant to extract the destination. :-<
295 0           my(@field_names) = qw(to cc subject);
296 0           my($field_regexp) = '(' . join("|", @field_names) . ')';
297 0           my(%fields);
298 0           my($in_body) = undef;
299 0           my $result_body = '';
300 0           foreach (split(/\n/, $result)) {
301 0 0         if ($in_body) {
302 0           $result_body .= "$_\n";
303 0           next;
304             };
305 0 0         if (/^\s*$/) {
306             # blank line terminates header
307 0           $in_body = 1;
308 0           next;
309             };
310 0 0         if (/^$field_regexp:\s*(.*)$/i) {
311 0           my($key, $value) = (lc($1), $2);
312             croak($self->{_prog} . ": duplicate fields not supported, field: $key.\n")
313 0 0         if (defined($fields{$key}));
314 0           $fields{$key} = $value;
315             };
316             };
317             croak($self->{_prog} . ": to missing.\n")
318 0 0         if (!defined($fields{'to'}));
319              
320             # Quote single quotes in $to.
321 0           foreach (keys %fields) {
322 0           $fields{$_} =~ s/\'/\'\\\'\'/g;
323             };
324              
325 0 0         if ($self->{_mechanism} eq 'sendmail') {
    0          
326 0           print "sendmail '" . $fields{"to"} . "' <<'$end_of_form_marker'\n$result\n$end_of_form_marker\n\n";
327             } elsif ($self->{_mechanism} eq 'Mail') {
328 0 0         my $cc_arg = (defined($fields{"cc"}) ? "-c '" . $fields{"cc"} . "' " : "");
329 0 0         my $subject_arg = (defined($fields{"subject"}) ? "-s '" . $fields{"subject"} . "' " : "");
330 0           print "Mail $subject_arg $cc_arg '" . $fields{"to"} . "' <<'$end_of_form_marker'\n$result_body\n$end_of_form_marker\n\n";
331             } else {
332 0           die $self->{_prog} . ": unknown mechanism " . $self->{_mechanism} . ".\n";
333             };
334             };
335             };
336              
337              
338             =head2 finish
339              
340             $filter->finish();
341              
342             Internal: write trailer, but no trailer for us.
343              
344             =cut
345             sub finish ($) {
346 0     0 1   my($self) = @_;
347              
348 0 0         if (defined($self->{_delay_comments})) {
349 0           foreach (@{$self->{_delay_comments}}) {
  0            
350 0           $_->flush(undef);
351             };
352             };
353 0           print "# " . $self->compute_program_log() . "\n";
354             }
355              
356             =head1 AUTHOR and COPYRIGHT
357              
358             Copyright (C) 1991-2015 by John Heidemann
359              
360             This program is distributed under terms of the GNU general
361             public license, version 2. See the file COPYING
362             with the distribution for details.
363              
364             =cut
365              
366             1;