Fix issue #32 by checking for " as well as ; when splitting.

Fixes Set-Cookie (v1) style cookie parsing with regards to quoting.

Note that this also subtly changes the way we deal values we return as
it strips the " when it previously didn't.  These are the logical values
so I believe this is corect but it is a change of behaviour.

This may well affect issue #21 as we'll strip the " on read meaning we
should hopefully do the right thing now.

Author: colinnewell

lib/HTTP/Cookies.pm

@@ -227,7 +227,7 @@ sub extract_cookies
 	    my $param;
 	    my $expires;
 	    my $first_param = 1;
-	    for $param (split(/;\s*/, $set)) {
+	    for $param (@{_split_text($set)}) {
                 next unless length($param);
 		my($k,$v) = split(/\s*=\s*/, $param, 2);
 		if (defined $v) {
@@ -617,6 +617,50 @@ sub _normalize_path  # so that plain string compare can be used
     $_[0] =~ s/([\0-\x20\x7f-\xff])/sprintf("%%%02X",ord($1))/eg;
 }
 
+# deals with splitting values by ; and the fact that they could
+# be in quotes which can also have escaping.
+sub _split_text {
+    my $val = shift;
+    my @vals = grep { $_ ne '' } split(/([;\\"])/, $val);
+    my @chunks;
+    # divide it up into chunks to be processed.
+    my $in_string = 0;
+    my @current_string;
+    for(my $i = 0; $i < @vals; $i++) {
+        my $chunk = $vals[$i];
+        if($in_string) {
+            if($chunk eq '\\') {
+                # don't care about next char probably.
+                # having said that, probably need to be appending to the chunks
+                # just dropping this.
+                $i++;
+                if($i < @vals) {
+                    push @current_string, $vals[$i];
+                }
+            } elsif($chunk eq '"') {
+                $in_string = 0;
+            }
+            else {
+                push @current_string, $chunk;
+            }
+        } else {
+            if($chunk eq '"') {
+                $in_string = 1;
+            }
+            elsif($chunk eq ';') {
+                push @chunks, join('', @current_string);
+                @current_string = ();
+            }
+            else {
+                push @current_string, $chunk;
+            }
+        }
+    }
+    push @chunks, join('', @current_string) if @current_string;
+    s/^\s+// for @chunks;
+    return \@chunks;
+}
+
 1;
 
 __END__

t/cookies.t

@@ -642,7 +642,7 @@ $c->extract_cookies($res);
 $req = HTTP::Request->new(GET => "http://www.example.com/foo");
 $c->add_cookie_header($req);
 #print $req->as_string;
-ok($req->header("Cookie"), "foo=\"bar\"");
+ok($req->header("Cookie"), "foo=bar");
 
 # Test cookies that expire far into the future [RT#50147]
 $c = HTTP::Cookies->new;

t/issue32.t

@@ -0,0 +1,24 @@
+use strict;
+use warnings;
+use Test::More;
+
+use HTTP::Cookies;
+use HTTP::Request;
+use HTTP::Response;
+
+my $req  = HTTP::Request->new(GET => "http://example.com");
+my $resp = HTTP::Response->new(200, 'OK', ['Set-Cookie', q!a="b;c;\\"d"; expires=Fri, 06-Nov-2025 08:58:34 GMT; domain=example.com; path=/!]);
+$resp->request($req);
+
+my $c = HTTP::Cookies->new;
+$c->extract_cookies($resp);
+is $c->as_string, 'Set-Cookie3: a="b;c;\"d"; path="/"; domain=example.com; path_spec; expires="2025-11-06 08:58:34Z"; version=0' . "\n";
+
+# test the implementation of the split function in isolation.
+# should probably name the function better too.
+my $simple = 'b;c;d';
+is_deeply HTTP::Cookies::_split_text($simple), [qw/b c  d/], "Parse $simple";
+my $complex = '"b;c;\\"d";blah=32;foo="/"';
+is_deeply HTTP::Cookies::_split_text($complex), ['b;c;"d','blah=32','foo=/'], "Parse $complex";
+
+done_testing;