Filename | /usr/local/lib/site_perl/Log/Writer/Email.pm |
Statements | Executed 29 statements in 1.31ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 3.30ms | 8.95ms | BEGIN@70 | Log::Writer::Email::
1 | 1 | 1 | 1.81ms | 2.21ms | BEGIN@71 | Log::Writer::Email::
1 | 1 | 1 | 845µs | 1.02ms | BEGIN@79 | Log::Writer::Email::
1 | 1 | 1 | 611µs | 828µs | BEGIN@69 | Log::Writer::Email::
1 | 1 | 1 | 12µs | 15µs | BEGIN@2 | Log::Writer::Email::
1 | 1 | 1 | 10µs | 46µs | BEGIN@68 | Log::Writer::Email::
1 | 1 | 1 | 9µs | 41µs | BEGIN@101 | Log::Writer::Email::
1 | 1 | 1 | 9µs | 9µs | BEGIN@82 | Log::Writer::Email::
1 | 1 | 1 | 7µs | 31µs | BEGIN@67 | Log::Writer::Email::
1 | 1 | 1 | 7µs | 45µs | BEGIN@83 | Log::Writer::Email::
1 | 1 | 1 | 7µs | 43µs | BEGIN@66 | Log::Writer::Email::
1 | 1 | 1 | 6µs | 11µs | BEGIN@3 | Log::Writer::Email::
1 | 1 | 1 | 6µs | 32µs | BEGIN@102 | Log::Writer::Email::
1 | 1 | 1 | 3µs | 3µs | END | Log::Writer::Email::
0 | 0 | 0 | 0s | 0s | _format_message | Log::Writer::Email::
0 | 0 | 0 | 0s | 0s | _get_possible_flags | Log::Writer::Email::
0 | 0 | 0 | 0s | 0s | _init | Log::Writer::Email::
0 | 0 | 0 | 0s | 0s | _setup_email_params | Log::Writer::Email::
0 | 0 | 0 | 0s | 0s | write | Log::Writer::Email::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Log::Writer::Email; | ||||
2 | 2 | 21µs | 2 | 18µs | # spent 15µs (12+3) within Log::Writer::Email::BEGIN@2 which was called:
# once (12µs+3µs) by Log::Loger::BEGIN@129 at line 2 # spent 15µs making 1 call to Log::Writer::Email::BEGIN@2
# spent 3µs making 1 call to strict::import |
3 | 2 | 51µs | 2 | 16µs | # spent 11µs (6+5) within Log::Writer::Email::BEGIN@3 which was called:
# once (6µs+5µs) by Log::Loger::BEGIN@129 at line 3 # spent 11µs making 1 call to Log::Writer::Email::BEGIN@3
# spent 5µs making 1 call to warnings::import |
4 | |||||
5 | #******************************************************************************* | ||||
6 | # | ||||
7 | # DOCUMENTATION SECTION | ||||
8 | # | ||||
9 | #******************************************************************************* | ||||
10 | |||||
11 | =head1 NAME | ||||
12 | |||||
13 | Log::Writer::Email - Log writer capable of sending messages by email | ||||
14 | |||||
15 | =head1 SYNOPSIS | ||||
16 | |||||
17 | use Log::Writer::Email; | ||||
18 | |||||
19 | =head1 DESCRIPTION | ||||
20 | |||||
21 | This writer writes given messages to the given IO::Handle. | ||||
22 | |||||
23 | =head1 USAGE | ||||
24 | |||||
25 | =head1 BUGS | ||||
26 | |||||
27 | =head1 FLAGS | ||||
28 | |||||
29 | rep r REPLACE_SOURCE | ||||
30 | ser s SERIALIZE | ||||
31 | tra t TRACEBACK | ||||
32 | |||||
33 | =head1 AUTHOR | ||||
34 | |||||
35 | Jan Mach | ||||
36 | Cesnet, z.s.p.o | ||||
37 | jan.mach@cesnet.cz | ||||
38 | http://www.cesnet.cz | ||||
39 | |||||
40 | =head1 COPYRIGHT | ||||
41 | |||||
42 | This program is free software; you can redistribute | ||||
43 | it and/or modify it under the same terms as Perl itself. | ||||
44 | |||||
45 | The full text of the license can be found in the | ||||
46 | LICENSE file included with this module. | ||||
47 | |||||
48 | |||||
49 | =head1 SEE ALSO | ||||
50 | |||||
51 | perl(1). | ||||
52 | |||||
53 | =head1 FUNCTION REFERENCE | ||||
54 | |||||
55 | =over 4 | ||||
56 | |||||
57 | =cut | ||||
58 | |||||
59 | #******************************************************************************* | ||||
60 | # | ||||
61 | # INITIALIZATION AND CLEANUP SECTION | ||||
62 | # | ||||
63 | #******************************************************************************* | ||||
64 | |||||
65 | #-- Perl core modules ---------------------------------------------------------# | ||||
66 | 2 | 28µs | 2 | 79µs | # spent 43µs (7+36) within Log::Writer::Email::BEGIN@66 which was called:
# once (7µs+36µs) by Log::Loger::BEGIN@129 at line 66 # spent 43µs making 1 call to Log::Writer::Email::BEGIN@66
# spent 36µs making 1 call to Exporter::import |
67 | 2 | 22µs | 2 | 55µs | # spent 31µs (7+24) within Log::Writer::Email::BEGIN@67 which was called:
# once (7µs+24µs) by Log::Loger::BEGIN@129 at line 67 # spent 31µs making 1 call to Log::Writer::Email::BEGIN@67
# spent 24µs making 1 call to Exporter::import |
68 | 2 | 26µs | 2 | 82µs | # spent 46µs (10+36) within Log::Writer::Email::BEGIN@68 which was called:
# once (10µs+36µs) by Log::Loger::BEGIN@129 at line 68 # spent 46µs making 1 call to Log::Writer::Email::BEGIN@68
# spent 36µs making 1 call to Exporter::import |
69 | 2 | 112µs | 2 | 853µs | # spent 828µs (611+218) within Log::Writer::Email::BEGIN@69 which was called:
# once (611µs+218µs) by Log::Loger::BEGIN@129 at line 69 # spent 828µs making 1 call to Log::Writer::Email::BEGIN@69
# spent 25µs making 1 call to Exporter::import |
70 | 2 | 143µs | 2 | 9.03ms | # spent 8.95ms (3.30+5.65) within Log::Writer::Email::BEGIN@70 which was called:
# once (3.30ms+5.65ms) by Log::Loger::BEGIN@129 at line 70 # spent 8.95ms making 1 call to Log::Writer::Email::BEGIN@70
# spent 77µs making 1 call to Exporter::import |
71 | 2 | 144µs | 2 | 2.27ms | # spent 2.21ms (1.81+399µs) within Log::Writer::Email::BEGIN@71 which was called:
# once (1.81ms+399µs) by Log::Loger::BEGIN@129 at line 71 # spent 2.21ms making 1 call to Log::Writer::Email::BEGIN@71
# spent 54µs making 1 call to Exporter::import |
72 | |||||
73 | #use Data::Dumper; #-+-> DEVEL ONLY <-+-# | ||||
74 | #use Smart::Comments; #-+-> DEVEL ONLY <-+-# | ||||
75 | |||||
76 | #-- Perl CPAN modules ---------------------------------------------------------# | ||||
77 | |||||
78 | #-- Custom application modules ------------------------------------------------# | ||||
79 | 2 | 114µs | 1 | 1.02ms | # spent 1.02ms (845µs+173µs) within Log::Writer::Email::BEGIN@79 which was called:
# once (845µs+173µs) by Log::Loger::BEGIN@129 at line 79 # spent 1.02ms making 1 call to Log::Writer::Email::BEGIN@79 |
80 | |||||
81 | #-- Module initializations ----------------------------------------------------# | ||||
82 | # spent 9µs within Log::Writer::Email::BEGIN@82 which was called:
# once (9µs+0s) by Log::Loger::BEGIN@129 at line 87 | ||||
83 | 2 | 36µs | 2 | 83µs | # spent 45µs (7+38) within Log::Writer::Email::BEGIN@83 which was called:
# once (7µs+38µs) by Log::Loger::BEGIN@129 at line 83 # spent 45µs making 1 call to Log::Writer::Email::BEGIN@83
# spent 38µs making 1 call to vars::import |
84 | 1 | 500ns | $VERSION = '0.01'; | ||
85 | 1 | 200ns | $DEVEL = 0; | ||
86 | 1 | 8µs | @ISA = ('Log::Writer::Module'); | ||
87 | 1 | 47µs | 1 | 9µs | } # spent 9µs making 1 call to Log::Writer::Email::BEGIN@82 |
88 | |||||
89 | #-- Module clean-up code (global destructor) ----------------------------------# | ||||
90 | 1 | 2µs | # spent 3µs within Log::Writer::Email::END which was called:
# once (3µs+0s) by main::RUNTIME at line 0 of mentat.storage.mongo.pl | ||
91 | |||||
92 | } | ||||
93 | |||||
94 | #******************************************************************************* | ||||
95 | # | ||||
96 | # CONSTANTS AND GLOBAL VARIABLES DEFINITION SECTION | ||||
97 | # | ||||
98 | #******************************************************************************* | ||||
99 | |||||
100 | #-- Constants -----------------------------------------------------------------# | ||||
101 | 2 | 29µs | 2 | 74µs | # spent 41µs (9+32) within Log::Writer::Email::BEGIN@101 which was called:
# once (9µs+32µs) by Log::Loger::BEGIN@129 at line 101 # spent 41µs making 1 call to Log::Writer::Email::BEGIN@101
# spent 32µs making 1 call to constant::import |
102 | 2 | 522µs | 2 | 58µs | # spent 32µs (6+26) within Log::Writer::Email::BEGIN@102 which was called:
# once (6µs+26µs) by Log::Loger::BEGIN@129 at line 102 # spent 32µs making 1 call to Log::Writer::Email::BEGIN@102
# spent 26µs making 1 call to constant::import |
103 | |||||
104 | #-- Static public class variables (our) ---------------------------------------# | ||||
105 | |||||
106 | #-- Static protected class variables (my) -------------------------------------# | ||||
107 | |||||
108 | #******************************************************************************* | ||||
109 | # | ||||
110 | # IMPLEMENTATION SECTION | ||||
111 | # | ||||
112 | #******************************************************************************* | ||||
113 | |||||
114 | =item write($$$;$) [PUBLIC] | ||||
115 | |||||
116 | Usage : $writer->write($source, $severity, $message, $subject); | ||||
117 | Purpose : Write given message to the destination | ||||
118 | Arguments : STRING $source - Name of the source of the message | ||||
119 | ENUM $severity - Severity in integer or string format (see Log::Core::Essentials for permited values) | ||||
120 | STRING $message - Log message | ||||
121 | Returns : $self | ||||
122 | Throws : Croaks, if not implemented in descendant classes | ||||
123 | Comments : ABSTRACT method, must be implemented in descendant classes | ||||
124 | See Also : Log::Core::Essentials module for permited severity values | ||||
125 | |||||
126 | =cut | ||||
127 | |||||
128 | sub write($$$;$) | ||||
129 | { | ||||
130 | my $self = shift; | ||||
131 | confess "Instance method not invoked on object instance" unless blessed($self); | ||||
132 | my ($source, $severity, $message, $subject) = @_; | ||||
133 | confess"Invalid arguments" unless (defined($source) and defined($severity) and defined($message)); | ||||
134 | |||||
135 | my $email = dclone($self->{EMAIL_PARAMS}); | ||||
136 | |||||
137 | $email->{'Subject'} = "[".uc($severity)."] ".$email->{'Subject'}; | ||||
138 | $email->{'Subject'} = $subject if $subject; | ||||
139 | $email->{'Message'} = $self->_format_message($source, $severity, $message); | ||||
140 | |||||
141 | my $success = sendmail(%$email); | ||||
142 | die ("Unable to mail log: " . $Mail::Sendmail::error) unless ($success); | ||||
143 | |||||
144 | return $self; | ||||
145 | } | ||||
146 | |||||
147 | #------------------------------------------------------------------------------- | ||||
148 | # Private interface | ||||
149 | #------------------------------------------------------------------------------- | ||||
150 | |||||
151 | # _init [PROTECTED] | ||||
152 | # | ||||
153 | # Usage : return $self->_init(@_); | ||||
154 | # Purpose : Initialize the new Log::Writer::String instance | ||||
155 | # Arguments : SCALAR $buffer - string buffer variable | ||||
156 | # (for other _init arguments see Log::Writer::Handle class) | ||||
157 | # Returns : Log::Writer::Module reference | ||||
158 | # Throws : Croaks, if invoked on class, or if given invalid arguments | ||||
159 | # See also : Log::Writer::Handle module | ||||
160 | |||||
161 | sub _init | ||||
162 | { | ||||
163 | my $self = shift; | ||||
164 | confess "Instance method not invoked on object instance" unless blessed($self); | ||||
165 | my ($email_params, $flags) = @_; | ||||
166 | confess "Invalid arguments" unless (defined($email_params)); | ||||
167 | |||||
168 | $self->_setup_email_params($email_params); | ||||
169 | $self->_setup_flags($flags); | ||||
170 | |||||
171 | return $self; | ||||
172 | } | ||||
173 | |||||
174 | # _get_possible_flags() [PROTECTED] | ||||
175 | # | ||||
176 | # Usage : my $flags = $self->_get_possible_flags(); | ||||
177 | # Purpose : Get hash structure describing all possible flags | ||||
178 | # Arguments : None | ||||
179 | # Returns : HASH REFERENCE $flags | ||||
180 | # Throws : Croaks, if invoked on class | ||||
181 | |||||
182 | sub _get_possible_flags() | ||||
183 | { | ||||
184 | my $self = shift; | ||||
185 | confess "Instance method not invoked on object instance" unless blessed($self); | ||||
186 | |||||
187 | return { | ||||
188 | 'r' => FLAG_REPLACE(), | ||||
189 | 'rep' => FLAG_REPLACE(), | ||||
190 | 'replace' => FLAG_REPLACE(), | ||||
191 | 't' => FLAG_TRACEBACK(), | ||||
192 | 'tra' => FLAG_TRACEBACK(), | ||||
193 | 'traceback' => FLAG_TRACEBACK(), | ||||
194 | }; | ||||
195 | } | ||||
196 | |||||
197 | # _setup_email_params($) [PROTECTED] | ||||
198 | |||||
199 | # Usage : $self->_setup_email_params($email); | ||||
200 | # Purpose : | ||||
201 | # Arguments : | ||||
202 | # Returns : $self | ||||
203 | # Throws : Croaks, if invoked on class, or if given invalid arguments | ||||
204 | |||||
205 | sub _setup_email_params($) | ||||
206 | { | ||||
207 | my $self = shift; | ||||
208 | confess "Instance method not invoked on object instance" unless blessed($self); | ||||
209 | my ($email_params,) = @_; | ||||
210 | confess "Email parameters must be given as argument" unless $email_params; | ||||
211 | confess "Email parameters must be given as HASH reference" unless ref $email_params eq 'HASH'; | ||||
212 | confess "Invalid email parameters: missing source email address" unless $email_params->{'From'}; | ||||
213 | confess "Invalid email parameters: missing destination email address" unless $email_params->{'To'}; | ||||
214 | confess "Invalid email parameters: missing email subject" unless $email_params->{'Subject'}; | ||||
215 | |||||
216 | $self->{EMAIL_PARAMS} = $email_params; | ||||
217 | $self->{EMAIL_PARAMS}->{'Content-type'} = 'text/plain; charset="utf-8"' unless $self->{EMAIL_PARAMS}->{'Content-type'}; | ||||
218 | $self->{EMAIL_PARAMS}->{'Reply-To'} = $self->{EMAIL_PARAMS}->{'From'} unless $self->{EMAIL_PARAMS}->{'Reply-To'}; | ||||
219 | return $self; | ||||
220 | } | ||||
221 | |||||
222 | # _format_message($$$) [PROTECTED] | ||||
223 | # | ||||
224 | # Usage : my $message = $self->_format_message($source, $severity, $message) | ||||
225 | # Purpose : Format log message from the given source, severity and message body | ||||
226 | # Arguments : STRING $source - Name of the source of the message | ||||
227 | # ENUM $severity - Severity in integer or string format (see Log::Core::Essentials for permited values) | ||||
228 | # STRING $message - Message | ||||
229 | # Returns : STRING formatted message | ||||
230 | # Throws : Croaks, if invoked on class | ||||
231 | |||||
232 | sub _format_message($$$) | ||||
233 | { | ||||
234 | my $self = shift; | ||||
235 | confess "Instance method not invoked on object instance" unless blessed($self); | ||||
236 | my ($source, $severity, $message) = @_; | ||||
237 | |||||
238 | my $date = localtime; | ||||
239 | my $hostname = hostname; | ||||
240 | $source = basename($0) if ($self->_flag(FLAG_REPLACE())); | ||||
241 | #$date = strftime($self->{DATE_FORMAT}, localtime) if ($self->{DATE_FORMAT}); | ||||
242 | |||||
243 | my $result = "$date $hostname ${source}[$$] $severity: $message\n"; | ||||
244 | $result .= "\nBacktrace:\n * " . join("\n * ", $self->_traceback()) . "\n" if $self->_flag(FLAG_TRACEBACK()); | ||||
245 | $result .= "\nNOTE: This email was automatically generated, please do not reply to it!"; | ||||
246 | return $result; | ||||
247 | } | ||||
248 | |||||
249 | =pod | ||||
250 | |||||
251 | =back | ||||
252 | |||||
253 | =cut | ||||
254 | |||||
255 | 1 | 2µs | 1; |