The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.


<Files "*.cgi">
    Options     +ExecCGI
    SetHandler  cgi-script
</Files>


<IfModule mod_perl.c>
    PerlLoadModule Apache2::JSONRPC
    PerlLoadModule CGI::JSONRPC::Dispatcher

    <Location /json-rpc>
        SetHandler              perl-script
        PerlOptions             +GlobalRequest
        PerlResponseHandler     Apache2::JSONRPC->handler
        JSONRPC_Class           CGI::JSONRPC::Dispatcher
    </Location>

    PerlLoadModule Apache2::JSONRPC::Session
    PerlLoadModule CGI::JSONRPC::Dispatcher::Session

    <Location /json-rpc-session>
       SetHandler              perl-script
       PerlOptions             +GlobalRequest
       PerlResponseHandler     Apache2::JSONRPC::Session->handler
       JSONRPC_Class           CGI::JSONRPC::Dispatcher::Session
    </location>


    <Perl>

  # Hello test object
  {
            package Hello;
        
            use Apache2::RequestRec;
            use Apache2::RequestUtil;
            use Apache2::Connection;
        
            sub jsonrpc_new {
                my($class, $id) = @_;
                return bless { id => $id }, $class;
            }
        
            sub who_am_i {
                my $r = Apache2::RequestUtil->request;
                return $r->connection->remote_ip;
            }

            sub jsonrpc_javascript {
                return <<"EOT";
Create_Class("Hello", "JSONRPC");

Hello.prototype.who_am_i = function () {
    this.Call_Server(this.who_i_am, "who_am_i");
}

Hello.prototype.who_i_am = function (ip) {
    alert("Your IP is " + ip);
}
EOT
            }
  }



  # LWP test object
  {
        use LWP::UserAgent;
        package LWP::UserAgent;
    
        sub jsonrpc_new {
            my $class = shift;
            return $class->new(@_);
        }
    
        sub jsonrpc_javascript {
            return <<"EOT";

            Create_Class("LWP.UserAgent", "JSONRPC");
            LWP.UserAgent.prototype.get_page = function (url) {
                LWPer.Call_Server(this.write_page, "get", url);
            };
            LWP.UserAgent.prototype.write_page = function (result) {
                if(result._content) {
                    this.frames[0].document.write(result._content);
                } else {
                    this.frames[0].document.write("No content, result: " + result._rc);
                }
                this.frames[0].document.close();
            };
EOT

        }

   }

  # Session aware test class
  {

       package Count;

       use CGI::JSONRPC::Session::Obj;
       use base qw(CGI::JSONRPC::Session::Obj);
      
        sub increment {
          my $self = shift;
          $self->{count} = 1 unless $self->{count};
          return $self->{count}++;
        }
       
        sub jsonrpc_javascript {
            return <<"EOT";
            Create_Class("Count", "JSONRPC");

            Count.prototype.increment = function () {
                this.Call_Server(this.show_count, "increment");
            }

            Count.prototype.show_count = function (count) {
                alert("count is " + count);
            }

            Count.prototype.notincrement = function () {
                this.Call_Server(this.show_count, "notincrement");
            }

            Count.prototype.show_count = function (count) {
                alert("count is " + count);
            }

EOT
        }


  } 

   
    </Perl>
</IfModule>