File Coverage

blib/lib/App/MonM/Notifier/Channel/Command.pm
Criterion Covered Total %
statement 15 34 44.1
branch 0 10 0.0
condition 0 3 0.0
subroutine 5 6 83.3
pod 1 1 100.0
total 21 54 38.8


line stmt bran cond sub pod time code
1             package App::MonM::Notifier::Channel::Command; # $Id: Command.pm 60 2019-07-14 09:57:26Z abalama $
2 1     1   7 use strict;
  1         2  
  1         25  
3 1     1   5 use utf8;
  1         1  
  1         6  
4              
5             =encoding utf-8
6              
7             =head1 NAME
8              
9             App::MonM::Notifier::Channel::Command - monotifier command channel
10              
11             =head1 VERSION
12              
13             Version 1.01
14              
15             =head1 SYNOPSIS
16              
17            
18             Type Command
19              
20             # Real To and From
21             To testuser
22             From root
23              
24             # Options
25             #Encoding base64
26              
27            
28             X-Foo foo
29             X-Bar bar
30            
31              
32             Command "grep MIME > t.msg"
33              
34            
35              
36             =head1 DESCRIPTION
37              
38             This module provides command method that send the content
39             of the message to an external program
40              
41             =head2 DIRECTIVES
42              
43             =over 4
44              
45             =item B
46              
47             Defines full path to external program
48              
49             Default: none
50              
51             =item B
52              
53             Sender address or name
54              
55             =item B
56              
57             Recipient address or name
58              
59             =item B
60              
61             Defines type of channel. MUST BE set to "Command" value
62              
63             =back
64              
65             About other options (base) see L
66              
67             =head2 METHODS
68              
69             =over 4
70              
71             =item B
72              
73             For internal use only!
74              
75             =back
76              
77             =head1 EXAMPLE
78              
79             Script example:
80              
81             #!/usr/bin/perl -w
82             use strict;
83             use utf8;
84              
85             my @in;
86             while(<>) {
87             chomp;
88             push @in, $_;
89             }
90              
91             print join "\n", @in;
92              
93             =head1 HISTORY
94              
95             See C file
96              
97             =head1 TO DO
98              
99             See C file
100              
101             =head1 SEE ALSO
102              
103             L, L
104              
105             =head1 AUTHOR
106              
107             Serż Minus (Sergey Lepenkov) L Eabalama@cpan.orgE
108              
109             =head1 COPYRIGHT
110              
111             Copyright (C) 1998-2019 D&D Corporation. All Rights Reserved
112              
113             =head1 LICENSE
114              
115             This program is free software; you can redistribute it and/or
116             modify it under the same terms as Perl itself.
117              
118             See C file and L
119              
120             =cut
121              
122 1     1   35 use vars qw/$VERSION/;
  1         2  
  1         54  
123             $VERSION = '1.01';
124              
125 1     1   5 use CTK::Util qw/ execute /;
  1         2  
  1         50  
126 1     1   6 use CTK::ConfGenUtil;
  1         2  
  1         215  
127              
128             sub process {
129 0     0 1   my $self = shift;
130 0           my $type = $self->type;
131 0 0         return $self->maybe::next::method() unless $type eq 'command';
132 0           my $message = $self->message;
133 0 0         unless ($message) {
134 0           $self->error("Incorrect Email::MIME object");
135 0           return;
136             }
137              
138 0   0       my $command = value($self->config, "command") || value($self->config, "script");
139 0 0         unless ($command) {
140 0           $self->error("Command string incorrect");
141 0           return;
142             }
143              
144 0           my $data = $message->as_string;
145              
146             # Run command
147 0           my $exe_err = '';
148 0           my $exe_out = execute($command, $data, \$exe_err);
149 0           my $stt = ($? >> 8);
150 0 0         my $exe_stt = $stt ? 0 : 1;
151 0           $self->status($exe_stt);
152 0 0         $self->error(sprintf("Exitval=%d; Error=%s", $stt, $exe_err)) unless $exe_stt;
153              
154 0           return;
155             }
156              
157             1;
158              
159             __END__