← Index
NYTProf Performance Profile   « block view • line view • sub view »
For mentat.storage.mongo.pl
  Run on Tue Jun 24 09:58:41 2014
Reported on Tue Jun 24 09:59:14 2014

Filename/usr/local/lib/site_perl/Log/Writer/Email.pm
StatementsExecuted 29 statements in 1.31ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1113.30ms8.95msLog::Writer::Email::::BEGIN@70Log::Writer::Email::BEGIN@70
1111.81ms2.21msLog::Writer::Email::::BEGIN@71Log::Writer::Email::BEGIN@71
111845µs1.02msLog::Writer::Email::::BEGIN@79Log::Writer::Email::BEGIN@79
111611µs828µsLog::Writer::Email::::BEGIN@69Log::Writer::Email::BEGIN@69
11112µs15µsLog::Writer::Email::::BEGIN@2Log::Writer::Email::BEGIN@2
11110µs46µsLog::Writer::Email::::BEGIN@68Log::Writer::Email::BEGIN@68
1119µs41µsLog::Writer::Email::::BEGIN@101Log::Writer::Email::BEGIN@101
1119µs9µsLog::Writer::Email::::BEGIN@82Log::Writer::Email::BEGIN@82
1117µs31µsLog::Writer::Email::::BEGIN@67Log::Writer::Email::BEGIN@67
1117µs45µsLog::Writer::Email::::BEGIN@83Log::Writer::Email::BEGIN@83
1117µs43µsLog::Writer::Email::::BEGIN@66Log::Writer::Email::BEGIN@66
1116µs11µsLog::Writer::Email::::BEGIN@3Log::Writer::Email::BEGIN@3
1116µs32µsLog::Writer::Email::::BEGIN@102Log::Writer::Email::BEGIN@102
1113µs3µ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;
2221µs218µ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
use strict;
# spent 15µs making 1 call to Log::Writer::Email::BEGIN@2 # spent 3µs making 1 call to strict::import
3251µ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 ---------------------------------------------------------#
66228µs279µ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
use Carp;
# spent 43µs making 1 call to Log::Writer::Email::BEGIN@66 # spent 36µs making 1 call to Exporter::import
67222µs255µ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
use Scalar::Util 'blessed';
# spent 31µs making 1 call to Log::Writer::Email::BEGIN@67 # spent 24µs making 1 call to Exporter::import
68226µs282µ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
use File::Basename;
# spent 46µs making 1 call to Log::Writer::Email::BEGIN@68 # spent 36µs making 1 call to Exporter::import
692112µs2853µ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
use Sys::Hostname;
# spent 828µs making 1 call to Log::Writer::Email::BEGIN@69 # spent 25µs making 1 call to Exporter::import
702143µs29.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
use Mail::Sendmail;
# spent 8.95ms making 1 call to Log::Writer::Email::BEGIN@70 # spent 77µs making 1 call to Exporter::import
712144µs22.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
use Storable 'dclone';
# 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 ------------------------------------------------#
792114µs11.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
use Log::Writer::Module;
# 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
BEGIN {
83236µs283µ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
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');
87147µs19µs}
# spent 9µs making 1 call to Log::Writer::Email::BEGIN@82
88
89#-- Module clean-up code (global destructor) ----------------------------------#
9012µ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
END {
91
92}
93
94#*******************************************************************************
95#
96# CONSTANTS AND GLOBAL VARIABLES DEFINITION SECTION
97#
98#*******************************************************************************
99
100#-- Constants -----------------------------------------------------------------#
101229µs274µ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
use constant FLAG_REPLACE => 'REPLACE';
# spent 41µs making 1 call to Log::Writer::Email::BEGIN@101 # spent 32µs making 1 call to constant::import
1022522µs258µ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
use constant FLAG_TRACEBACK => 'TRACEBACK';
# 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
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;