← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 17:10:45 2013
Reported on Tue Oct 15 17:11:23 2013

Filename/usr/share/perl5/Authen/CAS/Client.pm
StatementsExecuted 24 statements in 3.09ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11113.6ms31.7msAuthen::CAS::Client::::BEGIN@12Authen::CAS::Client::BEGIN@12
1111.46ms2.65msAuthen::CAS::Client::::BEGIN@8Authen::CAS::Client::BEGIN@8
1111.19ms1.23msAuthen::CAS::Client::::BEGIN@11Authen::CAS::Client::BEGIN@11
11142µs46µsAuthen::CAS::Client::::BEGIN@9Authen::CAS::Client::BEGIN@9
11119µs27µsAuthen::CAS::Client::::BEGIN@5Authen::CAS::Client::BEGIN@5
11117µs19µsAuthen::CAS::Client::::BEGIN@10Authen::CAS::Client::BEGIN@10
11110µs24µsAuthen::CAS::Client::::BEGIN@6Authen::CAS::Client::BEGIN@6
0000s0sAuthen::CAS::Client::::_errorAuthen::CAS::Client::_error
0000s0sAuthen::CAS::Client::::_parse_auth_responseAuthen::CAS::Client::_parse_auth_response
0000s0sAuthen::CAS::Client::::_parse_proxy_responseAuthen::CAS::Client::_parse_proxy_response
0000s0sAuthen::CAS::Client::::_server_requestAuthen::CAS::Client::_server_request
0000s0sAuthen::CAS::Client::::_urlAuthen::CAS::Client::_url
0000s0sAuthen::CAS::Client::::_v20_validateAuthen::CAS::Client::_v20_validate
0000s0sAuthen::CAS::Client::::login_urlAuthen::CAS::Client::login_url
0000s0sAuthen::CAS::Client::::logout_urlAuthen::CAS::Client::logout_url
0000s0sAuthen::CAS::Client::::newAuthen::CAS::Client::new
0000s0sAuthen::CAS::Client::::proxyAuthen::CAS::Client::proxy
0000s0sAuthen::CAS::Client::::proxy_validateAuthen::CAS::Client::proxy_validate
0000s0sAuthen::CAS::Client::::service_validateAuthen::CAS::Client::service_validate
0000s0sAuthen::CAS::Client::::validateAuthen::CAS::Client::validate
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Authen::CAS::Client;
2
3163µsrequire 5.006_001;
4
5329µs235µs
# spent 27µs (19+8) within Authen::CAS::Client::BEGIN@5 which was called: # once (19µs+8µs) by C4::Auth_with_cas::BEGIN@26 at line 5
use strict;
# spent 27µs making 1 call to Authen::CAS::Client::BEGIN@5 # spent 8µs making 1 call to strict::import
6329µs238µs
# spent 24µs (10+14) within Authen::CAS::Client::BEGIN@6 which was called: # once (10µs+14µs) by C4::Auth_with_cas::BEGIN@26 at line 6
use warnings;
# spent 24µs making 1 call to Authen::CAS::Client::BEGIN@6 # spent 14µs making 1 call to warnings::import
7
83188µs22.65ms
# spent 2.65ms (1.46+1.19) within Authen::CAS::Client::BEGIN@8 which was called: # once (1.46ms+1.19ms) by C4::Auth_with_cas::BEGIN@26 at line 8
use Authen::CAS::Client::Response;
# spent 2.65ms making 1 call to Authen::CAS::Client::BEGIN@8 # spent 7µs making 1 call to UNIVERSAL::import
9366µs250µs
# spent 46µs (42+4) within Authen::CAS::Client::BEGIN@9 which was called: # once (42µs+4µs) by C4::Auth_with_cas::BEGIN@26 at line 9
use LWP::UserAgent;
# spent 46µs making 1 call to Authen::CAS::Client::BEGIN@9 # spent 4µs making 1 call to UNIVERSAL::import
10342µs222µs
# spent 19µs (17+3) within Authen::CAS::Client::BEGIN@10 which was called: # once (17µs+3µs) by C4::Auth_with_cas::BEGIN@26 at line 10
use URI;
# spent 19µs making 1 call to Authen::CAS::Client::BEGIN@10 # spent 2µs making 1 call to UNIVERSAL::import
113231µs21.24ms
# spent 1.23ms (1.19+41µs) within Authen::CAS::Client::BEGIN@11 which was called: # once (1.19ms+41µs) by C4::Auth_with_cas::BEGIN@26 at line 11
use URI::QueryParam;
# spent 1.23ms making 1 call to Authen::CAS::Client::BEGIN@11 # spent 8µs making 1 call to UNIVERSAL::import
1232.43ms232.1ms
# spent 31.7ms (13.6+18.1) within Authen::CAS::Client::BEGIN@12 which was called: # once (13.6ms+18.1ms) by C4::Auth_with_cas::BEGIN@26 at line 12
use XML::LibXML;
# spent 31.7ms making 1 call to Authen::CAS::Client::BEGIN@12 # spent 355µs making 1 call to XML::LibXML::import
13
141600nsour $VERSION = '0.05';
15
16
17#======================================================================
18# constructor
19#
20
21sub new {
22 my ( $class, $cas, %args ) = @_;
23
24 my $self = {
25 _cas => URI->new( $cas ),
26 _ua => LWP::UserAgent->new( agent => "Authen-CAS-Client/$VERSION" ),
27 _fatal => $args{fatal} ? 1 : 0,
28 };
29
30 bless $self, $class;
31}
32
33
34#======================================================================
35# private methods
36#
37
38sub _error {
39 my ( $self, $error, $doc ) = @_;
40
41 die $error
42 if $self->{_fatal};
43
44 Authen::CAS::Client::Response::Error->new( error => $error, doc => $doc );
45}
46
47sub _parse_auth_response {
48 my ( $self, $xml ) = @_;
49
50 my $doc = eval { XML::LibXML->new->parse_string( $xml ) };
51 return $self->_error( 'Failed to parse XML', $xml )
52 if $@;
53
54 my ( $node, $response );
55
56 eval {
57 if( $node = $doc->find( '/cas:serviceResponse/cas:authenticationSuccess' )->get_node( 1 ) ) {
58 $response = eval {
59 my $user = $node->find( './cas:user' )->get_node( 1 )->textContent;
60
61 my $iou = $node->find( './cas:proxyGrantingTicket' )->get_node( 1 );
62 $iou = $iou->textContent
63 if( defined $iou );
64
65 my $proxies = $node->findnodes( './cas:proxies/cas:proxy' );
66 $proxies = [ map $_->textContent, @$proxies ]
67 if defined @$proxies;
68
69 Authen::CAS::Client::Response::AuthSuccess->new(
70 user => $user,
71 iou => $iou,
72 proxies => $proxies,
73 doc => $doc,
74 );
75 };
76
77 $response = $self->_error( 'Failed to parse authentication success response', $doc )
78 if $@;
79 }
80 elsif( $node = $doc->find( '/cas:serviceResponse/cas:authenticationFailure' )->get_node( 1 ) ) {
81 $response = eval {
82 die
83 unless $node->hasAttribute( 'code' );
84 my $code = $node->getAttribute( 'code' );
85
86 my $message = $node->textContent;
87 s/^\s+//, s/\s+\z//
88 for $message;
89
90 Authen::CAS::Client::Response::AuthFailure->new(
91 code => $code,
92 message => $message,
93 doc => $doc,
94 );
95 };
96
97 $response = $self->_error( 'Failed to parse authentication failure response', $doc )
98 if $@;
99 }
100 else {
101 die;
102 }
103 };
104
105 $response = $self->_error( 'Invalid CAS response', $doc )
106 if $@;
107
108 return $response;
109}
110
111sub _parse_proxy_response {
112 my ( $self, $xml ) = @_;
113
114 my $doc = eval { XML::LibXML->new->parse_string( $xml ) };
115 return $self->_error( 'Failed to parse XML', $xml )
116 if $@;
117
118 my ( $node, $response );
119
120 eval {
121 if( $node = $doc->find( '/cas:serviceResponse/cas:proxySuccess' )->get_node( 1 ) ) {
122 $response = eval {
123 my $proxy_ticket = $node->find( './cas:proxyTicket' )->get_node( 1 )->textContent;
124
125 Authen::CAS::Client::Response::ProxySuccess->new(
126 proxy_ticket => $proxy_ticket,
127 doc => $doc,
128 );
129 };
130 $response = $self->_error( 'Failed to parse proxy success response', $doc )
131 if $@;
132 }
133 elsif( $node = $doc->find( '/cas:serviceResponse/cas:proxyFailure' )->get_node( 1 ) ) {
134 $response = eval {
135 die
136 unless $node->hasAttribute( 'code' );
137 my $code = $node->getAttribute( 'code' );
138
139 my $message = $node->textContent;
140 s/^\s+//, s/\s+\z//
141 for $message;
142
143 Authen::CAS::Client::Response::ProxyFailure->new(
144 code => $code,
145 message => $message,
146 doc => $doc,
147 );
148 };
149 $response = $self->_error( 'Failed to parse proxy failure response', $doc )
150 if $@;
151 }
152 else {
153 die;
154 }
155 };
156
157 $response = $self->_error( 'Invalid CAS response', $doc )
158 if $@;
159
160 return $response;
161}
162
163sub _server_request {
164 my ( $self, $path, $params ) = @_;
165
166 my $url = $self->_url( $path, $params )->canonical;
167 my $response = $self->{_ua}->get( $url );
168
169 unless( $response->is_success ) {
170 return $self->_error(
171 'HTTP request failed: ' . $response->code . ': ' . $response->message,
172 $response->content
173 );
174 }
175
176 return $response->content;
177}
178
179sub _url {
180 my ( $self, $path, $params ) = @_;
181
182 my $url = $self->{_cas}->clone;
183
184 $url->path( $url->path . $path );
185 $url->query_param_append( $_ => $params->{$_} )
186 for keys %$params;
187
188 return $url;
189}
190
191sub _v20_validate {
192 my ( $self, $path, $service, $ticket, %args ) = @_;
193
194 my %params = ( service => $service, ticket => $ticket );
195
196 $params{renew} = 'true'
197 if $args{renew};
198 $params{pgtUrl} = URI->new( $args{pgtUrl} )->canonical
199 if defined $args{pgtUrl};
200
201 my $content = $self->_server_request( $path, \%params );
202 return $content
203 if ref $content;
204
205 return $self->_parse_auth_response( $content );
206}
207
208
209#======================================================================
210# public methods
211#
212
213sub login_url {
214 my ( $self, $service, %args ) = @_;
215
216 my %params = ( service => $service );
217
218 for ( qw/ renew gateway / ) {
219 $params{$_} = 'true', last
220 if $args{$_};
221 }
222
223 return $self->_url( '/login', \%params )->canonical;
224}
225
226sub logout_url {
227 my ( $self, %args ) = @_;
228
229 my %params;
230
231 $params{url} = $args{url}
232 if defined $args{url};
233
234 return $self->_url( '/logout', \%params )->canonical;
235}
236
237sub validate {
238 my ( $self, $service, $ticket, %args ) = @_;
239
240 my %params = ( service => $service, ticket => $ticket );
241
242 $params{renew} = 'true'
243 if $args{renew};
244
245 my $content = $self->_server_request( '/validate', \%params );
246 return $content
247 if ref $content;
248
249 my $response;
250
251 if( $content =~ /^no\n\n\z/ ) {
252 $response = Authen::CAS::Client::Response::AuthFailure->new( code => 'V10_AUTH_FAILURE', doc => $content );
253 }
254 elsif( $content =~ /^yes\n([^\n]+)\n\z/ ) {
255 $response = Authen::CAS::Client::Response::AuthSuccess->new( user => $1, doc => $content );
256 }
257 else {
258 $response = $self->_error( 'Invalid CAS response', $content );
259 }
260
261 return $response;
262}
263
264sub service_validate {
265 my ( $self, $service, $ticket, %args ) = @_;
266 return $self->_v20_validate( '/serviceValidate', $service, $ticket, %args );
267}
268
269sub proxy_validate {
270 my ( $self, $service, $ticket, %args ) = @_;
271 return $self->_v20_validate( '/proxyValidate', $service, $ticket, %args );
272}
273
274sub proxy {
275 my ( $self, $pgt, $target ) = @_;
276
277 my %params = ( pgt => $pgt, targetService => URI->new( $target ) );
278
279 my $content = $self->_server_request( '/proxy', \%params );
280 return $content
281 if ref $content;
282
283 return $self->_parse_proxy_response( $content );
284}
285
286
28715µs1
288__END__
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.