← Index
NYTProf Performance Profile   « line view »
For starman worker -M FindBin --max-requests 50 --workers 2 --user=kohadev-koha --group kohadev-koha --pid /var/run/koha/kohadev/plack.pid --daemonize --access-log /var/log/koha/kohadev/plack.log --error-log /var/log/koha/kohadev/plack-error.log -E deployment --socket /var/run/koha/kohadev/plack.sock /etc/koha/sites/kohadev/plack.psgi
  Run on Fri Jan 8 14:31:06 2016
Reported on Fri Jan 8 14:31:39 2016

Filename/usr/share/perl5/Authen/CAS/Client.pm
StatementsExecuted 17 statements in 2.17ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1115.37ms8.06msAuthen::CAS::Client::::BEGIN@9Authen::CAS::Client::BEGIN@9
1111.17ms1.83msAuthen::CAS::Client::::BEGIN@8Authen::CAS::Client::BEGIN@8
111628µs677µsAuthen::CAS::Client::::BEGIN@11Authen::CAS::Client::BEGIN@11
11117µs170µsAuthen::CAS::Client::::BEGIN@12Authen::CAS::Client::BEGIN@12
11115µs23µsAuthen::CAS::Client::::BEGIN@5Authen::CAS::Client::BEGIN@5
11110µs10µsAuthen::CAS::Client::::BEGIN@10Authen::CAS::Client::BEGIN@10
1119µs14µ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
3115µsrequire 5.006_001;
4
5245µs231µs
# spent 23µs (15+8) within Authen::CAS::Client::BEGIN@5 which was called: # once (15µs+8µs) by C4::Auth_with_cas::BEGIN@25 at line 5
use strict;
# spent 23µs making 1 call to Authen::CAS::Client::BEGIN@5 # spent 8µs making 1 call to strict::import
6236µs218µs
# spent 14µs (9+5) within Authen::CAS::Client::BEGIN@6 which was called: # once (9µs+5µs) by C4::Auth_with_cas::BEGIN@25 at line 6
use warnings;
# spent 14µs making 1 call to Authen::CAS::Client::BEGIN@6 # spent 5µs making 1 call to warnings::import
7
82144µs11.83ms
# spent 1.83ms (1.17+661µs) within Authen::CAS::Client::BEGIN@8 which was called: # once (1.17ms+661µs) by C4::Auth_with_cas::BEGIN@25 at line 8
use Authen::CAS::Client::Response;
# spent 1.83ms making 1 call to Authen::CAS::Client::BEGIN@8
92298µs18.06ms
# spent 8.06ms (5.37+2.70) within Authen::CAS::Client::BEGIN@9 which was called: # once (5.37ms+2.70ms) by C4::Auth_with_cas::BEGIN@25 at line 9
use LWP::UserAgent;
# spent 8.06ms making 1 call to Authen::CAS::Client::BEGIN@9
10228µs110µs
# spent 10µs within Authen::CAS::Client::BEGIN@10 which was called: # once (10µs+0s) by C4::Auth_with_cas::BEGIN@25 at line 10
use URI;
# spent 10µs making 1 call to Authen::CAS::Client::BEGIN@10
112175µs1677µs
# spent 677µs (628+49) within Authen::CAS::Client::BEGIN@11 which was called: # once (628µs+49µs) by C4::Auth_with_cas::BEGIN@25 at line 11
use URI::QueryParam;
# spent 677µs making 1 call to Authen::CAS::Client::BEGIN@11
1221.42ms2323µs
# spent 170µs (17+153) within Authen::CAS::Client::BEGIN@12 which was called: # once (17µs+153µs) by C4::Auth_with_cas::BEGIN@25 at line 12
use XML::LibXML;
# spent 170µs making 1 call to Authen::CAS::Client::BEGIN@12 # spent 153µs making 1 call to XML::LibXML::import
13
141400nsour $VERSION = '0.07';
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
28713µs1
288__END__
Report produced by the NYTProf 6.02 Perl profiler, developed by Tim Bunce and Adam Kaplan.