Subversion Repositories cryptochat

Compare Revisions

No changes between revisions

Regard whitespace Rev 1 → Rev 2

/trunk/dependencies/sajax/perl/Readme.txt
0,0 → 1,7
SAJAX PERL BACKEND
------------------
 
Contributed and copyighted by Nathan Schmidt (http://www.hinathan.com/).
Additional guidance and consultation by Jason Purdy and Nate Mueller.
 
 
Property changes:
Added: svn:mime-type
+text/plain
\ No newline at end of property
/trunk/dependencies/sajax/perl/Sajax.pm
0,0 → 1,184
package Sajax;
use Data::Dumper;
 
my $rs_debug_mode = 0;
my $rs_js_has_been_shown = 0;
my %rs_export_list = ();
my %rs_coderef_list = ();
 
sub incl_sajax {
}
sub rs_init {
$rs_debug_mode = 0;
$rs_js_has_been_shown = 0;
%rs_export_list = ();
%rs_coderef_list = ();
 
}
sub rs_handle_client_request {
my($q)=@_;
my $rv="";
if (!defined $q->param("rs")) {
return undef;
}
my $func_name = $q->param("rs");
 
if ( defined $rs_export_list{$func_name}) {
$rv .= "+:";
eval {
$rv .= &$func_name($q->param("rsargs"));
};
if($@) {
print STDERR "Err:[$@]\n";
}
} elsif ( defined $rs_coderef_list{$func_name}) {
$rv .= "+:";
my $cr = $rs_coderef_list{$func_name};
eval {
$rv .= &$cr($q->param("rsargs"));
};
if($@) {
print STDERR "Err:[$@]\n";
}
} else {
$rv .= "-:$func_name not callable";
}
return $rv;
}
sub rs_show_common_js() {
my $rv = "";
my $debug_mode = $rs_debug_mode ? "true" : "false";
my $CC = "\n// Perl backend version (c) copyright 2005 Nathan Schmidt";
$CC = "";
$rv .= <<EOT;
// remote scripting library
// (c) copyright 2005 modernmethod, inc$CC
var rs_debug_mode = $debug_mode;
var rs_obj = false;
var rs_callback = false;
 
function rs_debug(text) {
if (rs_debug_mode)
alert("RSD: " + text)
}
function rs_init_object() {
rs_debug("rs_init_object() called..")
var A;
try {
A=new ActiveXObject("Msxml2.XMLHTTP");
} catch (e) {
try {
A=new ActiveXObject("Microsoft.XMLHTTP");
} catch (oc) {
A=null;
}
}
if(!A && typeof XMLHttpRequest != "undefined")
A = new XMLHttpRequest();
if (!A)
rs_debug("Could not create connection object.");
return A;
}
EOT
return $rv;
}
 
 
#javascript escape a value
sub rs_esc {
my ($val)=@_;
$val =~ s/\"/\\\\\"/;
return $val;
}
 
sub rs_urlencode {
my($enc) = @_;
$enc =~ s/^\s+|\s+$//gs;
$enc =~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
$enc =~ s/ /\+/g;
$enc =~ s/%20/\+/g;
return $enc;
}
 
sub rs_show_one {
my($q,$func_name)=@_;
my $rv = "";
my $uri = $q->url(-query=>1);
if ($uri =~ m/\?/) {
$uri .= "&rs=".rs_urlencode($func_name);
} else {
$uri .= "?rs=".rs_urlencode($func_name);
}
 
my $urie = rs_esc($uri);
 
$rv .= <<EOT;
 
// wrapper for $func_name
function x_$func_name() {
// count args; build URL
var i, x, n;
var url = "$urie", a = x_$func_name.arguments;
for (i = 0; i < a.length-1; i++)
url = url + "&rsargs=" + escape(a[i]);
url = url.replace( /[+]/g, '%2B'); // fix the unescaped plus signs
x = rs_init_object();
x.open("GET", url, true);
x.onreadystatechange = function() {
if (x.readyState != 4)
return;
rs_debug("received " + x.responseText);
var status;
var data;
status = x.responseText.charAt(0);
data = x.responseText.substring(2);
if (status == "-")
alert("Error: " + callback_n);
else
a[a.length-1](data);
}
x.send(null);
rs_debug("x_$func_name url = " + url);
rs_debug("x_$func_name waiting..");
}
 
 
EOT
return $rv;
}
 
sub rs_register {
my($fn,$coderef)=@_;
$rs_coderef_list{$fn} = $coderef;
}
sub rs_export {
map {$rs_export_list{$_}=$_} @_;
return;
}
 
sub rs_show_javascript {
my ($q) = @_;
my $rv = "";
if (! $rs_js_has_been_shown) {
$rv .= rs_show_common_js();
$rs_js_has_been_shown = 1;
}
 
foreach my $func (keys %rs_export_list) {
$rv .= rs_show_one($q,$func);
}
foreach my $func (keys %rs_coderef_list) {
$rv .= rs_show_one($q,$func);
}
 
return $rv;
}
 
1;
Property changes:
Added: svn:mime-type
+text/x-perl
\ No newline at end of property
/trunk/dependencies/sajax/perl/example_multiply.cgi
0,0 → 1,113
#! /usr/bin/perl -w
 
# Perl version cloned from the original PHP by http://www.modernmethod.com/sajax/
# I've left commented-out examples in the code for running with static methods.
# For moving to ModPerl it's important to no be redefining subs all the time,
# so this code adds the rs_register(funcname,coderef) call, which takes a coderef
# rather than the name of a sub to be called.
 
 
use Sajax;
use CGI;
 
my $q = new CGI;
 
my $rv = "";
 
$rv .= "content-type: text/html\n\n";
 
 
=pod
#for static method calls
sub Sajax::multiply {
my($x, $y)=@_;
return $x * $y;
}
sub Sajax::divide {
my($x, $y)=@_;
return $x / $y;
}
=cut
 
#equivalent modperl methods
my $msub = sub {
my($x, $y)=@_;
return $x * $y;
};
my $dsub = sub {
my($x, $y)=@_;
return $x / $y;
};
 
 
 
Sajax::rs_init();
 
#register static methods (called by name)
#Sajax::rs_export("multiply","divide");
 
#modperl methods (called as anonymous coderefs)
Sajax::rs_register("multiply",$msub);
Sajax::rs_register("divide",$dsub);
 
 
my $handled_value = Sajax::rs_handle_client_request($q);
 
if(defined $handled_value) {
$rv .= $handled_value;
} else {
 
$rv .= "<html>\n<head>\n<title>Multiplier</title>\n<script>\n\n";
 
$rv .= Sajax::rs_show_javascript($q);
 
$rv .= <<EOT;
function do_multiply_cb(z) {
document.getElementById("z").value = z;
}
function do_divide_cb(z) {
document.getElementById("zz").value = z;
}
 
 
function do_multiply() {
var x, y;
x = document.getElementById("x").value;
y = document.getElementById("y").value;
x_multiply(x, y, do_multiply_cb);
}
 
function do_divide() {
var x, y;
x = document.getElementById("x").value;
y = document.getElementById("y").value;
x_divide(x, y, do_divide_cb);
}
EOT
 
 
$rv .= "</script>\n\n</head>\n";
$rv .= <<EOT;
<body>
<input type="text" name="x" id="x" value="2" size="3">
*
<input type="text" name="y" id="y" value="3" size="3">
=
<input type="text" name="z" id="z" value="" size="5">
<input type="text" name="zz" id="zz" value="" size="5">
<input type="button" name="check" value="Multiply" onclick="do_multiply(); return false;">
<input type="button" name="check" value="Divide" onclick="do_divide(); return false;">
<input type="button" name="check" value="Both" onclick="do_multiply();do_divide(); return false;">
 
<BR>
<A HREF=showsource.cgi>Show source</A>
</body>
</html>
EOT
}
 
 
print $rv;