| 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 | HTTP::Headers::ActionPack::MediaType::type |
| 1 | 1 | 1 | 49µs | 49µs | HTTP::Headers::ActionPack::MediaType::BEGIN@2 |
| 1 | 1 | 1 | 25µs | 55µs | HTTP::Headers::ActionPack::MediaType::BEGIN@11 |
| 1 | 1 | 1 | 22µs | 94µs | HTTP::Headers::ActionPack::MediaType::BEGIN@10 |
| 1 | 1 | 1 | 19µs | 134µs | HTTP::Headers::ActionPack::MediaType::BEGIN@13 |
| 1 | 1 | 1 | 15µs | 17.1ms | HTTP::Headers::ActionPack::MediaType::BEGIN@15 |
| 0 | 0 | 0 | 0s | 0s | HTTP::Headers::ActionPack::MediaType::_compare_params |
| 0 | 0 | 0 | 0s | 0s | HTTP::Headers::ActionPack::MediaType::equals |
| 0 | 0 | 0 | 0s | 0s | HTTP::Headers::ActionPack::MediaType::exact_match |
| 0 | 0 | 0 | 0s | 0s | HTTP::Headers::ActionPack::MediaType::major |
| 0 | 0 | 0 | 0s | 0s | HTTP::Headers::ActionPack::MediaType::match |
| 0 | 0 | 0 | 0s | 0s | HTTP::Headers::ActionPack::MediaType::matches_all |
| 0 | 0 | 0 | 0s | 0s | HTTP::Headers::ActionPack::MediaType::minor |
| 0 | 0 | 0 | 0s | 0s | HTTP::Headers::ActionPack::MediaType::params_match |
| 0 | 0 | 0 | 0s | 0s | HTTP::Headers::ActionPack::MediaType::type_matches |
| 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__ |