[SVN] [44] Cookie support

[ma...@sergeant.org]

Revision: 44
Author:   matt
Date:     2006-08-05 02:44:48 +0000 (Sat, 05 Aug 2006)

Log Message:
-----------
Cookie support

Modified Paths:
--------------
    trunk/lib/AxKit2/HTTPHeaders.pm
    trunk/lib/AxKit2/Utils.pm

Modified: trunk/lib/AxKit2/HTTPHeaders.pm
===================================================================
--- trunk/lib/AxKit2/HTTPHeaders.pm	2006-08-05 02:44:22 UTC (rev 43)
+++ trunk/lib/AxKit2/HTTPHeaders.pm	2006-08-05 02:44:48 UTC (rev 44)
@@ -6,7 +6,7 @@
 use warnings;
 no  warnings qw(deprecated);
 
-use AxKit2::Utils qw(uri_decode);
+use AxKit2::Utils qw(uri_decode uri_encode);
 
 use fields (
             'headers',      # href; lowercase header -> comma-sep list of values
@@ -25,6 +25,7 @@
             'vernum',       # version (number: major*1000+minor): "1.1" => 1001
             'responseLine', # first line of HTTP response (if response)
             'requestLine',  # first line of HTTP request (if request)
+            'parsed_cookies',  # parsed cookie data
             );
 
 our $HTTPCode = {
@@ -167,7 +168,7 @@
 
     $self->{responseLine} = "HTTP/1.0 $code " . $self->http_code_english($code);
     $self->{code} = $code;
-    $self->{type} = "httpres";
+    $self->{type} = "res";
     $self->{vernum} = 1000;
 
     return $self;
@@ -257,6 +258,56 @@
     return $self->{uri};
 }
 
+sub parse_cookies {
+    my AxKit2::HTTPHeaders $self = shift;
+    my $raw_cookies = $self->header('Cookie');
+    $self->{parsed_cookies} = {};
+    foreach (split(/;\s+/, $raw_cookies)) {
+        my ($key, $value) = split("=", $_, 2);
+        my (@values) = map { uri_decode($_) } split(/&/, $value);
+        $key = uri_decode($key);
+        $self->{parsed_cookies}{$key} = \@values;
+    }
+}
+
+# From RFC-2109
+#    cookie-av       =       "Comment" "=" value
+#                    |       "Domain" "=" value
+#                    |       "Max-Age" "=" value
+#                    |       "Path" "=" value
+#                    |       "Secure"
+#                    |       "Version" "=" 1*DIGIT
+
+# my @vals = $hd_in->cookie($name);             # fetch a cookie values
+# $hd_out->cookie($name, $value);               # set a cookie
+# $hd_out->cookie($name, $value, path => "/");  # cookie with params
+# $hd_out->cookie($name, \@values, domain => "example.com");  # multivalue
+sub cookie {
+    my AxKit2::HTTPHeaders $self = shift;
+    my $name = shift;
+    if (@_) {
+        die "Cannot set cookies in the request"
+            if $self->{type} eq 'req';
+        # set cookie
+        my $value = shift;
+        my %params = @_;
+        
+        # special case for "secure"
+        my @params = delete($params{secure}) ? ("secure") : ();
+        # rest are key-value pairs
+        push @params, map { "$_=$params{$_}" } keys %params;
+        
+        my $key = uri_encode($name);
+        my $cookie = "$key=" . join("&", map uri_encode($_), ref($value) ? @$value : $value);
+        $self->header('Set-Cookie', join('; ', $cookie, @params));
+        return;
+    }
+    die "Cannot extract cookies from the response"
+        if $self->{type} eq 'res';
+    $self->parse_cookies unless $self->{parsed_cookies};
+    return @{$self->{parsed_cookies}{$name}} if exists $self->{parsed_cookies}{$name};
+}
+
 sub filename {
     my AxKit2::HTTPHeaders $self = shift;
     @_ and $self->{file} = shift;

Modified: trunk/lib/AxKit2/Utils.pm
===================================================================
--- trunk/lib/AxKit2/Utils.pm	2006-08-05 02:44:22 UTC (rev 43)
+++ trunk/lib/AxKit2/Utils.pm	2006-08-05 02:44:48 UTC (rev 44)
@@ -5,8 +5,18 @@
 
 use base 'Exporter';
 
-our @EXPORT_OK = qw(uri_decode http_date);
+our @EXPORT_OK = qw(uri_encode uri_decode http_date);
 
+sub uri_encode {
+    my $uri = shift;
+
+    # TODO: Support Unicode?
+    $uri =~ s/([^-.\w ])/sprintf('%%%02X', ord $1)/ge;
+    $uri =~ tr/ /+/;
+
+    return $uri;
+}
+
 sub uri_decode {
 	my $uri = shift;
 	return '' unless defined $uri;