← Index
NYTProf Performance Profile   « block view • line view • sub view »
For xt/tapper-mcp-scheduler-with-db-longrun.t
  Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:23:06 2012

Filename/2home/ss5/local/projects/Tapper/src/Tapper-MCP/lib/Tapper/MCP/Net/TAP.pm
StatementsExecuted 17 statements in 1.05ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11194µs149µsTapper::MCP::Net::TAP::::BEGIN@3Tapper::MCP::Net::TAP::BEGIN@3
11111µs55µsTapper::MCP::Net::TAP::::BEGIN@3.13Tapper::MCP::Net::TAP::BEGIN@3.13
11111µs2.97msTapper::MCP::Net::TAP::::BEGIN@7Tapper::MCP::Net::TAP::BEGIN@7
11110µs26µsTapper::MCP::Net::TAP::::BEGIN@5Tapper::MCP::Net::TAP::BEGIN@5
1118µs13µsTapper::MCP::Net::TAP::::BEGIN@4Tapper::MCP::Net::TAP::BEGIN@4
0000s0sTapper::MCP::Net::TAP::::__ANON__[lib/Tapper/MCP/Net/TAP.pm:58]Tapper::MCP::Net::TAP::__ANON__[lib/Tapper/MCP/Net/TAP.pm:58]
0000s0sTapper::MCP::Net::TAP::::associated_hostnameTapper::MCP::Net::TAP::associated_hostname
0000s0sTapper::MCP::Net::TAP::::mcp_headerlinesTapper::MCP::Net::TAP::mcp_headerlines
0000s0sTapper::MCP::Net::TAP::::prc_headerlinesTapper::MCP::Net::TAP::prc_headerlines
0000s0sTapper::MCP::Net::TAP::::tap_report_awayTapper::MCP::Net::TAP::tap_report_away
0000s0sTapper::MCP::Net::TAP::::tap_report_createTapper::MCP::Net::TAP::tap_report_create
0000s0sTapper::MCP::Net::TAP::::tap_report_sendTapper::MCP::Net::TAP::tap_report_send
0000s0sTapper::MCP::Net::TAP::::upload_filesTapper::MCP::Net::TAP::upload_files
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Tapper::MCP::Net::TAP;
2
3699µs3248µs
# spent 55µs (11+44) within Tapper::MCP::Net::TAP::BEGIN@3.13 which was called: # once (11µs+44µs) by Tapper::MCP::Net::TAP::BEGIN@3 at line 3 # spent 149µs (94+55) within Tapper::MCP::Net::TAP::BEGIN@3 which was called: # once (94µs+55µs) by Module::Runtime::require_module at line 3
use 5.010;
# spent 149µs making 1 call to Tapper::MCP::Net::TAP::BEGIN@3 # spent 55µs making 1 call to Tapper::MCP::Net::TAP::BEGIN@3.13 # spent 44µs making 1 call to feature::import
4319µs217µs
# spent 13µs (8+4) within Tapper::MCP::Net::TAP::BEGIN@4 which was called: # once (8µs+4µs) by Module::Runtime::require_module at line 4
use strict;
# spent 13µs making 1 call to Tapper::MCP::Net::TAP::BEGIN@4 # spent 4µs making 1 call to strict::import
5319µs242µs
# spent 26µs (10+16) within Tapper::MCP::Net::TAP::BEGIN@5 which was called: # once (10µs+16µs) by Module::Runtime::require_module at line 5
use warnings;
# spent 26µs making 1 call to Tapper::MCP::Net::TAP::BEGIN@5 # spent 16µs making 1 call to warnings::import
6
73907µs25.92ms
# spent 2.97ms (11µs+2.96) within Tapper::MCP::Net::TAP::BEGIN@7 which was called: # once (11µs+2.96ms) by Module::Runtime::require_module at line 7
use Moose::Role;
# spent 2.97ms making 1 call to Tapper::MCP::Net::TAP::BEGIN@7 # spent 2.96ms making 1 call to Moose::Exporter::__ANON__[Moose/Exporter.pm:492]
8
912µs1218µsrequires 'testrun', 'cfg', 'log';
# spent 218µs making 1 call to Moose::Role::requires
10
11=head2 prc_headerlines
12
13Generate header lines for the TAP report containing the results of the
14PRC with the number provided as argument.
15
16=cut
17
18sub prc_headerlines {
19 my ($self, $prc_number) = @_;
20
21 my $hostname = $self->associated_hostname;
22
23 my $testrun_id = $self->testrun->id;
24 my $suitename = ($prc_number > 0) ? "Guest-Overview-$prc_number" : "PRC0-Overview";
25
26 my $headerlines = [
27 "# Tapper-reportgroup-testrun: $testrun_id",
28 "# Tapper-suite-name: $suitename",
29 "# Tapper-suite-version: $Tapper::MCP::VERSION",
30 "# Tapper-machine-name: $hostname",
31 "# Tapper-section: prc-state-details",
32 "# Tapper-reportgroup-primary: 0",
33 ];
34 return $headerlines;
35}
36
37
38=head2 tap_report_away
39
40Actually send the tap report to receiver.
41
42@param string - report to be sent
43
44@return success - (0, report id)
45@return error - (1, error string)
46
47=cut
48
49sub tap_report_away
50{
51 my ($self, $tap) = @_;
52 my $reportid;
53 if (my $sock = IO::Socket::INET->new(PeerAddr => $self->cfg->{report_server},
54 PeerPort => $self->cfg->{report_port},
55 Proto => 'tcp')) {
56 eval{
57 my $timeout = 100;
58 local $SIG{ALRM}=sub{die("timeout for sending tap report ($timeout seconds) reached.");};
59 alarm($timeout);
60 ($reportid) = <$sock> =~m/(\d+)$/g;
61 $sock->print($tap);
62 };
63 alarm(0);
64 $self->log->error($@) if $@;
65 close $sock;
66 } else {
67 return(1,"Can not connect to report server: $!");
68 }
69 return (0,$reportid);
70
71}
72
73=head2 tap_report_send
74
75Send information of current test run status to report framework using TAP
76protocol.
77
78@param array - report array
79@param array - header lines
80
81@return success - (0, report id)
82@return error - (1, error string)
83
84=cut
85
86sub tap_report_send
87{
88 my ($self, $reportlines, $headerlines) = @_;
89 my $tap = $self->tap_report_create($reportlines, $headerlines);
90 $self->log->debug($tap);
91 return $self->tap_report_away($tap);
92}
93
94=head2 associated_hostname
95
96Return the name of the host associated to this testrun or 'No hostname
97set'.
98
99@return string - hostname
100
101=cut
102
103sub associated_hostname
104{
105 my ($self) = @_;
106 my $hostname;
107
108 eval {
109 # parts of this chain may not exists and thus thow an exception
110 $hostname = $self->testrun->testrun_scheduling->host->name;
111 };
112 return ($hostname // 'No hostname set');
113}
114
115
116=head2 suite_headerlines
117
118Generate TAP header lines for the main MCP report.
119
120@param int - testrun id
121
122@return array ref - header lines
123
124=cut
125
126sub mcp_headerlines {
127 my ($self) = @_;
128
129 my $topic = $self->testrun->topic_name() || $self->testrun->shortname();
130 $topic =~ s/\s+/-/g;
131 my $hostname = $self->associated_hostname();
132 my $testrun_id = $self->testrun->id;
133
134 my $headerlines = [
135 "# Tapper-reportgroup-testrun: $testrun_id",
136 "# Tapper-suite-name: Topic-$topic",
137 "# Tapper-suite-version: $Tapper::MCP::VERSION",
138 "# Tapper-machine-name: $hostname",
139 "# Tapper-section: MCP overview",
140 "# Tapper-reportgroup-primary: 1",
141 ];
142 return $headerlines;
143}
144
145=head2 tap_report_create
146
147Create a report string from a report in array form. Since the function only
148does data transformation, no error should ever occur.
149
150@param array ref - report array
151@param array ref - header lines
152
153@return report string
154
155=cut
156
157sub tap_report_create
158{
159 my ($self, $reportlines, $headerlines) = @_;
160 my @reportlines = @$reportlines;
161 my $message;
162 $message .= "1..".($#reportlines+1)."\n";
163
164 foreach my $line (map { chomp; $_ } @$headerlines) {
165 $message .= "$line\n";
166 }
167
168 # @reportlines starts with 0, reports start with 1
169 for (my $i=1; $i<=$#reportlines+1; $i++) {
170 $message .= "not " if $reportlines[$i-1]->{error};
171 $message .="ok $i - ";
172 $message .= $reportlines[$i-1]->{msg} if $reportlines[$i-1]->{msg};
173 $message .="\n";
174
175 $message .= "# ".$reportlines[$i-1]->{comment}."\n"
176 if $reportlines[$i-1]->{comment};
177 }
178 return ($message);
179}
180
181
182=head2 upload_files
183
184Upload files written in one stage of the testrun to report framework.
185
186@param int - report id
187@param int - testrun id
188
189@return success - 0
190@return error - error string
191
192=cut
193
194sub upload_files
195{
196 my ($self, $reportid, $testrunid) = @_;
197 my $host = $self->cfg->{report_server};
198 my $port = $self->cfg->{report_api_port};
199
200 my $outputdir = $self->cfg->{paths}{output_dir};
201 my $path = "$outputdir/$testrunid/";
202 return 0 unless -d $path;
203 my @files=`find $path -type f`;
204 $self->log->debug(@files);
205 foreach my $file(@files) {
206 chomp $file;
207 my $reportfile=$file;
208 $reportfile =~ s|^$path||;
209 $reportfile =~ s|^./||;
210 $reportfile =~ s|[^A-Za-z0-9_-]|_|g;
211 my $cmdline = "#! upload $reportid ";
212 $cmdline .= $reportfile;
213 $cmdline .= " plain\n";
214
215 my $server = IO::Socket::INET->new(PeerAddr => $host,
216 PeerPort => $port);
217 return "Cannot open remote receiver $host:$port" if not $server;
218
219 open(my $FH, "<",$file) or do{$self->log->warn("Can't open $file:$!"); $server->close();next;};
220 $server->print($cmdline);
221 while (my $line = <$FH>) {
222 $server->print($line);
223 }
224 close($FH);
225 $server->close();
226 }
227 system(qq{find "$outputdir" -maxdepth 1 -type d -mtime +30 -exec rm -fr \\{\\} \\;});
228 return 0;
229}
230
231
23215µs1;