← Index
NYTProf Performance Profile   « block view • line view • sub view »
For mentat.storage.mongo.pl
  Run on Tue Jun 24 10:04:38 2014
Reported on Tue Jun 24 10:05:08 2014

Filename/usr/local/lib/site_perl/Log/Writer/Email.pm
StatementsExecuted 29 statements in 1.40ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1113.54ms9.43msLog::Writer::Email::::BEGIN@70Log::Writer::Email::BEGIN@70
1111.89ms2.35msLog::Writer::Email::::BEGIN@71Log::Writer::Email::BEGIN@71
111877µs1.05msLog::Writer::Email::::BEGIN@79Log::Writer::Email::BEGIN@79
111624µs856µsLog::Writer::Email::::BEGIN@69Log::Writer::Email::BEGIN@69
11113µs16µsLog::Writer::Email::::BEGIN@2Log::Writer::Email::BEGIN@2
11112µs51µsLog::Writer::Email::::BEGIN@68Log::Writer::Email::BEGIN@68
11112µs12µsLog::Writer::Email::::BEGIN@82Log::Writer::Email::BEGIN@82
11110µs43µsLog::Writer::Email::::BEGIN@101Log::Writer::Email::BEGIN@101
1118µs31µsLog::Writer::Email::::BEGIN@67Log::Writer::Email::BEGIN@67
1118µs45µsLog::Writer::Email::::BEGIN@83Log::Writer::Email::BEGIN@83
1117µs46µsLog::Writer::Email::::BEGIN@66Log::Writer::Email::BEGIN@66
1116µs33µsLog::Writer::Email::::BEGIN@102Log::Writer::Email::BEGIN@102
1116µs11µsLog::Writer::Email::::BEGIN@3Log::Writer::Email::BEGIN@3
1112µs2µsLog::Writer::Email::::ENDLog::Writer::Email::END
0000s0sLog::Writer::Email::::_format_messageLog::Writer::Email::_format_message
0000s0sLog::Writer::Email::::_get_possible_flagsLog::Writer::Email::_get_possible_flags
0000s0sLog::Writer::Email::::_initLog::Writer::Email::_init
0000s0sLog::Writer::Email::::_setup_email_paramsLog::Writer::Email::_setup_email_params
0000s0sLog::Writer::Email::::writeLog::Writer::Email::write
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Log::Writer::Email;
2222µs219µs
# spent 16µs (13+3) within Log::Writer::Email::BEGIN@2 which was called: # once (13µs+3µs) by Log::Loger::BEGIN@129 at line 2
use strict;
# spent 16µs making 1 call to Log::Writer::Email::BEGIN@2 # spent 3µs making 1 call to strict::import
3247µs216µ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
use warnings;
# 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
13Log::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
21This 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
35Jan Mach
36Cesnet, z.s.p.o
37jan.mach@cesnet.cz
38http://www.cesnet.cz
39
40=head1 COPYRIGHT
41
42This program is free software; you can redistribute
43it and/or modify it under the same terms as Perl itself.
44
45The full text of the license can be found in the
46LICENSE file included with this module.
47
48
49=head1 SEE ALSO
50
51perl(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 ---------------------------------------------------------#
66230µs286µs
# spent 46µs (7+39) within Log::Writer::Email::BEGIN@66 which was called: # once (7µs+39µs) by Log::Loger::BEGIN@129 at line 66
use Carp;
# spent 46µs making 1 call to Log::Writer::Email::BEGIN@66 # spent 39µs making 1 call to Exporter::import
67222µs255µs
# spent 31µs (8+23) within Log::Writer::Email::BEGIN@67 which was called: # once (8µs+23µs) by Log::Loger::BEGIN@129 at line 67
use Scalar::Util 'blessed';
# spent 31µs making 1 call to Log::Writer::Email::BEGIN@67 # spent 23µs making 1 call to Exporter::import
68226µs290µs
# spent 51µs (12+39) within Log::Writer::Email::BEGIN@68 which was called: # once (12µs+39µs) by Log::Loger::BEGIN@129 at line 68
use File::Basename;
# spent 51µs making 1 call to Log::Writer::Email::BEGIN@68 # spent 39µs making 1 call to Exporter::import
692116µs2882µs
# spent 856µs (624+233) within Log::Writer::Email::BEGIN@69 which was called: # once (624µs+233µs) by Log::Loger::BEGIN@129 at line 69
use Sys::Hostname;
# spent 856µs making 1 call to Log::Writer::Email::BEGIN@69 # spent 26µs making 1 call to Exporter::import
702160µs29.52ms
# spent 9.43ms (3.54+5.89) within Log::Writer::Email::BEGIN@70 which was called: # once (3.54ms+5.89ms) by Log::Loger::BEGIN@129 at line 70
use Mail::Sendmail;
# spent 9.43ms making 1 call to Log::Writer::Email::BEGIN@70 # spent 97µs making 1 call to Exporter::import
712155µs22.41ms
# spent 2.35ms (1.89+466µs) within Log::Writer::Email::BEGIN@71 which was called: # once (1.89ms+466µs) by Log::Loger::BEGIN@129 at line 71
use Storable 'dclone';
# spent 2.35ms making 1 call to Log::Writer::Email::BEGIN@71 # spent 60µ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 ------------------------------------------------#
792130µs11.05ms
# spent 1.05ms (877µs+175µs) within Log::Writer::Email::BEGIN@79 which was called: # once (877µs+175µs) by Log::Loger::BEGIN@129 at line 79
use Log::Writer::Module;
# spent 1.05ms making 1 call to Log::Writer::Email::BEGIN@79
80
81#-- Module initializations ----------------------------------------------------#
82
# spent 12µs within Log::Writer::Email::BEGIN@82 which was called: # once (12µs+0s) by Log::Loger::BEGIN@129 at line 87
BEGIN {
83241µs283µs
# spent 45µs (8+38) within Log::Writer::Email::BEGIN@83 which was called: # once (8µs+38µs) by Log::Loger::BEGIN@129 at line 83
use vars qw($VERSION $DEVEL @ISA);
# spent 45µs making 1 call to Log::Writer::Email::BEGIN@83 # spent 38µs making 1 call to vars::import
8439µs $VERSION = '0.01';
85 $DEVEL = 0;
86 @ISA = ('Log::Writer::Module');
87140µs112µs}
# spent 12µs making 1 call to Log::Writer::Email::BEGIN@82
88
89#-- Module clean-up code (global destructor) ----------------------------------#
9012µs
# spent 2µs within Log::Writer::Email::END which was called: # once (2µs+0s) by main::RUNTIME at line 0 of mentat.storage.mongo.pl
END {
91
92}
93
94#*******************************************************************************
95#
96# CONSTANTS AND GLOBAL VARIABLES DEFINITION SECTION
97#
98#*******************************************************************************
99
100#-- Constants -----------------------------------------------------------------#
101228µs276µs
# spent 43µs (10+33) within Log::Writer::Email::BEGIN@101 which was called: # once (10µs+33µs) by Log::Loger::BEGIN@129 at line 101
use constant FLAG_REPLACE => 'REPLACE';
# spent 43µs making 1 call to Log::Writer::Email::BEGIN@101 # spent 33µs making 1 call to constant::import
1022572µs259µs
# spent 33µ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
use constant FLAG_TRACEBACK => 'TRACEBACK';
# spent 33µ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
128sub 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
161sub _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
182sub _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
205sub _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
232sub _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
25512µs1;