| 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 | LWP::Simple::BEGIN@26 |
| 1 | 1 | 1 | 3.14ms | 3.73ms | LWP::Simple::BEGIN@14 |
| 2 | 2 | 2 | 56µs | 1.73ms | LWP::Simple::import |
| 1 | 1 | 1 | 21µs | 28µs | LWP::Simple::BEGIN@3 |
| 1 | 1 | 1 | 12µs | 12µs | LWP::Simple::BEGIN@27 |
| 1 | 1 | 1 | 11µs | 113µs | LWP::Simple::BEGIN@4 |
| 1 | 1 | 1 | 8µs | 8µ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 | 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 | 2 | 6µs | my $pkg = shift; | ||
| 22 | 2 | 4µs | my $callpkg = caller; | ||
| 23 | 2 | 26µs | 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__ |