Skip to content
Browse files

coockies

  • Loading branch information...
1 parent 77cf429 commit 75eb57ea8c646641c93b156958d490cfdbb88922 Aliaksandr Zahatski committed Jan 21, 2012
Showing with 175 additions and 95 deletions.
  1. +37 −5 lib/WebDAO/CV.pm
  2. +32 −0 lib/WebDAO/Response.pm
  3. +4 −5 lib/WebDAO/Session0.pm
  4. +11 −81 script/webdao.psgi
  5. +91 −4 t/16_cv.t
View
42 lib/WebDAO/CV.pm
@@ -10,8 +10,10 @@ use URI;
use Data::Dumper;
use strict;
use warnings;
-#use WebDAO::Base;
-#use base qw( WebDAO::Base );
+use WebDAO::Base;
+use base qw( WebDAO::Base );
+
+__PACKAGE__->mk_attr(status=>200);
sub new {
my $class = shift;
@@ -99,18 +101,19 @@ return params (currently only from GET)
sub param {
my $self = shift;
- return { $self->url()->query_form };
+ my $params = { $self->url()->query_form };
+ return keys %$params unless @_;
+ return $params->{$_[0]};
}
=head2 set_header
- $cv->set_header("Content_Type" => 'text/html; charset=utf-8')
+ $cv->set_header("Content-Type" => 'text/html; charset=utf-8')
=cut
sub set_header {
my ( $self, $name, $par ) = @_;
- $name = uc $name;
#collect -cookies
if ( $name eq '-COOKIE' ) {
@@ -120,6 +123,35 @@ sub set_header {
$self->{headers}->{$name} = $par;
}
}
+
+=head3 print_headers [ header1=>value, ...]
+
+Method for output headers
+
+=cut
+
+sub print_headers {
+ my $self = shift;
+ #merge in and exists headers
+ my %headers = ( %{ $self->{headers} } , @_ );
+ my $status = $self->status;
+ my $fd = $self->{writer}->([$status||"200", [%headers], undef]);
+ $self->{fd} = $fd;
+}
+
+sub print {
+ my $self = shift;
+ if (exists $self->{fd}) {
+ foreach my $line (@_) {
+ utf8::encode( $line) if utf8::is_utf8($line);
+ $self->{fd}->write($line);
+ }
+ } else {
+ print @_;
+ }
+}
+
+
1;
View
32 lib/WebDAO/Response.pm
@@ -71,6 +71,38 @@ sub get_header {
return $self->_headers->{ uc $name };
}
+=head2 aliases for headers
+
+=head3 content_type
+
+ $r->content_type('text/html; charset=utf-8');
+
+=cut
+
+sub content_type {
+ my $self = shift;
+ unless ($#_ > 0 ) {
+ $self->set_header('Content-Type', @_)
+ }
+ $self->get_header('Content-Type');
+}
+
+=head3 content_length
+
+A decimal number indicating the size in bytes of the message content.
+
+=cut
+
+sub content_length {
+ my $self = shift;
+ unless ($#_ > 0 ) {
+ $self->set_header('Content-Length' , @_)
+ }
+ $self->get_header('Content-Length');
+}
+
+=head3
+
=head2 get_mime_for_filename <filename>
Determine mime type for filename (Simple by ext);
View
9 lib/WebDAO/Session0.pm
@@ -12,6 +12,7 @@ use Encode qw(encode decode is_utf8);
use WebDAO::Session;
use base qw( WebDAO::Session );
use WebDAO::CV;
+use WebDAO::Response0;
#sub new {
# my $class = shift;
@@ -31,7 +32,7 @@ sub Init {
my $cv = $self->Cgi_obj; # Store Cgi_obj in local var
#create response object
$self->_response_obj(
- new WebDAO::Response::
+ new WebDAO::Response0::
session => $self,
cv => $cv
);
@@ -59,17 +60,15 @@ sub Init {
#save request method
$self->request_method($cv->method);
#set default header
- $cv->set_header("Content_Type" => 'text/html; charset=utf-8');
- #$cv->set_header( -type => 'text/html; charset=utf-8' );
-
+ $cv->set_header("Content-Type" => 'text/html; charset=utf-8');
}
#Get cgi params;
sub _get_params {
my $self = shift;
my $_cgi = $self->Cgi_obj();
my %params;
- foreach my $i ( $_cgi->param() ) {
+ foreach my $i ( $_cgi->param() ) {
my @all = $_cgi->param($i);
foreach my $value (@all) {
next if ref $value;
View
92 script/webdao.psgi
@@ -6,78 +6,6 @@
# AUTHOR: Aliaksandr P. Zahatski (Mn), <zag@cpan.org>
#===============================================================================
-package WebDAO::CVpsgi;
-use strict;
-use warnings;
-use CGI::Simple;
-use WebDAO::CVcgi;
-use base qw/WebDAO::CVcgi/;
-__PACKAGE__->mk_attr( _cb =>undef, _env => undef);
-sub _init {
- my $self = shift;
- my ($env, $cb) = @_;
- $self->_cb($cb);
- $self->_env($env);
- $self->SUPER::_init(CGI::Simple->new($env->{QUERY_STRING}));
- 1;
-}
-sub http {return}
-sub url {
- my $self = shift;
-
- my $env = $self->_env;
-
- my $uri = #($env->{'psgi.url_scheme'} || "http") .
- #"://" .
-# ($env->{HTTP_HOST} || (($env->{SERVER_NAME} || "") . ":" . ($env->{SERVER_PORT} || 80))) .
- ($env->{SCRIPT_NAME} || $env->{PATH_INFO} || '/');
-
- return $uri;
-}
-sub query_string{ $_[0]->{env}->{QUERY_STRING} };
-sub referer{""}
-sub param {{}};
-
-sub response {
- my $self = shift;
- my $res = shift || return;
- if ( my $headers = delete $res->{headers} ) {
- my $cgi = $self->Cgi_obj;
- my %out_headers = %{ $self->_headers };
- my $status = $res->{'headers'}->{'-STATUS'} || "200" ;
- while ( my ($key, $val) = each %{ $headers } ) {
- # aggregate cookies
- if ( $key eq '-COOKIE' ) {
- push @{ $out_headers{$key} }, $val;
- }
- else {
- $out_headers{$key} = $val;
- }
-
- }
- my @headers = split(/[\n\r]+/, $cgi->header(%out_headers));
- my $fd = $self->_cb->([$status,\@headers,undef]);
-# $fd->write("ok");
-# $fd->close();
-# warn "out geader";
- $self->{fd} = $fd;
- }
-# use Data::Dumper;
-# warn "Resr" . Dumper($res) ;
- $self->print ($res->{data})
-# $self->SUPER::response($res);
-}
-
-sub print {
- my $self = shift;
- if (exists $self->{fd}) {
- $self->{fd}->write(@_);
- } else {
- print @_;
- }
-
-}
-1;
package main;
use strict;
use warnings;
@@ -87,32 +15,34 @@ use WebDAO::CV;
my $handler = sub {
my $env = shift;
+ die "Only psgi.streaming=1 servers supported !"
+ unless $env->{'psgi.streaming'};
my $coderef = shift;
- $env->{wdEngine} = $env->{HTTP_WDENGINE};
- $env->{wdSession} = $env->{HTTP_WDSESSION};
- warn "use $env->{wdSession}";
+ $env->{wdEnginePar} = $ENV{wdEnginePar} || $env->{HTTP_WDENGINEPAR} ;
+ $env->{wdEngine} = $ENV{wdEngine} || $env->{HTTP_WDENGINE} ;
+ $env->{wdSession} = $ENV{wdSession} || $env->{HTTP_WDSESSION} || 'WebDAO::Session0' ;
my $ini = WebDAO::Util::get_classes(__env => $env, __preload=>1);
-# use Data::Dumper;
-# warn Dumper $ini;
my $store_obj = "$ini->{wdStore}"->new(
%{ $ini->{wdStorePar} }
);
my $cv = WebDAO::CV->new(env=>$env, writer=>$coderef);
+
my $sess = "$ini->{wdSession}"->new(
%{ $ini->{wdSessionPar} },
store => $store_obj,
cv => $cv,
);
+# warn "use $env->{wdSession}, $ini->{wdEngine}";
my $eng = "$ini->{wdEngine}"->new(
%{ $ini->{wdEnginePar} },
session => $sess,
);
- $sess->set_header( -type => 'text/html; charset=utf-8' );
+ #set default header
+# $sess->set_header("content-Type" => 'text/html; charset=utf-8');
$sess->ExecEngine($eng);
-# my $fd = $coderef->([ 200, ['Content-Type' => 'text/plain'], undef]);
-# $fd->write("Hello ");
-
+ use Data::Dumper;
+ $cv->{fd}->write('<pre>'.Dumper($env).'</pre>');
#close psgi
$cv->{fd}->close() if exists $cv->{fd};
$sess->destroy;
View
95 t/16_cv.t
@@ -5,18 +5,39 @@
# AUTHOR: Aliaksandr P. Zahatski, <zahatski@gmail.com>
#===============================================================================
#$Id$
-package WebDAO::CV;
-use Data::Dumper;
+package Test::Writer;
+sub new {
+ my $class = shift;
+ my $self = bless( ( $#_ == 0 ) ? shift : {@_}, ref($class) || $class );
+}
+sub write { ${ $_[0]->{out} } . $_[1] }
+sub close { }
+sub headers { return { @{ $_[0]->{headers} } } }
1;
use strict;
use warnings;
+sub make_cv {
+my %args = @_;
+my $out;
+my $cv = WebDAO::CV->new(
+ env => $args{env},
+ writer => sub {
+ new Test::Writer::
+ out => \$out,
+ status => $_[0]->[0],
+ headers => $_[0]->[1];
+ }
+);
+
+}
#use Test::More tests => 1; # last test to print
use Test::More 'no_plan';
use_ok('WebDAO::CV');
+my $out = '';
my $fcgi = WebDAO::CV->new(
env => {
'FCGI_ROLE' => 'RESPONDER',
@@ -26,6 +47,12 @@ my $fcgi = WebDAO::CV->new(
'REQUEST_METHOD' => 'GET',
'HTTP_ACCEPT' =>
'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8',
+ },
+ writer => sub {
+ new Test::Writer::
+ out => \$out,
+ status => $_[0]->[0],
+ headers => $_[0]->[1];
}
);
@@ -40,6 +67,66 @@ is_deeply $fcgi->accept,
'text/html' => undef
},
'accept';
+is_deeply {
+ map { $_ => $fcgi->param($_) } $fcgi->param()
+}, { '23' => '23' }, 'GET params';
+
+$fcgi->set_header( "Content-Type" => 'text/html; charset=utf-8' );
+my $wr = $fcgi->print_headers();
+
+is_deeply $wr->{headers},
+ [ 'Content-Type' => 'text/html; charset=utf-8' ], "set headers";
+is $wr->{status}, 200, 'Status: 200';
+
+use_ok('WebDAO::Response0');
+my $cv1 = &make_cv;
+my $r = new WebDAO::Response0:: cv=>$cv1;
+$r->content_type('text/html; charset=utf-8');
+$r->content_length(2345);
+$r->print_header();
+
+use CGI;
+my $c = new CGI;
+my $q1 = $c->cookie( {
+ -NAME => "srote",
+ -EXPIRES => "+3M",
+ -PATH => "/Err",
+ -VALUE => { "1"=>"2", "ewe"=>1}
+ }
+);
+my $q2 = $c->cookie( {
+ -NAME => "olol",
+ -EXPIRES => "+3M",
+ -PATH => "/",
+ -VALUE => "oh"
+ }
+);
+my $q3 = $c->cookie( {
+ -NAME => "olol",
+ -EXPIRES => "+3M",
+ -PATH => "/",
+ -VALUE => "ohhhhhh"
+ }
+);
+use Data::Dumper;
+diag Dumper $q2;
+diag $c->header(-cookie=>[$q1, $q2, $q3]);
+diag Dumper $cv1->{fd}->headers;
+
+package WebDAO::CV;
+use Data::Dumper;
+
+=head2 get_cookie
+
+=cut
+
+sub get_cookie {
+ my $self = shift;
+}
+
+1;
+
+
+#use CGI;;
+#print CGI->new()->header(-status=>'200 Not Found');
-is_deeply $fcgi->param(), { '23' => '23' }, 'GET params';
-print Dumper $fcgi->set_header("Content_Type" => 'text/html; charset=utf-8')

0 comments on commit 75eb57e

Please sign in to comment.
Something went wrong with that request. Please try again.