view release on metacpan or  search on metacpan

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

use Apache2::RequestIO ();
use Apache2::Directive ();
use Apache2::Log ();
use Apache2::Module ();
use CGI::JSONRPC::Base;

use base qw(CGI::JSONRPC::Base Apache2::Module);

our $VERSION = "0.02";

__PACKAGE__->add([ CookOptions(
    [
        'JSONRPC_Class',
        'Perl class to dispatch JSONRPC calls to.',
    ],
)]);

return 1;


sub CookOptions { return(map { CookOption(@$_) } @_); }

sub CookOption {
    my($option, $help) = @_;
    return +{
        name            =>      $option,
        func            =>      join('::', __PACKAGE__, 'SetOption'),
        args_how        =>      TAKE1,
        req_override    =>      OR_ALL,
        $help ? (errmsg =>      "$option: $help") : (),
    };
}

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

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