Redesigning cookies & sessions #1, #2

khrt · Jan 23, 2013 · 6d80bf5 · 6d80bf5
1 parent ca0e57a
commit 6d80bf5
Show file tree

Hide file tree

Showing 17 changed files with 154 additions and 211 deletions.
diff --git a/examples/base/fwapp.pl b/examples/base/fwapp.pl
@@ -95,10 +95,13 @@
 get '/session/set' => sub {
     my $self = shift;
 
-    $self->session(test => 'value');
-    $self->session(value => 'test');
+    my $test = $self->param('test') || 'default';
+    my $value = $self->param('value') || 'default';
 
-    $self->render(text => 'Set cookie.');
+    $self->session(test => $test);
+    $self->session(value => $value);
+
+    $self->render(text => "Set cookie: test => `$test`, value => `$value`.");
 };
 
 get '/session/get' => sub {
@@ -110,6 +113,7 @@
     $self->render(text => "Get cookie: $p1/$p2");
 };
 
+app->secret('verysecret');
 app->start;
 
 __DATA__
diff --git a/lib/Kompot.pm b/lib/Kompot.pm
@@ -1,24 +1,20 @@
 package Kompot;
 
-use v5.12;
-
 use strict;
 use warnings;
 
 use utf8;
+use v5.12;
 
 our $VERSION = '0.11';
 
 use FindBin;
-use lib $FindBin::Bin;
-
-use DDP output => 'stdout';
 
 use base 'Exporter';
+use lib $FindBin::Bin;
 
 use Kompot::App;
 
-
 our @EXPORT = qw(
     delete get head options post put any
     app start
@@ -37,19 +33,19 @@ sub import {
 sub _app   { Kompot::App->app }
 sub _start { _app->run }
 
-
 ### Export subs
 
 sub app   { __PACKAGE__ }
 sub start { goto &_start }
 
+sub secret { _app->secret(@_) }
+
 sub delete  { _app->route->add(['delete'],  @_) }
 sub get     { _app->route->add(['get'],     @_) }
 sub head    { _app->route->add(['head'],    @_) }
 sub options { _app->route->add(['options'], @_) }
 sub post    { _app->route->add(['post'],    @_) }
 sub put     { _app->route->add(['put'],     @_) }
-
 sub any     { _app->route->add([qw(delete get head post put)], @_) }
 
 

diff --git a/lib/Kompot/App.pm b/lib/Kompot/App.pm
@@ -1,12 +1,12 @@
 package Kompot::App;
 
-use v5.12;
-
 use strict;
 use warnings;
 
 use utf8;
+use v5.12;
 
+use Carp;
 use DDP { output => 'stdout' };
 
 use base 'Kompot::Base';
@@ -16,13 +16,18 @@ use Kompot::Handler;
 use Kompot::Renderer;
 use Kompot::Routes;
 
-
 sub name { 'Kompot' . $Kompot::VERSION }
 
-# XXX NEED SECRET
 sub secret {
     my ($self, $value) = @_;
-    state $secret = $value;
+
+    state $secret;
+
+    if ($value) {
+        carp 'set secret value';
+        $secret = $value;
+    }
+
     return $secret;
 }
 
@@ -31,7 +36,7 @@ sub request {
 
     state $_request;
 
-    if ( scalar @_ ) {
+    if (scalar @_) {
         $_request = Kompot::Request->new(@_);
     }
 
@@ -45,7 +50,7 @@ sub routes { state $_route ||= Kompot::Routes->new }
 sub route  { goto &routes }
 
 sub config { state $_config ||= Kompot::Config->new }
-sub dir { shift->config }
+sub dir { goto &config }
 
 #
 # Main function
@@ -55,6 +60,11 @@ sub run {
     my $cfg = $self->config;
 #p($cfg);
 
+    if (not $self->secret) {
+        carp 'no secret';
+        return;
+    }
+
     my $handler = Kompot::Handler->new;
 #p($handler);
 
@@ -64,7 +74,6 @@ sub run {
     return $response;
 }
 
-
 1;
 
 __END__
diff --git a/lib/Kompot/Base.pm b/lib/Kompot/Base.pm
@@ -1,28 +1,31 @@
 package Kompot::Base;
 
-use v5.12;
-
 use strict;
 use warnings;
 
 use utf8;
+use v5.12;
 
+use Carp;
+
+#sub import {
+#    my $class = shift;
+#}
 
 sub new {
     my $class = shift;
 
-    my $self = bless({}, ref($class) || $class);
-
+    my $self = bless {}, ref $class || $class;
     $self->init(@_);
 
     return $self;
 }
 
+# default initializer
 sub init {1}
 
 sub app { state $_app ||= Kompot::App->new }
 
-
 1;
 
 __END__
diff --git a/lib/Kompot/Controller.pm b/lib/Kompot/Controller.pm
@@ -1,22 +1,27 @@
 package Kompot::Controller;
 
-use v5.12;
-
 use strict;
 use warnings;
 
 use utf8;
+use v5.12;
 
 use DDP { output => 'stdout' };
 
 use base 'Kompot::Base';
 
 use Kompot::Renderer;
+use Kompot::Session;
 
 sub init {
     my $self = shift;
 
     $self->{req} = shift;
+
+    # Init session
+    $self->session(Kompot::Session->new->load_params($self->{req}->cookies));
+
+    return 1;
 }
 
 sub req { shift->{req} }
@@ -40,7 +45,7 @@ sub stash {
     return $stash if not @_;
 
     # one
-    return $stash->{ $_[0] } if @_ == 1;
+    return $stash->{ $_[0] } if @_ == 1 and not ref $_[0];
 
     # new
     my $v = @_ % 2 ? $_[0] : {@_};
@@ -51,15 +56,14 @@ sub stash {
 
 sub session {
     my $self = shift;
-p @_;
 
     my $session = $self->stash->{'kompot.session'} ||= {};
 
     # all
     return $session if not @_;
 
     # one
-    return $session->{ $_[0] } if @_ == 1;
+    return $session->{ $_[0] } if @_ == 1 and not ref $_[0];
 
     # new
     my $v = @_ % 2 ? $_[0] : {@_};
@@ -75,16 +79,20 @@ sub render {
 
     my $template = $p->{template} ? $p->{template} : undef;
 
-
     my $text = $p->{text};
     my $json = $p->{json};
 
-
     my $app = $self->app;
 
-    $app->render->dynamic($self, $p);
-}
+    my $r = $app->render->dynamic($self, $p);
+    if ($r && $r->status == 200) {
+        # Set cookie
+        my $cookie = Kompot::Session->new->generate_cookie($self->session);
+        $r->set_cookie($cookie->to_string) if $cookie;
+    }
 
+    return $r;
+}
 
 1;
 

diff --git a/lib/Kompot/Cookie.pm b/lib/Kompot/Cookie.pm
@@ -1,11 +1,10 @@
 package Kompot::Cookie;
 
-use v5.12;
-
 use strict;
 use warnings;
 
 use utf8;
+use v5.12;
 
 use DDP { output => 'stdout' };
 use Carp;
@@ -15,15 +14,16 @@ use base 'Kompot::Base';
 
 sub init {
     my $self = shift;
-
     my $cookie = @_ % 2 ? $_[0] : {@_};
 
     if (ref($cookie)) {
-        map { $self->{$_} = $cookie->{$_} // undef }
-            qw(name value domain secure http_only);
-
-        $self->{path} = $cookie->{path} || '/';
-        $self->{expires} = $self->_expires($cookie->{expires});
+        $self->{name}      = $cookie->{name}      || 'kompot';
+        $self->{value}     = $cookie->{value}     || '';
+        $self->{path}      = $cookie->{path}      || '/';
+        $self->{expires}   = $self->_expires($cookie->{expires});
+        $self->{domain}    = $cookie->{domain}    || '';
+        $self->{secure}    = $cookie->{secure}    || '';
+        $self->{http_only} = $cookie->{http_only} || 1;
     }
     else {
         $self->parse($cookie);
@@ -32,33 +32,18 @@ sub init {
     return 1;
 }
 
-###
-sub name      { shift->{name}  }
-sub path      { shift->{path}  }
-sub value     { shift->{value} }
-sub expires   { shift->{expires} }
-sub domain    { shift->{domain}  }
-sub secure    { defined(shift->{secure})    ? 1 : 0 }
-sub http_only { defined(shift->{http_only}) ? 1 : 0 }
-###
+sub name { shift->{name} }
+sub value { shift->{value} }
 
 sub parse {
     my ($self, $cookie) = @_;
 
     my ($name, $value) = split(/\s*=\s*/, $cookie, 2);
 
     $self->{name}  = $name;
-    $self->{value} = $value;
+    $self->{value} = uri_unescape($value);
 
-    my @values;
-
-    if ($value) {
-        @values = map { uri_unescape($_) } split(/[&;]/, $value);
-    }
-
-    $self->{_values} = \@values;
-
-    return $self;
+    return 1;
 }
 
 sub to_string {
@@ -76,7 +61,6 @@ sub to_string {
     push @cookie, 'HttpOnly' if $self->{http_only};
 
     my $cookie_str = join '; ', @cookie;
-say ">>cookie_str--$cookie_str<<";
 
     if (length $cookie_str > 4096) {
         carp 'cookie > 4096';