Filename | /usr/local/share/perl/5.18.2/HTTP/Headers/ActionPack/MediaType.pm |
Statements | Executed 100013 statements in 596ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
100001 | 1 | 1 | 692ms | 810ms | type | HTTP::Headers::ActionPack::MediaType::
1 | 1 | 1 | 49µs | 49µs | BEGIN@2 | HTTP::Headers::ActionPack::MediaType::
1 | 1 | 1 | 25µs | 55µs | BEGIN@11 | HTTP::Headers::ActionPack::MediaType::
1 | 1 | 1 | 22µs | 94µs | BEGIN@10 | HTTP::Headers::ActionPack::MediaType::
1 | 1 | 1 | 19µs | 134µs | BEGIN@13 | HTTP::Headers::ActionPack::MediaType::
1 | 1 | 1 | 15µs | 17.1ms | BEGIN@15 | HTTP::Headers::ActionPack::MediaType::
0 | 0 | 0 | 0s | 0s | _compare_params | HTTP::Headers::ActionPack::MediaType::
0 | 0 | 0 | 0s | 0s | equals | HTTP::Headers::ActionPack::MediaType::
0 | 0 | 0 | 0s | 0s | exact_match | HTTP::Headers::ActionPack::MediaType::
0 | 0 | 0 | 0s | 0s | major | HTTP::Headers::ActionPack::MediaType::
0 | 0 | 0 | 0s | 0s | match | HTTP::Headers::ActionPack::MediaType::
0 | 0 | 0 | 0s | 0s | matches_all | HTTP::Headers::ActionPack::MediaType::
0 | 0 | 0 | 0s | 0s | minor | HTTP::Headers::ActionPack::MediaType::
0 | 0 | 0 | 0s | 0s | params_match | HTTP::Headers::ActionPack::MediaType::
0 | 0 | 0 | 0s | 0s | type_matches | HTTP::Headers::ActionPack::MediaType::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package HTTP::Headers::ActionPack::MediaType; | ||||
2 | # spent 49µs within HTTP::Headers::ActionPack::MediaType::BEGIN@2 which was called:
# once (49µs+0s) by HTTP::Headers::ActionPack::MediaTypeList::BEGIN@15 at line 4 | ||||
3 | 1 | 38µs | $HTTP::Headers::ActionPack::MediaType::AUTHORITY = 'cpan:STEVAN'; | ||
4 | 1 | 92µs | 1 | 49µs | } # spent 49µs making 1 call to HTTP::Headers::ActionPack::MediaType::BEGIN@2 |
5 | { | ||||
6 | 2 | 1µs | $HTTP::Headers::ActionPack::MediaType::VERSION = '0.09'; | ||
7 | } | ||||
8 | # ABSTRACT: A Media Type | ||||
9 | |||||
10 | 2 | 72µs | 2 | 164µs | # spent 94µs (22+71) within HTTP::Headers::ActionPack::MediaType::BEGIN@10 which was called:
# once (22µs+71µs) by HTTP::Headers::ActionPack::MediaTypeList::BEGIN@15 at line 10 # spent 94µs making 1 call to HTTP::Headers::ActionPack::MediaType::BEGIN@10
# spent 71µs making 1 call to strict::import |
11 | 2 | 58µs | 2 | 86µs | # spent 55µs (25+30) within HTTP::Headers::ActionPack::MediaType::BEGIN@11 which was called:
# once (25µs+30µs) by HTTP::Headers::ActionPack::MediaTypeList::BEGIN@15 at line 11 # spent 55µs making 1 call to HTTP::Headers::ActionPack::MediaType::BEGIN@11
# spent 30µs making 1 call to warnings::import |
12 | |||||
13 | 2 | 54µs | 2 | 250µs | # spent 134µs (19+116) within HTTP::Headers::ActionPack::MediaType::BEGIN@13 which was called:
# once (19µs+116µs) by HTTP::Headers::ActionPack::MediaTypeList::BEGIN@15 at line 13 # spent 134µs making 1 call to HTTP::Headers::ActionPack::MediaType::BEGIN@13
# spent 116µs making 1 call to Exporter::import |
14 | |||||
15 | 2 | 527µs | 2 | 34.1ms | # spent 17.1ms (15µs+17.0) within HTTP::Headers::ActionPack::MediaType::BEGIN@15 which was called:
# once (15µs+17.0ms) by HTTP::Headers::ActionPack::MediaTypeList::BEGIN@15 at line 15 # spent 17.1ms making 1 call to HTTP::Headers::ActionPack::MediaType::BEGIN@15
# spent 17.0ms making 1 call to parent::import |
16 | |||||
17 | 100001 | 596ms | 100001 | 118ms | # spent 810ms (692+118) within HTTP::Headers::ActionPack::MediaType::type which was called 100001 times, avg 8µs/call:
# 100001 times (692ms+118ms) by PONAPI::Server::_ponapi_check_headers at line 222 of lib/PONAPI/Server.pm, avg 8µs/call # spent 118ms making 100001 calls to HTTP::Headers::ActionPack::Core::BaseHeaderType::subject, avg 1µs/call |
18 | sub major { (split '/' => (shift)->type)[0] } | ||||
19 | sub minor { (split '/' => (shift)->type)[1] } | ||||
20 | |||||
21 | sub matches_all { | ||||
22 | my $self = shift; | ||||
23 | $self->type eq '*/*' && $self->params_are_empty | ||||
24 | ? 1 : 0; | ||||
25 | } | ||||
26 | |||||
27 | # must be exactly the same | ||||
28 | sub equals { | ||||
29 | my ($self, $other) = @_; | ||||
30 | $other = (ref $self)->new_from_string( $other ) unless blessed $other; | ||||
31 | $other->type eq $self->type && _compare_params( $self->params, $other->params ) | ||||
32 | ? 1 : 0; | ||||
33 | } | ||||
34 | |||||
35 | # types must be compatible and params much match exactly | ||||
36 | sub exact_match { | ||||
37 | my ($self, $other) = @_; | ||||
38 | $other = (ref $self)->new_from_string( $other ) unless blessed $other; | ||||
39 | $self->type_matches( $other ) && _compare_params( $self->params, $other->params ) | ||||
40 | ? 1 : 0; | ||||
41 | } | ||||
42 | |||||
43 | # types must be be compatible and params should align | ||||
44 | sub match { | ||||
45 | my ($self, $other) = @_; | ||||
46 | $other = (ref $self)->new_from_string( $other ) unless blessed $other; | ||||
47 | $self->type_matches( $other ) && $self->params_match( $other->params ) | ||||
48 | ? 1 : 0; | ||||
49 | } | ||||
50 | |||||
51 | ## ... | ||||
52 | |||||
53 | sub type_matches { | ||||
54 | my ($self, $other) = @_; | ||||
55 | return 1 if $other->type eq '*' || $other->type eq '*/*' || $other->type eq $self->type; | ||||
56 | $other->major eq $self->major && $other->minor eq '*' | ||||
57 | ? 1 : 0; | ||||
58 | } | ||||
59 | |||||
60 | sub params_match { | ||||
61 | my ($self, $other) = @_; | ||||
62 | my $params = $self->params; | ||||
63 | foreach my $k ( keys %$other ) { | ||||
64 | next if $k eq 'q'; | ||||
65 | return 0 if not exists $params->{ $k }; | ||||
66 | return 0 if $params->{ $k } ne $other->{ $k }; | ||||
67 | } | ||||
68 | return 1; | ||||
69 | } | ||||
70 | |||||
71 | ## ... | ||||
72 | |||||
73 | sub _compare_params { | ||||
74 | my ($left, $right) = @_; | ||||
75 | my @left_keys = sort grep { $_ ne 'q' } keys %$left; | ||||
76 | my @right_keys = sort grep { $_ ne 'q' } keys %$right; | ||||
77 | |||||
78 | return 0 unless (scalar @left_keys) == (scalar @right_keys); | ||||
79 | |||||
80 | foreach my $i ( 0 .. $#left_keys ) { | ||||
81 | return 0 unless $left_keys[$i] eq $right_keys[$i]; | ||||
82 | return 0 unless $left->{ $left_keys[$i] } eq $right->{ $right_keys[$i] }; | ||||
83 | } | ||||
84 | |||||
85 | return 1; | ||||
86 | } | ||||
87 | |||||
88 | 1 | 4µs | 1; | ||
89 | |||||
90 | __END__ |