[Catalyst-commits] r8439 - in trunk/Catalyst-Plugin-Session-Store-DBIC: . lib/Catalyst/Plugin/Session/Store lib/Catalyst/Plugin/Session/Store/DBIC t t/lib/TestApp/Model/DBIC t/lib/TestApp/Schema

dwc at dev.catalyst.perl.org dwc at dev.catalyst.perl.org
Mon Sep 22 19:34:10 BST 2008


Author: dwc
Date: 2008-09-22 19:34:10 +0100 (Mon, 22 Sep 2008)
New Revision: 8439

Modified:
   trunk/Catalyst-Plugin-Session-Store-DBIC/Makefile.PL
   trunk/Catalyst-Plugin-Session-Store-DBIC/lib/Catalyst/Plugin/Session/Store/DBIC.pm
   trunk/Catalyst-Plugin-Session-Store-DBIC/lib/Catalyst/Plugin/Session/Store/DBIC/Delegate.pm
   trunk/Catalyst-Plugin-Session-Store-DBIC/t/04dbic.t
   trunk/Catalyst-Plugin-Session-Store-DBIC/t/05dbic-schema.t
   trunk/Catalyst-Plugin-Session-Store-DBIC/t/lib/TestApp/Model/DBIC/Session.pm
   trunk/Catalyst-Plugin-Session-Store-DBIC/t/lib/TestApp/Schema/Session.pm
Log:
Move the column_info check to the delegate, where the information is easier to access

Modified: trunk/Catalyst-Plugin-Session-Store-DBIC/Makefile.PL
===================================================================
--- trunk/Catalyst-Plugin-Session-Store-DBIC/Makefile.PL	2008-09-22 14:44:30 UTC (rev 8438)
+++ trunk/Catalyst-Plugin-Session-Store-DBIC/Makefile.PL	2008-09-22 18:34:10 UTC (rev 8439)
@@ -18,6 +18,7 @@
         'Storable'                                   => 0,
         'FindBin'                                    => 0,
         'Test::More'                                 => 0,
+        'Test::Warn'                                 => 0,
     },
     dist          => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
     clean         => { FILES => 'Catalyst-Plugin-Session-Store-DBIC-* MANIFEST META.yml README' },

Modified: trunk/Catalyst-Plugin-Session-Store-DBIC/lib/Catalyst/Plugin/Session/Store/DBIC/Delegate.pm
===================================================================
--- trunk/Catalyst-Plugin-Session-Store-DBIC/lib/Catalyst/Plugin/Session/Store/DBIC/Delegate.pm	2008-09-22 14:44:30 UTC (rev 8438)
+++ trunk/Catalyst-Plugin-Session-Store-DBIC/lib/Catalyst/Plugin/Session/Store/DBIC/Delegate.pm	2008-09-22 18:34:10 UTC (rev 8439)
@@ -3,8 +3,9 @@
 use strict;
 use warnings;
 use base qw/Class::Accessor::Fast/;
+use Carp qw/carp/;
 
-__PACKAGE__->mk_accessors(qw/model id_field _session_row _flash_row/);
+__PACKAGE__->mk_accessors(qw/model id_field data_field _session_row _flash_row/);
 
 =head1 NAME
 
@@ -82,7 +83,17 @@
 
     for (qw/_session_row _flash_row/) {
         my $row = $self->$_;
-        $row->update if $row and $row->in_storage;
+        next unless $row;
+
+        # Check the size if available to avoid silent trucation on e.g. MySQL
+        my $data_field = $self->data_field;
+        if (my $size = $row->result_source->column_info($data_field)->{size}) {
+            my $total_size = length($row->$data_field);
+            carp "This session requires $total_size bytes of storage, but your database column '$data_field' can only store $size bytes. Storing this session may not be reliable; increase the size of your data field"
+                if $total_size > $size;
+        }
+
+        $row->update if $row->in_storage;
     }
 
     $self->_clear_instance_data;
@@ -109,7 +120,7 @@
 
 =head1 COPYRIGHT
 
-Copyright 2006 Daniel Westermann-Clark, all rights reserved.
+Copyright 2006-2008 Daniel Westermann-Clark, all rights reserved.
 
 This program is free software; you can redistribute it and/or modify it
 under the same terms as Perl itself.

Modified: trunk/Catalyst-Plugin-Session-Store-DBIC/lib/Catalyst/Plugin/Session/Store/DBIC.pm
===================================================================
--- trunk/Catalyst-Plugin-Session-Store-DBIC/lib/Catalyst/Plugin/Session/Store/DBIC.pm	2008-09-22 14:44:30 UTC (rev 8438)
+++ trunk/Catalyst-Plugin-Session-Store-DBIC/lib/Catalyst/Plugin/Session/Store/DBIC.pm	2008-09-22 18:34:10 UTC (rev 8439)
@@ -154,8 +154,9 @@
     my ($c, $id) = @_;
 
     Catalyst::Plugin::Session::Store::DBIC::Delegate->new({
-        model    => $c->session_store_model($id),
-        id_field => $c->session_store_dbic_id_field,
+        model      => $c->session_store_model($id),
+        id_field   => $c->session_store_dbic_id_field,
+        data_field => $c->session_store_dbic_data_field,
     });
 }
 
@@ -179,36 +180,13 @@
 
     my $accessor = sub { shift->$type($key)->$field(@_) };
 
-    my $data_field = $c->session_store_dbic_data_field;
-    if ($field eq $data_field) {
-        my @new_args;
-        my $total_size = 0;
-        foreach my $arg (@args) {
-            my $value = MIME::Base64::encode(Storable::nfreeze($arg || ''));
-            $total_size += length($value);
-            push @new_args, $value;
-        }
-
-        $DB::single = 1;
-        my $size;
-        if ($c->session_store_model->can('column_info')) {
-            # A DBIx::Class object.
-            $size = $c->session_store_model->column_info($data_field)->{size};
-        } elsif ($c->session_store_model->can('result_source')) {
-            # A DBIx::Class::ResultSet object.
-            $size = $c->session_store_model->result_source->column_info($data_field)->{size};
-        }
-        if ($size && $total_size > $size) {
-           warn "This session requires $total_size bytes of storage, but your database column '$data_field' can only store $size bytes. Cannot store session";
-           @new_args = ();
-        }
-
+    if ($field eq $c->session_store_dbic_data_field) {
+        @args = map { MIME::Base64::encode(Storable::nfreeze($_ || '')) } @args;
         $accessor = sub {
             my $value = shift->$type($key)->$field(@_);
             return unless defined $value;
             return Storable::thaw(MIME::Base64::decode($value));
         };
-        @args = @new_args;
     }
 
     return ($accessor, @args);
@@ -316,10 +294,18 @@
 The C<session_data> column should be a long text field.  Session data
 is encoded using L<MIME::Base64> before being stored in the database.
 
-Note that MySQL TEXT fields only store 64KB, so if your session data 
-will exceed that size you'll want to move to MEDIUMTEXT, MEDIUMBLOB, 
-or larger.
+Note that MySQL C<TEXT> fields only store 64 kB, so if your session
+data will exceed that size you'll want to use C<MEDIUMTEXT>,
+C<MEDIUMBLOB>, or larger. If you configure your
+L<DBIx::Class::ResultSource> to include the size of the column, you
+will receive warnings for this problem:
 
+    This session requires 1180 bytes of storage, but your database
+    column 'session_data' can only store 200 bytes. Storing this
+    session may not be reliable; increase the size of your data field
+
+See L<DBIx::Class::ResultSource/add_columns> for more information.
+
 The C<expires> column stores the future expiration time of the
 session.  This may be null for per-user and flash sessions.
 
@@ -350,7 +336,7 @@
 
 =head1 COPYRIGHT
 
-Copyright 2006,2008 Daniel Westermann-Clark, all rights reserved.
+Copyright 2006-2008 Daniel Westermann-Clark, all rights reserved.
 
 This program is free software; you can redistribute it and/or modify it
 under the same terms as Perl itself.

Modified: trunk/Catalyst-Plugin-Session-Store-DBIC/t/04dbic.t
===================================================================
--- trunk/Catalyst-Plugin-Session-Store-DBIC/t/04dbic.t	2008-09-22 14:44:30 UTC (rev 8438)
+++ trunk/Catalyst-Plugin-Session-Store-DBIC/t/04dbic.t	2008-09-22 18:34:10 UTC (rev 8439)
@@ -4,6 +4,7 @@
 use warnings;
 use FindBin;
 use Test::More;
+use Test::Warn;
 
 use lib "$FindBin::Bin/lib";
 
@@ -17,7 +18,7 @@
     eval { require Test::WWW::Mechanize::Catalyst }
         or plan skip_all => "Test::WWW::Mechanize::Catalyst is required for this test";
 
-    plan tests => 15;
+    plan tests => 14;
 
     $ENV{TESTAPP_DB_FILE} = "$FindBin::Bin/session.db";
 
@@ -65,9 +66,9 @@
 
 # Exceed our session storage capactity
 $value = "blah" x 200;
-$mech->get_ok("http://localhost/session/setup?key=$key&value=$value", 'exceeding storage capacity');
-$mech->get_ok("http://localhost/session/output?key=$key", 'request to get session value');
-$mech->content_lacks($value, 'value is not set');
+warning_like {
+    $mech->get_ok("http://localhost/session/setup?key=$key&value=$value", 'exceeding storage capacity');
+} qr/^This session requires \d+ bytes of storage, but your database column 'data' can only store 200 bytes. Storing this session may not be reliable; increase the size of your data field/;
 
 # Delete session
 $mech->get_ok('http://localhost/session/delete', 'request to delete session');

Modified: trunk/Catalyst-Plugin-Session-Store-DBIC/t/05dbic-schema.t
===================================================================
--- trunk/Catalyst-Plugin-Session-Store-DBIC/t/05dbic-schema.t	2008-09-22 14:44:30 UTC (rev 8438)
+++ trunk/Catalyst-Plugin-Session-Store-DBIC/t/05dbic-schema.t	2008-09-22 18:34:10 UTC (rev 8439)
@@ -4,6 +4,7 @@
 use warnings;
 use FindBin;
 use Test::More;
+use Test::Warn;
 
 use lib "$FindBin::Bin/lib";
 
@@ -20,7 +21,7 @@
     eval { require Catalyst::Model::DBIC::Schema }
         or plan skip_all => "Catalyst::Model::DBIC::Schema is required for this test";
 
-    plan tests => 15;
+    plan tests => 14;
 
     $ENV{TESTAPP_DB_FILE} = "$FindBin::Bin/session.db";
 
@@ -65,9 +66,9 @@
 
 # Exceed our session storage capactity
 $value = "blah" x 200;
-$mech->get_ok("http://localhost/session/setup?key=$key&value=$value", 'exceeding storage capacity');
-$mech->get_ok("http://localhost/session/output?key=$key", 'request to get session value');
-$mech->content_lacks($value, 'value is not set');
+warning_like {
+    $mech->get_ok("http://localhost/session/setup?key=$key&value=$value", 'exceeding storage capacity');
+} qr/This session requires \d+ bytes of storage, but your database column 'data' can only store 200 bytes. Storing this session may not be reliable; increase the size of your data field/;
 
 # Delete session
 $mech->get_ok('http://localhost/session/delete', 'request to delete session');

Modified: trunk/Catalyst-Plugin-Session-Store-DBIC/t/lib/TestApp/Model/DBIC/Session.pm
===================================================================
--- trunk/Catalyst-Plugin-Session-Store-DBIC/t/lib/TestApp/Model/DBIC/Session.pm	2008-09-22 14:44:30 UTC (rev 8438)
+++ trunk/Catalyst-Plugin-Session-Store-DBIC/t/lib/TestApp/Model/DBIC/Session.pm	2008-09-22 18:34:10 UTC (rev 8439)
@@ -7,7 +7,15 @@
 use warnings;
 
 __PACKAGE__->table('sessions');
-__PACKAGE__->add_columns('id', 'data', { size => 200 }, 'expires');
+__PACKAGE__->add_columns(
+    id => {
+    },
+    data => {
+        size => 200,
+    },
+    expires => {
+    },
+);
 __PACKAGE__->set_primary_key('id');
 
 1;

Modified: trunk/Catalyst-Plugin-Session-Store-DBIC/t/lib/TestApp/Schema/Session.pm
===================================================================
--- trunk/Catalyst-Plugin-Session-Store-DBIC/t/lib/TestApp/Schema/Session.pm	2008-09-22 14:44:30 UTC (rev 8438)
+++ trunk/Catalyst-Plugin-Session-Store-DBIC/t/lib/TestApp/Schema/Session.pm	2008-09-22 18:34:10 UTC (rev 8439)
@@ -7,7 +7,15 @@
 __PACKAGE__->load_components(qw/Core/);
 
 __PACKAGE__->table('sessions');
-__PACKAGE__->add_columns('id', { }, 'data', { size => 200 }, 'expires', { });
+__PACKAGE__->add_columns(
+    id => {
+    },
+    data => {
+        size => 200,
+    },
+    expires => {
+    },
+);
 __PACKAGE__->set_primary_key('id');
 
 1;




More information about the Catalyst-commits mailing list