view release on metacpan or  search on metacpan

lib/Apache2/JSONRPC/Session.pm  view on Meta::CPAN

package Apache2::JSONRPC::Session;
use strict;
use Apache2::JSONRPC;
use CGI::JSONRPC::Dispatcher::Session;
use base qw(Apache2::JSONRPC);

1;

sub new {
   my ($class,%args) = @_;
   %args = __PACKAGE__->init_session(%args);
   return bless { dispatcher => $class->default_dispatcher, %args }, $class;
}

sub _generate_sid {
  my ($class,$r) = @_;
  # ok this makes me feel dirty but it's either use the id generate from
  # CGI::Session, roll our own or don't depend on the POST data not getting
  # messed with.  Personally I feel safer using the CGI::Session id generator
  
  # this "borrowed" from CGI::Session::ID::md5 as a middle ground position

  require Digest::MD5;
  my $md5 = new Digest::MD5();
  $md5->add($$ , time() , rand(time) );
   return $md5->hexdigest();
}

sub cgi_session_dsn {
  my $class = shift;
  return "driver:file;serializer:yaml";
}

# should set the args with a 'session' key
sub init_session {
   my ($class,%args) = @_;
   
   require CGI::Session; 
   require CGI::Cookie;

   my $r = $args{request};
   my $id = $class->_have_cookie($r);
   # if $id is undef or somesuch then CGI::Session needs a CGI object (for what
   # reason I don't know).  So in that case we'll buff $id with a session_id we
   # generate
   $id = $class->_generate_sid($r) unless $id;
   my $session;
 
   $session = CGI::Session->new($class->cgi_session_dsn(), $id);  
   $session->flush(); # could be new?
   $args{session} = $session;

   my $cookie = CGI::Cookie->new(-name => 'CGISESSID', -value => $session->id );
   $r->headers_out->add('Set-Cookie', $cookie );

   return %args;      
}

sub _have_cookie {
  my ($self,$r) = @_;
  if(my $cookie_jar = CGI::Cookie->fetch($r)) {
       if($cookie_jar->{CGISESSID}) {
           return $cookie_jar->{CGISESSID}->value;
       }
   }

   return;

}

=pod