Profile of Cookie/Baker.pm

← Index
NYTProf Performance Profile «line view»
For script/ponapi
Run on Wed Feb 10 15:51:26 2016
Reported on Thu Feb 11 09:43:10 2016

Filename | /usr/local/share/perl/5.18.2/Cookie/Baker.pm
Statements | Executed 24 statements in 658µs

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 35µs | 35µs | Cookie::Baker::::BEGIN@9Cookie::Baker::BEGIN@9
1 | 1 | 1 | 15µs | 15µs | Cookie::Baker::::BEGIN@3Cookie::Baker::BEGIN@3
1 | 1 | 1 | 10µs | 47µs | Cookie::Baker::::BEGIN@7Cookie::Baker::BEGIN@7
1 | 1 | 1 | 8µs | 19µs | Cookie::Baker::::BEGIN@65Cookie::Baker::BEGIN@65
1 | 1 | 1 | 7µs | 74µs | Cookie::Baker::::BEGIN@6Cookie::Baker::BEGIN@6
1 | 1 | 1 | 5µs | 14µs | Cookie::Baker::::BEGIN@4Cookie::Baker::BEGIN@4
1 | 1 | 1 | 5µs | 8µs | Cookie::Baker::::BEGIN@5Cookie::Baker::BEGIN@5
0 | 0 | 0 | 0s | 0s | Cookie::Baker::::_dateCookie::Baker::_date
0 | 0 | 0 | 0s | 0s | Cookie::Baker::::bake_cookieCookie::Baker::bake_cookie
0 | 0 | 0 | 0s | 0s | Cookie::Baker::::pp_crush_cookieCookie::Baker::pp_crush_cookie

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package Cookie::Baker;
2 |  |  |  |  |
3 | 2 | 38µs | 1 | 15µs | # spent 15µs within Cookie::Baker::BEGIN@3 which was called: # once (15µs+0s) by Plack::Response::BEGIN@8 at line 3 use 5.008001; # spent 15µs making 1 call to Cookie::Baker::BEGIN@3
4 | 2 | 18µs | 2 | 22µs | # spent 14µs (5+8) within Cookie::Baker::BEGIN@4 which was called: # once (5µs+8µs) by Plack::Response::BEGIN@8 at line 4 use strict; # spent 14µs making 1 call to Cookie::Baker::BEGIN@4 # spent 8µs making 1 call to strict::import
5 | 2 | 22µs | 2 | 11µs | # spent 8µs (5+3) within Cookie::Baker::BEGIN@5 which was called: # once (5µs+3µs) by Plack::Response::BEGIN@8 at line 5 use warnings; # spent 8µs making 1 call to Cookie::Baker::BEGIN@5 # spent 3µs making 1 call to warnings::import
6 | 2 | 21µs | 2 | 141µs | # spent 74µs (7+67) within Cookie::Baker::BEGIN@6 which was called: # once (7µs+67µs) by Plack::Response::BEGIN@8 at line 6 use base qw/Exporter/; # spent 74µs making 1 call to Cookie::Baker::BEGIN@6 # spent 67µs making 1 call to base::import
7 | 2 | 89µs | 2 | 85µs | # spent 47µs (10+37) within Cookie::Baker::BEGIN@7 which was called: # once (10µs+37µs) by Plack::Response::BEGIN@8 at line 7 use URI::Escape; # spent 47µs making 1 call to Cookie::Baker::BEGIN@7 # spent 37µs making 1 call to Exporter::import
8 |  |  |  |  |
9 |  |  |  |  | # spent 35µs within Cookie::Baker::BEGIN@9 which was called: # once (35µs+0s) by Plack::Response::BEGIN@8 at line 25 BEGIN {
10 | 1 | 400ns |  |  | our $VERSION = "0.06";
11 | 1 | 800ns |  |  | our @EXPORT = qw/bake_cookie crush_cookie/;
12 | 1 | 400ns |  |  | my $use_pp = $ENV{COOKIE_BAKER_PP};
13 | 1 | 300ns |  |  | if (!$use_pp) {
14 | 1 | 100ns |  |  | eval {
15 | 1 | 28µs |  |  | require Cookie::Baker::XS;
16 |  |  |  |  | };
17 | 1 | 600ns |  |  | $use_pp = !!$@;
18 |  |  |  |  | }
19 | 1 | 5µs |  |  | if ($use_pp) {
20 |  |  |  |  | *crush_cookie = \&pp_crush_cookie;
21 |  |  |  |  | }
22 |  |  |  |  | else {
23 |  |  |  |  | *crush_cookie = \&Cookie::Baker::XS::crush_cookie;
24 |  |  |  |  | }
25 | 1 | 229µs | 1 | 35µs | } # spent 35µs making 1 call to Cookie::Baker::BEGIN@9
26 |  |  |  |  |
27 |  |  |  |  | sub bake_cookie {
28 |  |  |  |  | my ($name,$val) = @_;
29 |  |  |  |  |
30 |  |  |  |  | return '' unless defined $val;
31 |  |  |  |  | my %args = ref $val ? %{$val} : (value => $val);
32 |  |  |  |  | $name = URI::Escape::uri_escape($name) if $name =~ m![^a-zA-Z\-\._~]!;
33 |  |  |  |  | my $cookie = "$name=" . URI::Escape::uri_escape($args{value}) . '; ';
34 |  |  |  |  | $cookie .= 'domain=' . $args{domain} . '; ' if $args{domain};
35 |  |  |  |  | $cookie .= 'path='. $args{path} . '; ' if $args{path};
36 |  |  |  |  | $cookie .= 'expires=' . _date($args{expires}) . '; ' if exists $args{expires} && defined $args{expires};
37 |  |  |  |  | $cookie .= 'max-age=' . $args{"max-age"} . '; ' if $args{"max-age"};
38 |  |  |  |  | $cookie .= 'secure; ' if $args{secure};
39 |  |  |  |  | $cookie .= 'HttpOnly; ' if $args{httponly};
40 |  |  |  |  | substr($cookie,-2,2,'');
41 |  |  |  |  | $cookie;
42 |  |  |  |  | }
43 |  |  |  |  |
44 | 1 | 2µs |  |  | my @MON = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
45 | 1 | 800ns |  |  | my @WDAY = qw( Sun Mon Tue Wed Thu Fri Sat );
46 |  |  |  |  |
47 | 1 | 2µs |  |  | my %term = (
48 |  |  |  |  | 's' => 1,
49 |  |  |  |  | 'm' => 60,
50 |  |  |  |  | 'h' => 3600,
51 |  |  |  |  | 'd' => 86400,
52 |  |  |  |  | 'M' => 86400 * 30,
53 |  |  |  |  | 'y' => 86400 * 365,
54 |  |  |  |  | );
55 |  |  |  |  |
56 |  |  |  |  | sub _date {
57 |  |  |  |  | my $expires = shift;
58 |  |  |  |  |
59 |  |  |  |  | my $expires_at;
60 |  |  |  |  | if ($expires =~ /^\d+$/) {
61 |  |  |  |  | # all numbers -> epoch date
62 |  |  |  |  | $expires_at = $expires;
63 |  |  |  |  | }
64 |  |  |  |  | elsif ( $expires =~ /^([-+]?(?:\d+|\d*\.\d*))([smhdMy]?)/ ) {
65 | 2 | 197µs | 2 | 31µs | # spent 19µs (8+12) within Cookie::Baker::BEGIN@65 which was called: # once (8µs+12µs) by Plack::Response::BEGIN@8 at line 65 no warnings; # spent 19µs making 1 call to Cookie::Baker::BEGIN@65 # spent 12µs making 1 call to warnings::unimport
66 |  |  |  |  | my $offset = ($term{$2} || 1) * $1;
67 |  |  |  |  | $expires_at = time + $offset;
68 |  |  |  |  | }
69 |  |  |  |  | elsif ( $expires eq 'now' ) {
70 |  |  |  |  | $expires_at = time;
71 |  |  |  |  | }
72 |  |  |  |  | else {
73 |  |  |  |  | return $expires;
74 |  |  |  |  | }
75 |  |  |  |  | my($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($expires_at);
76 |  |  |  |  | $year += 1900;
77 |  |  |  |  | # (cookies use '-' as date separator, HTTP uses ' ')
78 |  |  |  |  | return sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",
79 |  |  |  |  | $WDAY[$wday], $mday, $MON[$mon], $year, $hour, $min, $sec);
80 |  |  |  |  | }
81 |  |  |  |  |
82 |  |  |  |  | sub pp_crush_cookie {
83 |  |  |  |  | my $cookie_string = shift;
84 |  |  |  |  | return {} unless $cookie_string;
85 |  |  |  |  | my %results;
86 |  |  |  |  | my @pairs = grep m/=/, split "[;,] ?", $cookie_string;
87 |  |  |  |  | for my $pair ( @pairs ) {
88 |  |  |  |  | # trim leading trailing whitespace
89 |  |  |  |  | $pair =~ s/^\s+//; $pair =~ s/\s+$//;
90 |  |  |  |  |
91 |  |  |  |  | my ($key, $value) = map URI::Escape::uri_unescape($_), split( "=", $pair, 2 );
92 |  |  |  |  |
93 |  |  |  |  | # Take the first one like CGI.pm or rack do
94 |  |  |  |  | $results{$key} = $value unless exists $results{$key};
95 |  |  |  |  | }
96 |  |  |  |  | return \%results;
97 |  |  |  |  | }
98 |  |  |  |  |
99 | 1 | 4µs |  |  | 1;
100 |  |  |  |  | __END__