Changeset 22986 for lang/perl/Moxy

Timestamp:

11/08/08 10:15:26 (2 months ago)

Author:

tokuhirom

Message:

use HTTP::Session for session management

Location:

lang/perl/Moxy/trunk

Files:

• Makefile.PL (modified) (1 diff)
• config.yaml.sample (modified) (1 diff)
• lib/Moxy.pm (modified) (11 diffs)
• lib/Moxy/Plugin/HTTPHeader.pm (modified) (3 diffs)
• lib/Moxy/Plugin/UserAgentSwitcher.pm (modified) (2 diffs)
• lib/Moxy/Plugin/UserID.pm (modified) (3 diffs)
• lib/Moxy/Session (added)
• lib/Moxy/Session/State (added)
• lib/Moxy/Session/State/BasicAuth.pm (added)
• lib/Moxy/Storage.pm (deleted)
• lib/Moxy/Storage/DBM_File.pm (deleted)
• t/Plugins/DisableTableTag.t (modified) (1 diff)
• t/Plugins/FlashUseImgTag.t (modified) (1 diff)
• t/Plugins/GPS-request.t (modified) (1 diff)
• t/Plugins/GPS-response.t (modified) (1 diff)
• t/Plugins/Pictogram.t (modified) (1 diff)
• t/Plugins/RefererCutter.t (modified) (1 diff)
• t/Plugins/Scrubber.t (modified) (1 diff)
• t/Plugins/StripScripts.t (modified) (1 diff)
• t/Session-State-BasicAuth.t (added)
• t/Storage-DBM_File.t (deleted)

lang/perl/Moxy/trunk/Makefile.PL

@@ -29 +29 @@
 requires 'HTTP::MobileAttribute';
 requires 'Path::Class';
+requires 'HTTP::Session' => 0.08;
 
 test_requires('Test::More');

lang/perl/Moxy/trunk/config.yaml.sample

@@ -8 +8 @@
   log:
     level: debug
-  storage:
-    module: DBM_File
-    file: /tmp/moxy.ndbm
-    dbm_class: NDBM_File
+  session:
+    state:
+      module: BasicAuth
+    store:
+      module: DBM
+      config:
+        file: /tmp/moxy.ndbm
+        dbm_class: NDBM_File
 
 plugins:

lang/perl/Moxy/trunk/lib/Moxy.pm

@@ -16 +16 @@
 use HTML::TreeBuilder::XPath;
 use HTML::TreeBuilder;
+use HTTP::Session;
 use LWP::UserAgent;
 use MIME::Base64;
@@ -52 +53 @@
     $self->conf->{global}->{log}->{fh} ||= \*STDERR;
 
-    $self->_init_storage;
-
     return $self;
 }
@@ -65 +64 @@
     };
 }
-
-# -------------------------------------------------------------------------
-
-sub _init_storage {
-    my ($self, ) = @_;
-
-    my $mod = $self->{config}->{global}->{storage}->{module};
-       $mod = $mod ? "Moxy::Storage::$mod" : 'Moxy::Storage::DBM_File';
-    $mod->use or die $@;
-    $self->{storage} = $mod->new($self, $self->conf->{global}->{storage} || {});
-}
-
-sub storage { shift->{storage} }
 
 # -------------------------------------------------------------------------
@@ -181 +167 @@
 sub handle_request {
     my ($self, $req) = @_;
-
-    my $session_id = join ',', $req->headers->authorization_basic;
-    $self->log(debug => "Authorization header: $session_id");
-    if ($session_id) {
-        return $self->_make_response(
-            req => $req,
-            user_id  => $session_id,
-        );
-    } else {
+    warn "HOGE";
+
+    my $conf = $self->conf->{global}->{session};
+    my $state_type = $conf->{state}->{module} || 'BasicAuth';
+    my $state = sub {
+        if ($state_type eq 'Cookie') {
+            require HTTP::Session::State::Cookie;
+            HTTP::Session::State::Cookie->new(
+                $conf->{state}->{config}
+            );
+        } else {
+            require Moxy::Session::State::BasicAuth;
+            Moxy::Session::State::BasicAuth->new(
+                $conf->{state}->{config} || {}
+            );
+        }
+    }->();
+    my $store = sub {
+        my $klass = "HTTP::Session::Store::$conf->{store}->{module}";
+        Class::MOP::load_class($klass);
+        $klass->new( $conf->{store}->{config} );
+    }->();
+
+    my $auth = join(',', $req->headers->authorization_basic);
+    if ($state->isa('Moxy::Session::State::BasicAuth') && !$auth) {
+        $self->log(debug => 'basicauth');
         return HTTP::Engine::Response->new(
             status => 401,
@@ -197 +200 @@
             body => 'authentication required',
         );
+    } else {
+        $self->log(debug => "session: state: $state, store: $store");
+        my $session = HTTP::Session->new(
+            state   => $state,
+            store   => $store,
+            request => $req,
+        );
+        $self->log(debug => "session: $session");
+        my $res = $self->_make_response(
+            req     => $req,
+            session => $session,
+        );
+        $session->response_filter($res);
+        return $res;
     }
 }
@@ -204 +221 @@
     my %args = validate(
         @_ => +{
-            req     => { isa  => 'HTTP::Engine::Request', },
-            user_id => { type => SCALAR },
+            req     => { isa => 'HTTP::Engine::Request', },
+            session => { type => OBJECT },
         }
     );
@@ -222 +239 @@
             url     => $url,
             request => $req->as_http_request,
-            user_id => $args{user_id},
+            session => $args{session},
         );
         $self->log(debug => '-- response status: ' . $res->code);
@@ -271 +288 @@
             url      => qr{^https?://},
             request  => { isa  => 'HTTP::Request' },
-            user_id  => { type => SCALAR },
+            session  => { type => OBJECT },
         }
     );
@@ -283 +300 @@
         'request_filter_process_agent',
         {   request => $req, # HTTP::Request object
-            user    => $args{user_id},
+            session => $args{session},
         }
     );
@@ -294 +311 @@
                 request          => $req,              # HTTP::Request object
                 mobile_attribute => $mobile_attribute,
-                user             => $args{user_id},
+                session          => $args{session},
             }
         );
@@ -322 +339 @@
                 response         => $response,           # HTTP::Response object
                 mobile_attribute => $mobile_attribute,
-                user             => $args{user_id},
+                session          => $args{session},
             }
         );

lang/perl/Moxy/trunk/lib/Moxy/Plugin/HTTPHeader.pm

@@ -10 +10 @@
     my ($self, $context, $args) = @_;
 
-    my $http_header = $context->storage->get(__PACKAGE__. $args->{user});
+    my $http_header = $args->{session}->get(__PACKAGE__);
 
     if ($http_header) {
@@ -35 +35 @@
             params      => \%params,
             current_uri => $args->{response}->request->uri,
-            headers     => $context->storage->get(__PACKAGE__ . $args->{user}),
+            headers     => $args->{session}->get(__PACKAGE__),
         }
     );
@@ -49 +49 @@
         # store settings
         my $r = CGI->new($args->{request}->content);
-        $context->storage->set(__PACKAGE__ . $args->{user} => $r->param('moxy_http_header'));
+        $args->{session}->set(__PACKAGE__ => $r->param('moxy_http_header'));
 
         # back

lang/perl/Moxy/trunk/lib/Moxy/Plugin/UserAgentSwitcher.pm

@@ -12 +12 @@
     my ($self, $context, $args) = @_;
 
-    my $user_agent = $context->storage->get('user_agent_' . $args->{user}) || 'KDDI-TS3G UP.Browser/6.2.0.7.3.129 (GUI) MMP/2.0';
+    my $user_agent = $args->{session}->get('user_agent') || 'KDDI-TS3G UP.Browser/6.2.0.7.3.129 (GUI) MMP/2.0';
     my $ua_info = $self->get_ua_info($context, $user_agent);
 
@@ -51 +51 @@
         # store settings
         my $r = CGI->new($args->{request}->content); # CGI.pm は遅いやん。他になんかないんかねー
-        $context->storage->set("user_agent_$args->{user}" => $r->param('moxy_user_agent'));
+        $args->{session}->set("user_agent" => $r->param('moxy_user_agent'));
 
         # back

lang/perl/Moxy/trunk/lib/Moxy/Plugin/UserID.pm

@@ -9 +9 @@
     my ($self, $context, $args) = @_;
 
-    my $key = join(',', __PACKAGE__, $args->{user}, $args->{mobile_attribute}->user_agent);
-    my $user_id = $context->storage->get($key);
+    my $key = join(',', __PACKAGE__, $args->{mobile_attribute}->user_agent);
+    my $user_id = $args->{session}->get($key);
     if ($user_id) {
         # au subscriber id.
@@ -31 +31 @@
 
         # store to user stash.
-        my $key = join(',', __PACKAGE__, $args->{user}, $args->{mobile_attribute}->user_agent);
-        $context->storage->set($key => $r->param('user_id'));
+        my $key = join(',', __PACKAGE__, $args->{mobile_attribute}->user_agent);
+        $args->{session}->set($key => $r->param('user_id'));
 
         my $response = HTTP::Response->new( 302, 'Moxy(UserID)' );
@@ -44 +44 @@
     return '' unless $args->{mobile_attribute}->is_ezweb || $args->{mobile_attribute}->is_docomo;
 
-    my $key = join(',', __PACKAGE__, $args->{user}, $args->{mobile_attribute}->user_agent);
-    my $user_id = $context->storage->get($key);
+    my $key = join(',', __PACKAGE__, $args->{mobile_attribute}->user_agent);
+    my $user_id = $args->{session}->get($key);
 
     return $self->render_template(

lang/perl/Moxy/trunk/t/Plugins/DisableTableTag.t

@@ -14 +14 @@
         global => {
             assets_path => catfile( $FindBin::Bin, '..', 'assets' ),
-            storage => {
-                module    => 'DBM_File',
-                file      => 't/testing.ndbm',
-                dbm_class => 'NDBM_File',
-            },
             'log' => {
                 level => 'info',

lang/perl/Moxy/trunk/t/Plugins/FlashUseImgTag.t

@@ -14 +14 @@
         global => {
             assets_path => catfile( $FindBin::Bin, '..', 'assets' ),
-            storage => {
-                module    => 'DBM_File',
-                file      => 't/testing.ndbm',
-                dbm_class => 'NDBM_File',
-            },
             'log' => {
                 level => 'info',

lang/perl/Moxy/trunk/t/Plugins/GPS-request.t

@@ -14 +14 @@
         global => {
             assets_path => catfile( $FindBin::Bin, '..', 'assets' ),
-            storage => {
-                module    => 'DBM_File',
-                file      => 't/testing.ndbm',
-                dbm_class => 'NDBM_File',
-            },
             'log' => {
                 level => 'info',

lang/perl/Moxy/trunk/t/Plugins/GPS-response.t

@@ -15 +15 @@
         global => {
             assets_path => catfile( $FindBin::Bin, '..', 'assets' ),
-            storage => {
-                module    => 'DBM_File',
-                file      => 't/testing.ndbm',
-                dbm_class => 'NDBM_File',
-            },
             'log' => {
                 level => 'info',

lang/perl/Moxy/trunk/t/Plugins/Pictogram.t

@@ -13 +13 @@
         global => {
             assets_path => File::Spec->catfile( $FindBin::Bin, '..', '..', 'assets' ),
-            storage => {
-                module    => 'DBM_File',
-                file      => 't/testing.ndbm',
-                dbm_class => 'NDBM_File',
-            },
             'log' => {
                 level => 'info',

lang/perl/Moxy/trunk/t/Plugins/RefererCutter.t

@@ -11 +11 @@
         global => {
             assets_path => File::Spec->catfile( $FindBin::Bin, '..', 'assets' ),
-            storage => {
-                module    => 'DBM_File',
-                file      => 't/testing.ndbm',
-                dbm_class => 'NDBM_File',
-            },
             'log' => {
                 level => 'info',

lang/perl/Moxy/trunk/t/Plugins/Scrubber.t

@@ -16 +16 @@
         global => {
             assets_path => catfile( $FindBin::Bin, '..', '..', 'assets' ),
-            storage => {
-                module    => 'DBM_File',
-                file      => 't/testing.ndbm',
-                dbm_class => 'NDBM_File',
-            },
             'log' => {
                 level => 'info',

lang/perl/Moxy/trunk/t/Plugins/StripScripts.t

@@ -16 +16 @@
         global => {
             assets_path => catfile( $FindBin::Bin, '..', '..', 'assets' ),
-            storage => {
-                module    => 'DBM_File',
-                file      => 't/testing.ndbm',
-                dbm_class => 'NDBM_File',
-            },
             'log' => {
                 level => 'info',