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} = [EMAIL PROTECTED];
+ }
+}
+
+# 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, [EMAIL PROTECTED], 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;
