Filename | /usr/share/perl5/LWP/Simple.pm |
Statements | Executed 33 statements in 1.55ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 8.55ms | 29.3ms | BEGIN@26 | LWP::Simple::
1 | 1 | 1 | 3.14ms | 3.73ms | BEGIN@14 | LWP::Simple::
2 | 2 | 2 | 56µs | 1.73ms | import | LWP::Simple::
1 | 1 | 1 | 21µs | 28µs | BEGIN@3 | LWP::Simple::
1 | 1 | 1 | 12µs | 12µs | BEGIN@27 | LWP::Simple::
1 | 1 | 1 | 11µs | 113µs | BEGIN@4 | LWP::Simple::
1 | 1 | 1 | 8µs | 8µs | BEGIN@28 | LWP::Simple::
0 | 0 | 0 | 0s | 0s | __ANON__[:66] | LWP::Simple::
0 | 0 | 0 | 0s | 0s | __ANON__[:68] | LWP::Simple::
0 | 0 | 0 | 0s | 0s | get | LWP::Simple::
0 | 0 | 0 | 0s | 0s | getprint | LWP::Simple::
0 | 0 | 0 | 0s | 0s | getstore | LWP::Simple::
0 | 0 | 0 | 0s | 0s | head | LWP::Simple::
0 | 0 | 0 | 0s | 0s | mirror | LWP::Simple::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package LWP::Simple; | ||||
2 | |||||
3 | 3 | 36µs | 2 | 35µs | # spent 28µs (21+7) within LWP::Simple::BEGIN@3 which was called:
# once (21µs+7µs) by C4::Auth::BEGIN@34 at line 3 # spent 28µs making 1 call to LWP::Simple::BEGIN@3
# spent 6µs making 1 call to strict::import |
4 | 3 | 65µs | 2 | 214µs | # spent 113µs (11+102) within LWP::Simple::BEGIN@4 which was called:
# once (11µs+102µs) by C4::Auth::BEGIN@34 at line 4 # spent 113µs making 1 call to LWP::Simple::BEGIN@4
# spent 102µs making 1 call to vars::import |
5 | |||||
6 | 1 | 2µs | require Exporter; | ||
7 | |||||
8 | 1 | 4µs | @EXPORT = qw(get head getprint getstore mirror); | ||
9 | 1 | 1µs | @EXPORT_OK = qw($ua); | ||
10 | |||||
11 | # I really hate this. I was a bad idea to do it in the first place. | ||||
12 | # Wonder how to get rid of it??? (It even makes LWP::Simple 7% slower | ||||
13 | # for trivial tests) | ||||
14 | 3 | 188µs | 2 | 4.12ms | # spent 3.73ms (3.14+594µs) within LWP::Simple::BEGIN@14 which was called:
# once (3.14ms+594µs) by C4::Auth::BEGIN@34 at line 14 # spent 3.73ms making 1 call to LWP::Simple::BEGIN@14
# spent 386µs making 1 call to Exporter::import |
15 | 1 | 24µs | push(@EXPORT, @HTTP::Status::EXPORT); | ||
16 | |||||
17 | 1 | 1µs | $VERSION = "5.835"; | ||
18 | |||||
19 | sub import | ||||
20 | # spent 1.73ms (56µs+1.67) within LWP::Simple::import which was called 2 times, avg 864µs/call:
# once (24µs+1.11ms) by C4::XSLT::BEGIN@36 at line 36 of /usr/share/koha/lib/C4/XSLT.pm
# once (31µs+563µs) by C4::Auth::BEGIN@34 at line 34 of /usr/share/koha/lib/C4/Auth.pm | ||||
21 | 6 | 36µs | my $pkg = shift; | ||
22 | my $callpkg = caller; | ||||
23 | 2 | 91µs | Exporter::export($pkg, $callpkg, @_); # spent 91µs making 2 calls to Exporter::export, avg 45µs/call | ||
24 | } | ||||
25 | |||||
26 | 3 | 235µs | 1 | 29.3ms | # spent 29.3ms (8.55+20.7) within LWP::Simple::BEGIN@26 which was called:
# once (8.55ms+20.7ms) by C4::Auth::BEGIN@34 at line 26 # spent 29.3ms making 1 call to LWP::Simple::BEGIN@26 |
27 | 3 | 47µs | 1 | 12µs | # spent 12µs within LWP::Simple::BEGIN@27 which was called:
# once (12µs+0s) by C4::Auth::BEGIN@34 at line 27 # spent 12µs making 1 call to LWP::Simple::BEGIN@27 |
28 | 3 | 857µs | 1 | 8µs | # spent 8µs within LWP::Simple::BEGIN@28 which was called:
# once (8µs+0s) by C4::Auth::BEGIN@34 at line 28 # spent 8µs making 1 call to LWP::Simple::BEGIN@28 |
29 | 1 | 12µs | 1 | 4.05ms | $ua = LWP::UserAgent->new; # we create a global UserAgent object # spent 4.05ms making 1 call to LWP::UserAgent::new |
30 | 1 | 11µs | 1 | 134µs | $ua->agent("LWP::Simple/$VERSION "); # spent 134µs making 1 call to LWP::UserAgent::agent |
31 | 1 | 6µs | 1 | 264µs | $ua->env_proxy; # spent 264µs making 1 call to LWP::UserAgent::env_proxy |
32 | |||||
33 | |||||
34 | sub get ($) | ||||
35 | { | ||||
36 | my $response = $ua->get(shift); | ||||
37 | return $response->decoded_content if $response->is_success; | ||||
38 | return undef; | ||||
39 | } | ||||
40 | |||||
41 | |||||
42 | sub head ($) | ||||
43 | { | ||||
44 | my($url) = @_; | ||||
45 | my $request = HTTP::Request->new(HEAD => $url); | ||||
46 | my $response = $ua->request($request); | ||||
47 | |||||
48 | if ($response->is_success) { | ||||
49 | return $response unless wantarray; | ||||
50 | return (scalar $response->header('Content-Type'), | ||||
51 | scalar $response->header('Content-Length'), | ||||
52 | HTTP::Date::str2time($response->header('Last-Modified')), | ||||
53 | HTTP::Date::str2time($response->header('Expires')), | ||||
54 | scalar $response->header('Server'), | ||||
55 | ); | ||||
56 | } | ||||
57 | return; | ||||
58 | } | ||||
59 | |||||
60 | |||||
61 | sub getprint ($) | ||||
62 | { | ||||
63 | my($url) = @_; | ||||
64 | my $request = HTTP::Request->new(GET => $url); | ||||
65 | local($\) = ""; # ensure standard $OUTPUT_RECORD_SEPARATOR | ||||
66 | my $callback = sub { print $_[0] }; | ||||
67 | if ($^O eq "MacOS") { | ||||
68 | $callback = sub { $_[0] =~ s/\015?\012/\n/g; print $_[0] } | ||||
69 | } | ||||
70 | my $response = $ua->request($request, $callback); | ||||
71 | unless ($response->is_success) { | ||||
72 | print STDERR $response->status_line, " <URL:$url>\n"; | ||||
73 | } | ||||
74 | $response->code; | ||||
75 | } | ||||
76 | |||||
77 | |||||
78 | sub getstore ($$) | ||||
79 | { | ||||
80 | my($url, $file) = @_; | ||||
81 | my $request = HTTP::Request->new(GET => $url); | ||||
82 | my $response = $ua->request($request, $file); | ||||
83 | |||||
84 | $response->code; | ||||
85 | } | ||||
86 | |||||
87 | |||||
88 | sub mirror ($$) | ||||
89 | { | ||||
90 | my($url, $file) = @_; | ||||
91 | my $response = $ua->mirror($url, $file); | ||||
92 | $response->code; | ||||
93 | } | ||||
94 | |||||
95 | |||||
96 | 1 | 26µs | 1; | ||
97 | |||||
98 | __END__ |