| Filename | /usr/local/share/perl/5.18.2/Cookie/Baker.pm |
| Statements | Executed 24 statements in 658µs |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 35µs | 35µs | Cookie::Baker::BEGIN@9 |
| 1 | 1 | 1 | 15µs | 15µs | Cookie::Baker::BEGIN@3 |
| 1 | 1 | 1 | 10µs | 47µs | Cookie::Baker::BEGIN@7 |
| 1 | 1 | 1 | 8µs | 19µs | Cookie::Baker::BEGIN@65 |
| 1 | 1 | 1 | 7µs | 74µs | Cookie::Baker::BEGIN@6 |
| 1 | 1 | 1 | 5µs | 14µs | Cookie::Baker::BEGIN@4 |
| 1 | 1 | 1 | 5µs | 8µs | Cookie::Baker::BEGIN@5 |
| 0 | 0 | 0 | 0s | 0s | Cookie::Baker::_date |
| 0 | 0 | 0 | 0s | 0s | Cookie::Baker::bake_cookie |
| 0 | 0 | 0 | 0s | 0s | Cookie::Baker::pp_crush_cookie |
| 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 # 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 # 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 # 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 # 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 # 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 | ||||
| 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 # 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__ |