| Filename | /usr/share/perl5/LWP/Simple.pm |
| Statements | Executed 33 statements in 982µs |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 5.62ms | 27.2ms | LWP::Simple::BEGIN@26 |
| 1 | 1 | 1 | 2.96ms | 3.51ms | LWP::Simple::BEGIN@14 |
| 2 | 2 | 2 | 36µs | 917µs | LWP::Simple::import |
| 1 | 1 | 1 | 23µs | 30µs | LWP::Simple::BEGIN@3 |
| 1 | 1 | 1 | 11µs | 106µs | LWP::Simple::BEGIN@4 |
| 1 | 1 | 1 | 7µs | 7µs | LWP::Simple::BEGIN@27 |
| 1 | 1 | 1 | 6µs | 6µs | LWP::Simple::BEGIN@28 |
| 0 | 0 | 0 | 0s | 0s | LWP::Simple::__ANON__[:66] |
| 0 | 0 | 0 | 0s | 0s | LWP::Simple::__ANON__[:68] |
| 0 | 0 | 0 | 0s | 0s | LWP::Simple::get |
| 0 | 0 | 0 | 0s | 0s | LWP::Simple::getprint |
| 0 | 0 | 0 | 0s | 0s | LWP::Simple::getstore |
| 0 | 0 | 0 | 0s | 0s | LWP::Simple::head |
| 0 | 0 | 0 | 0s | 0s | LWP::Simple::mirror |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package LWP::Simple; | ||||
| 2 | |||||
| 3 | 3 | 37µs | 2 | 37µs | # spent 30µs (23+7) within LWP::Simple::BEGIN@3 which was called:
# once (23µs+7µs) by C4::Auth::BEGIN@34 at line 3 # spent 30µs making 1 call to LWP::Simple::BEGIN@3
# spent 7µs making 1 call to strict::import |
| 4 | 3 | 63µs | 2 | 200µs | # spent 106µs (11+95) within LWP::Simple::BEGIN@4 which was called:
# once (11µs+95µs) by C4::Auth::BEGIN@34 at line 4 # spent 106µs making 1 call to LWP::Simple::BEGIN@4
# spent 95µs making 1 call to vars::import |
| 5 | |||||
| 6 | 1 | 1µs | require Exporter; | ||
| 7 | |||||
| 8 | 1 | 3µs | @EXPORT = qw(get head getprint getstore mirror); | ||
| 9 | 1 | 600ns | @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 | 215µs | 2 | 3.87ms | # spent 3.51ms (2.96+547µs) within LWP::Simple::BEGIN@14 which was called:
# once (2.96ms+547µs) by C4::Auth::BEGIN@34 at line 14 # spent 3.51ms making 1 call to LWP::Simple::BEGIN@14
# spent 365µs making 1 call to Exporter::import |
| 15 | 1 | 15µs | push(@EXPORT, @HTTP::Status::EXPORT); | ||
| 16 | |||||
| 17 | 1 | 600ns | $VERSION = "5.835"; | ||
| 18 | |||||
| 19 | sub import | ||||
| 20 | # spent 917µs (36+880) within LWP::Simple::import which was called 2 times, avg 458µs/call:
# once (17µs+546µs) by C4::XSLT::BEGIN@36 at line 36 of /usr/share/koha/lib/C4/XSLT.pm
# once (19µs+334µs) by C4::Auth::BEGIN@34 at line 34 of /usr/share/koha/lib/C4/Auth.pm | ||||
| 21 | 6 | 24µs | my $pkg = shift; | ||
| 22 | my $callpkg = caller; | ||||
| 23 | 2 | 57µs | Exporter::export($pkg, $callpkg, @_); # spent 57µs making 2 calls to Exporter::export, avg 28µs/call | ||
| 24 | } | ||||
| 25 | |||||
| 26 | 3 | 151µs | 1 | 27.2ms | # spent 27.2ms (5.62+21.6) within LWP::Simple::BEGIN@26 which was called:
# once (5.62ms+21.6ms) by C4::Auth::BEGIN@34 at line 26 # spent 27.2ms making 1 call to LWP::Simple::BEGIN@26 |
| 27 | 3 | 23µs | 1 | 7µs | # spent 7µs within LWP::Simple::BEGIN@27 which was called:
# once (7µs+0s) by C4::Auth::BEGIN@34 at line 27 # spent 7µs making 1 call to LWP::Simple::BEGIN@27 |
| 28 | 3 | 421µs | 1 | 6µs | # spent 6µs within LWP::Simple::BEGIN@28 which was called:
# once (6µs+0s) by C4::Auth::BEGIN@34 at line 28 # spent 6µs making 1 call to LWP::Simple::BEGIN@28 |
| 29 | 1 | 7µs | 1 | 2.14ms | $ua = LWP::UserAgent->new; # we create a global UserAgent object # spent 2.14ms making 1 call to LWP::UserAgent::new |
| 30 | 1 | 5µs | 1 | 62µs | $ua->agent("LWP::Simple/$VERSION "); # spent 62µs making 1 call to LWP::UserAgent::agent |
| 31 | 1 | 2µs | 1 | 96µs | $ua->env_proxy; # spent 96µ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 | 14µs | 1; | ||
| 97 | |||||
| 98 | __END__ |