add split_cookie_header function to Mojo::Util

mojolicious · Feb 10, 2015 · c97f588 · c97f588
1 parent 716442c
commit c97f588
Show file tree

Hide file tree

Showing 6 changed files with 79 additions and 60 deletions.
diff --git a/Changes b/Changes
@@ -1,5 +1,6 @@
 
-5.78  2015-02-09
+5.78  2015-02-10
+  - Added split_cookie_header function to Mojo::Util.
   - Improved design of built-in templates.
   - Fixed bug in Mojo::DOM that made parsing a requirement.
   - Fixed warnings in Mojo::URL.

diff --git a/lib/Mojo/Cookie/Response.pm b/lib/Mojo/Cookie/Response.pm
@@ -2,10 +2,12 @@ package Mojo::Cookie::Response;
 use Mojo::Base 'Mojo::Cookie';
 
 use Mojo::Date;
-use Mojo::Util qw(quote split_header);
+use Mojo::Util qw(quote split_cookie_header);
 
 has [qw(domain httponly max_age origin path secure)];
 
+my %ATTRS = map { $_ => 1 } qw(expires domain path secure max-age httponly);
+
 sub expires {
   my $self = shift;
 
@@ -22,26 +24,15 @@ sub parse {
   my ($self, $str) = @_;
 
   my @cookies;
-  my $tree = split_header($str // '');
+  my $tree = split_cookie_header($str // '');
   while (my $pairs = shift @$tree) {
-    my $i = 0;
+    push @cookies,
+      $self->new(name => shift(@$pairs), value => shift(@$pairs) // '');
+
     while (@$pairs) {
       my ($name, $value) = (shift @$pairs, shift @$pairs);
 
-      # "expires" is a special case, thank you Netscape...
-      if ($name =~ /^expires$/i) {
-        push @$pairs, @{shift @$tree // []};
-        my $len = ($pairs->[0] // '') =~ /-/ ? 6 : 10;
-        $value .= join ' ', ',', grep {defined} splice @$pairs, 0, $len;
-      }
-
-      # This will only run once
-      push @cookies, $self->new(name => $name, value => $value // '') and next
-        unless $i++;
-
-      # Attributes (Netscape and RFC 6265)
-      next unless $name =~ /^(expires|domain|path|secure|max-age|httponly)$/i;
-      my $attr = lc $1;
+      next unless $ATTRS{my $attr = lc $name};
       $attr = 'max_age' if $attr eq 'max-age';
       $cookies[-1]
         ->$attr($attr eq 'secure' || $attr eq 'httponly' ? 1 : $value);
@@ -54,27 +45,27 @@ sub parse {
 sub to_string {
   my $self = shift;
 
-  # Name and value (Netscape)
+  # Name and value
   return '' unless length(my $name = $self->name // '');
   my $value = $self->value // '';
   my $cookie = join '=', $name, $value =~ /[,;" ]/ ? quote($value) : $value;
 
-  # "expires" (Netscape)
+  # "expires"
   if (defined(my $e = $self->expires)) { $cookie .= "; expires=$e" }
 
-  # "domain" (Netscape)
+  # "domain"
   if (my $domain = $self->domain) { $cookie .= "; domain=$domain" }
 
-  # "path" (Netscape)
+  # "path"
   if (my $path = $self->path) { $cookie .= "; path=$path" }
 
-  # "secure" (Netscape)
+  # "secure"
   $cookie .= "; secure" if $self->secure;
 
-  # "Max-Age" (RFC 6265)
+  # "Max-Age"
   if (defined(my $max = $self->max_age)) { $cookie .= "; Max-Age=$max" }
 
-  # "HttpOnly" (RFC 6265)
+  # "HttpOnly"
   $cookie .= "; HttpOnly" if $self->httponly;
 
   return $cookie;

diff --git a/lib/Mojo/Date.pm b/lib/Mojo/Date.pm
@@ -25,9 +25,10 @@ sub parse {
   return $self->epoch($date) if $date =~ /^\d+$|^\d+\.\d+$/;
 
   # RFC 822/1123 (Sun, 06 Nov 1994 08:49:37 GMT)
+  # RFC 850/1036 (Sunday, 06-Nov-94 08:49:37 GMT)
   my $offset = 0;
   my ($day, $month, $year, $h, $m, $s);
-  if ($date =~ /^\w+\,\s+(\d+)\s+(\w+)\s+(\d+)\s+(\d+):(\d+):(\d+)\s+GMT$/) {
+  if ($date =~ /^\w+\,\s+(\d+)\W+(\w+)\D+(\d+)\s+(\d+):(\d+):(\d+)\s+GMT$/) {
     ($day, $month, $year, $h, $m, $s) = ($1, $MONTHS{$2}, $3, $4, $5, $6);
   }
 
@@ -37,11 +38,6 @@ sub parse {
     $offset = (($8 * 3600) + ($9 * 60)) * ($7 eq '+' ? -1 : 1) if $7;
   }
 
-  # RFC 850/1036 (Sunday, 06-Nov-94 08:49:37 GMT)
-  elsif ($date =~ /^\w+\,\s+(\d+)-(\w+)-(\d+)\s+(\d+):(\d+):(\d+)\s+GMT$/) {
-    ($day, $month, $year, $h, $m, $s) = ($1, $MONTHS{$2}, $3, $4, $5, $6);
-  }
-
   # ANSI C asctime() (Sun Nov  6 08:49:37 1994)
   elsif ($date =~ /^\w+\s+(\w+)\s+(\d+)\s+(\d+):(\d+):(\d+)\s+(\d+)$/) {
     ($month, $day, $h, $m, $s, $year) = ($MONTHS{$1}, $2, $3, $4, $5, $6);

diff --git a/lib/Mojo/UserAgent/CookieJar.pm b/lib/Mojo/UserAgent/CookieJar.pm
@@ -109,7 +109,7 @@ sub _compare {
   return ($cookie->origin // '') ne $origin;
 }
 
-sub _path { $_[0] eq '/' || $_[0] eq $_[1] || $_[1] =~ m!^\Q$_[0]/! }
+sub _path { $_[0] eq '/' || $_[0] eq $_[1] || index($_[1], "$_[0]/") == 0 }
 
 1;
 

diff --git a/lib/Mojo/Util.pm b/lib/Mojo/Util.pm
@@ -55,9 +55,9 @@ our @EXPORT_OK = (
   qw(b64_decode b64_encode camelize class_to_file class_to_path decamelize),
   qw(decode deprecated dumper encode hmac_sha1_sum html_unescape md5_bytes),
   qw(md5_sum monkey_patch punycode_decode punycode_encode quote),
-  qw(secure_compare sha1_bytes sha1_sum slurp split_header spurt squish),
-  qw(steady_time tablify term_escape trim unindent unquote url_escape),
-  qw(url_unescape xml_escape xor_encode xss_escape)
+  qw(secure_compare sha1_bytes sha1_sum slurp split_cookie_header),
+  qw(split_header spurt squish steady_time tablify term_escape trim unindent),
+  qw(unquote url_escape url_unescape xml_escape xor_encode xss_escape)
 );
 
 sub b64_decode { decode_base64 $_[0] }
@@ -243,25 +243,8 @@ sub slurp {
   return $content;
 }
 
-sub split_header {
-  my $str = shift;
-
-  my (@tree, @token);
-  while ($str =~ s/^[,;\s]*([^=;, ]+)\s*//) {
-    push @token, $1, undef;
-    $token[-1] = unquote($1)
-      if $str =~ s/^=\s*("(?:\\\\|\\"|[^"])*"|[^;, ]*)\s*//;
-
-    # Separator
-    $str =~ s/^;\s*//;
-    next unless $str =~ s/^,\s*//;
-    push @tree, [@token];
-    @token = ();
-  }
-
-  # Take care of final token
-  return [@token ? (@tree, \@token) : @tree];
-}
+sub split_cookie_header { _header(shift, 1) }
+sub split_header        { _header(shift, 0) }
 
 sub spurt {
   my ($content, $path) = @_;
@@ -396,6 +379,35 @@ sub _encoding {
   $CACHE{$_[0]} //= find_encoding($_[0]) // croak "Unknown encoding '$_[0]'";
 }
 
+sub _header {
+  my ($str, $cookie) = @_;
+
+  my (@tree, @token);
+  while ($str =~ s/^[,;\s]*([^=;, ]+)\s*//) {
+    push @token, $1, undef;
+
+    # Special "expires" value
+    my $e = $cookie && lc $1 eq 'expires';
+    if ($e && $str =~ s/^=\s*(\w+\,\s+\d+\W+\w+\D+\d+\s+\d+:\d+:\d+\s+GMT)//) {
+      $token[-1] = $1;
+    }
+
+    # Normal value
+    elsif ($str =~ s/^=\s*("(?:\\\\|\\"|[^"])*"|[^;, ]*)\s*//) {
+      $token[-1] = unquote $1;
+    }
+
+    # Separator
+    $str =~ s/^;\s*//;
+    next unless $str =~ s/^,\s*//;
+    push @tree, [@token];
+    @token = ();
+  }
+
+  # Take care of final token
+  return [@token ? (@tree, \@token) : @tree];
+}
+
 sub _options {
 
   # Hash or name (one)
@@ -656,6 +668,13 @@ Generate SHA1 checksum for bytes.
 
 Read all data at once from file.
 
+=head2 split_cookie_header
+
+  my $tree = splie_cookie_header 'a=b; expires=Thu, 07 Aug 2008 07:07:59 GMT';
+
+Same as L</"split_header">, but handles C<expires> values from
+L<RFC 6265|http://tools.ietf.org/html/rfc6265>.
+
 =head2 split_header
 
    my $tree = split_header 'foo="bar baz"; test=123, yada';

diff --git a/t/mojo/util.t b/t/mojo/util.t
@@ -15,9 +15,9 @@ use Mojo::Util
   qw(b64_decode b64_encode camelize class_to_file class_to_path decamelize),
   qw(decode dumper encode hmac_sha1_sum html_unescape md5_bytes md5_sum),
   qw(monkey_patch punycode_decode punycode_encode quote secure_compare),
-  qw(secure_compare sha1_bytes sha1_sum slurp split_header spurt squish),
-  qw(steady_time tablify term_escape trim unindent unquote url_escape),
-  qw(url_unescape xml_escape xor_encode xss_escape);
+  qw(secure_compare sha1_bytes sha1_sum slurp split_cookie_header),
+  qw(split_header spurt squish steady_time tablify term_escape trim unindent),
+  qw(unquote url_escape url_unescape xml_escape xor_encode xss_escape);
 
 # camelize
 is camelize('foo_bar_baz'), 'FooBarBaz', 'right camelized result';
@@ -75,16 +75,28 @@ is_deeply split_header('foo = "b a\" r\"\\\\"; bar="ba z"'),
 my $header = q{</foo/bar>; rel="x"; t*=UTF-8'de'a%20b};
 my $tree = [['</foo/bar>', undef, 'rel', 'x', 't*', 'UTF-8\'de\'a%20b']];
 is_deeply split_header($header), $tree, 'right result';
-$header = 'a=b c; A=b.c; D=/E; a-b=3; F=Thu, 07 Aug 2008 07:07:59 GMT; Ab;';
-$tree   = [
-  ['a', 'b', 'c', undef, 'A', 'b.c', 'D', '/E', 'a-b', '3', 'F', 'Thu'],
+$header
+  = 'a=b c; A=b.c; D=/E; a-b=3; expires=Thu, 07 Aug 2008 07:07:59 GMT; Ab;';
+$tree = [
+  ['a', 'b', 'c', undef, 'A', 'b.c', 'D', '/E', 'a-b', '3', 'expires', 'Thu'],
   [
     '07',       undef, 'Aug', undef, '2008', undef,
     '07:07:59', undef, 'GMT', undef, 'Ab',   undef
   ]
 ];
 is_deeply split_header($header), $tree, 'right result';
 
+# split_cookie_header
+is_deeply split_cookie_header(''), [], 'right result';
+is_deeply split_cookie_header(
+  'a=b; expires=Thu, 07 Aug 2008 07:07:59 GMT,c=d'),
+  [['a', 'b', 'expires', 'Thu, 07 Aug 2008 07:07:59 GMT'], ['c', 'd']],
+  'right result';
+is_deeply split_cookie_header(
+  'a=b; expires=Tuesday, 09-Nov-1999 23:12:40 GMT, c=d'),
+  [['a', 'b', 'expires', 'Tuesday, 09-Nov-1999 23:12:40 GMT'], ['c', 'd']],
+  'right result';
+
 # unindent
 is unindent(" test\n  123\n 456\n"), "test\n 123\n456\n",
   'right unindented result';