File Coverage

blib/lib/CGI/Ajax.pm

Criterion	Covered	Total	%
statement	35	231	15.1
branch	5	110	4.5
condition	1	33	3.0
subroutine	7	22	31.8
pod	4	16	25.0
total	52	412	12.6

line	stmt	bran	cond	sub	pod	time	code
1							package CGI::Ajax;
2	1			1		44284	use strict;
	1					3
	1					39
3	1			1		1690	use Data::Dumper;
	1					20118
	1					87
4	1			1		12	use base qw(Class::Accessor);
	1					3
	1					1351
5	1			1		3479	use overload '""' => 'show_javascript'; # for building web pages, so
	1					2
	1					9
6							# you can just say: print $pjx
7
8							BEGIN {
9	1			1		75	use vars qw ($VERSION @ISA @METHODS);
	1					1
	1					96
10	1			1		4	@METHODS = qw(url_list coderef_list CACHE DEBUG JSDEBUG html
11							js_encode_function cgi_header_extra skip_header fname);
12
13	1					7	CGI::Ajax->mk_accessors(@METHODS);
14
15	1					3544	$VERSION = .707;
16							}
17
18							########################################### main pod documentation begin ##
19
20							=head1 NAME
21
22							CGI::Ajax - a perl-specific system for writing Asynchronous web
23							applications
24
25							=head1 SYNOPSIS
26
27							use strict;
28							use CGI; # or any other CGI:: form handler/decoder
29							use CGI::Ajax;
30
31							my $cgi = new CGI;
32							my $pjx = new CGI::Ajax( 'exported_func' => \&perl_func );
33							print $pjx->build_html( $cgi, \&Show_HTML);
34
35							sub perl_func {
36							my $input = shift;
37							# do something with $input
38							my $output = $input . " was the input!";
39							return( $output );
40							}
41
42							sub Show_HTML {
43							my $html = <
44
45
46							Enter something:
47
48							onkeyup="exported_func( ['val1'], ['resultdiv'] );">
49
50
51
52
53							EOHTML
54							return $html;
55							}
56
57							When you use CGI::Ajax within Applications that send their own header information,
58							you can skip the header:
59
60							my $pjx = new CGI::Ajax(
61							'exported_func' => \&perl_func,
62							'skip_header' => 1,
63							);
64							$pjx->skip_header(1);
65
66							print $pjx->build_html( $cgi, \&Show_HTML);
67
68							I
69							directory of the distribution.>
70
71							=head1 DESCRIPTION
72
73							CGI::Ajax is an object-oriented module that provides a unique
74							mechanism for using perl code asynchronously from javascript-
75							enhanced HTML pages. CGI::Ajax unburdens the user from having to
76							write extensive javascript, except for associating an exported
77							method with a document-defined event (such as onClick, onKeyUp,
78							etc). CGI::Ajax also mixes well with HTML containing more complex
79							javascript.
80
81							CGI::Ajax supports methods that return single results or multiple
82							results to the web page, and supports returning values to multiple
83							DIV elements on the HTML page.
84
85							Using CGI::Ajax, the URL for the HTTP GET/POST request is
86							automatically generated based on HTML layout and events, and the
87							page is then dynamically updated with the output from the perl
88							function. Additionally, CGI::Ajax supports mapping URL's to a
89							CGI::Ajax function name, so you can separate your code processing
90							over multiple scripts.
91
92							Other than using the Class::Accessor module to generate CGI::Ajax'
93							accessor methods, CGI::Ajax is completely self-contained - it
94							does not require you to install a larger package or a full Content
95							Management System, etc.
96
97							We have added I for other CGI handler/decoder modules,
98							like L or L, but we can't test these
99							since we run mod_perl2 only here. CGI::Ajax checks to see if a
100							header() method is available to the CGI object, and then uses it.
101							If method() isn't available, it creates it's own minimal header.
102
103							A primary goal of CGI::Ajax is to keep the module streamlined and
104							maximally flexible. We are trying to keep the generated javascript
105							code to a minimum, but still provide users with a variety of
106							methods for deploying CGI::Ajax. And VERY little user javascript.
107
108							=head1 EXAMPLES
109
110							The CGI::Ajax module allows a Perl subroutine to be called
111							asynchronously, when triggered from a javascript event on the
112							HTML page. To do this, the subroutine must be I,
113							usually done during:
114
115							my $pjx = new CGI::Ajax( 'JSFUNC' => \&PERLFUNC );
116
117							This maps a perl subroutine (PERLFUNC) to an automatically
118							generated Javascript function (JSFUNC). Next you setup a trigger this
119							function when an event occurs (e.g. "onClick"):
120
121							onClick="JSFUNC(['source1','source2'], ['dest1','dest2']);"
122
123							where 'source1', 'dest1', 'source2', 'dest2' are the DIV ids of
124							HTML elements in your page...
125
126
127
128
129
130
131							L sends the values from source1 and source2 to your
132							Perl subroutine and returns the results to dest1 and dest2.
133
134							=head2 4 Usage Methods
135
136							=over 4
137
138							=item 1 Standard CGI::Ajax example
139
140							Start by defining a perl subroutine that you want available from
141							javascript. In this case we'll define a subrouting that determines
142							whether or not an input is odd, even, or not a number (NaN):
143
144							use strict;
145							use CGI::Ajax;
146							use CGI;
147
148
149							sub evenodd_func {
150							my $input = shift;
151
152							# see if input is defined
153							if ( not defined $input ) {
154							return("input not defined or NaN");
155							}
156
157							# see if value is a number (thanks Randall!)
158							if ( $input !~ /\A\d+\z/ ) {
159							return("input is NaN");
160							}
161
162							# got a number, so mod by 2
163							$input % 2 == 0 ? return("EVEN") : return("ODD");
164							}
165
166							Alternatively, we could have used coderefs to associate an
167							exported name...
168
169							my $evenodd_func = sub {
170							# exactly the same as in the above subroutine
171							};
172
173							Next we define a function to generate the web page - this can
174							be done many different ways, and can also be defined as an
175							anonymous sub. The only requirement is that the sub send back
176							the html of the page. You can do this via a string containing the
177							html, or from a coderef that returns the html, or from a function
178							(as shown here)...
179
180							sub Show_HTML {
181							my $html = <
182
183							CGI::Ajax Example
184
185
186							Enter a number:
187
188							OnKeyUp="evenodd( ['val1'], ['resultdiv'] );">
189
190
191
192
193
194
195							EOT
196							return $html;
197							}
198
199							The exported Perl subrouting is triggered using the C
200							event handler of the input HTML element. The subroutine takes one
201							value from the form, the input element B<'val1'>, and returns the
202							the result to an HTML div element with an id of B<'resultdiv'>.
203							Sending in the input id in an array format is required to support
204							multiple inputs, and similarly, to output multiple the results,
205							you can use an array for the output divs, but this isn't mandatory -
206							as will be explained in the B usage.
207
208							Now create a CGI object and a CGI::Ajax object, associating a reference
209							to our subroutine with the name we want available to javascript.
210
211							my $cgi = new CGI();
212							my $pjx = new CGI::Ajax( 'evenodd' => \&evenodd_func );
213
214							And if we used a coderef, it would look like this...
215
216							my $pjx = new CGI::Ajax( 'evenodd' => $evenodd_func );
217
218							Now we're ready to print the output page; we send in the cgi
219							object and the HTML-generating function.
220
221							print $pjx->build_html($cgi,\&Show_HTML);
222
223							CGI::Ajax has support for passing in extra HTML header information
224							to the CGI object. This can be accomplished by adding a third
225							argument to the build_html() call. The argument needs to be a
226							hashref containing Key=>value pairs that CGI objects understand:
227
228							print $pjx->build_html($cgi,\&Show_HTML,
229							{-charset=>'UTF-8, -expires=>'-1d'});
230
231							See L for more header() method options. (CGI.pm, not the
232							Perl6 CGI)
233
234							That's it for the CGI::Ajax standard method. Let's look at
235							something more advanced.
236
237							=item 2 Advanced CGI::Ajax example
238
239							Let's say we wanted to have a perl subroutine process multiple
240							values from the HTML page, and similarly return multiple values
241							back to distinct divs on the page. This is easy to do, and
242							requires no changes to the perl code - you just create it as you
243							would any perl subroutine that works with multiple input values
244							and returns multiple values. The significant change happens in
245							the event handler javascript in the HTML...
246
247							onClick="exported_func(['input1','input2'],['result1','result2']);"
248
249							Here we associate our javascript function ("exported_func") with
250							two HTML element ids ('input1','input2'), and also send in two
251							HTML element ids to place the results in ('result1','result2').
252
253							=item 3 Sending Perl Subroutine Output to a Javascript function
254
255							Occassionally, you might want to have a custom javascript function
256							process the returned information from your Perl subroutine.
257							This is possible, and the only requierment is that you change
258							your event handler code...
259
260							onClick="exported_func(['input1'],[js_process_func]);"
261
262							In this scenario, C is a javascript function you
263							write to take the returned value from your Perl subroutine and
264							process the results. I
265							quoted -- if it were, then CGI::Ajax would look for a HTML element
266							with that id.> Beware that with this usage, B
267							for distributing the results to the appropriate place on the
268							HTML page>. If the exported Perl subroutine returns, e.g. 2
269							values, then C would need to process the input
270							by working through an array, or using the javascript Function
271							C object.
272
273							function js_process_func() {
274							var input1 = arguments[0]
275							var input2 = arguments[1];
276							// do something and return results, or set HTML divs using
277							// innerHTML
278							document.getElementById('outputdiv').innerHTML = input1;
279							}
280
281							=item 4 URL/Outside Script CGI::Ajax example
282
283							There are times when you may want a different script to
284							return content to your page. This could be because you have
285							an existing script already written to perform a particular
286							task, or you want to distribute a part of your application to another
287							script. This can be accomplished in L by using a URL in
288							place of a locally-defined Perl subroutine. In this usage,
289							you alter you creation of the L object to link an
290							exported javascript function name to a local URL instead of
291							a coderef or a subroutine.
292
293							my $url = 'scripts/other_script.pl';
294							my $pjx = new CGI::Ajax( 'external' => $url );
295
296							This will work as before in terms of how it is called from you
297							event handler:
298
299							onClick="external(['input1','input2'],['resultdiv']);"
300
301							The other_script.pl will get the values via a CGI object and
302							accessing the 'args' key. The values of the B<'args'> key will
303							be an array of everything that was sent into the script.
304
305							my @input = $cgi->params('args');
306							$input[0]; # contains first argument
307							$input[1]; # contains second argument, etc...
308
309							This is good, but what if you need to send in arguments to the
310							other script which are directly from the calling Perl script,
311							i.e. you want a calling Perl script's variable to be sent, not
312							the value from an HTML element on the page? This is possible
313							using the following syntax:
314
315							onClick="exported_func(['args__$input1','args__$input2'],
316							['resultdiv']);"
317
318							Similary, if the external script required a constant as input
319							(e.g. C, you would use this syntax:
320
321							onClick="exported_func(['args__42'],['resultdiv']);"
322
323							In both of the above examples, the result from the external
324							script would get placed into the I element on our
325							(the calling script's) page.
326
327							If you are sending more than one argument from an external perl
328							script back to a javascript function, you will need to split the
329							string (AJAX applications communicate in strings only) on something.
330							Internally, we use '__pjx__', and this string is checked for. If
331							found, L will automatically split it. However, if you
332							don't want to use '__pjx__', you can do it yourself:
333
334							For example, from your Perl script, you would...
335
336							return("A\|B"); # join with "\|"
337
338							and then in the javascript function you would have something like...
339
340							process_func() {
341							var arr = arguments[0].split("\|");
342							// arr[0] eq 'A'
343							// arr[1] eq 'B'
344							}
345
346							In order to rename parameters, in case the outside script needs
347							specifically-named parameters and not CGI::Ajax' I<'args'> default
348							parameter name, change your event handler associated with an HTML
349							event like this
350
351							onClick="exported_func(['myname__$input1','myparam__$input2'],
352							['resultdiv']);"
353
354							The URL generated would look like this...
355
356							C
357
358							You would then retrieve the input in the outside script with this...
359
360							my $p1 = $cgi->params('myname');
361							my $p1 = $cgi->params('myparam');
362
363							Finally, what if we need to get a value from our HTML page and we
364							want to send that value to an outside script but the outside script
365							requires a named parameter different from I<'args'>? You can
366							accomplish this with L using the getVal() javascript
367							method (which returns an array, thus the C notation):
368
369							onClick="exported_func(['myparam__' + getVal('div_id')[0]],
370							['resultdiv']);"
371
372							This will get the value of our HTML element with and
373							I of I, and submit it to the url attached to
374							I. So if our exported handler referred to a URI
375							called I';
624	0					0	return $rv;
625							}
626
627							## new
628							sub new {
629	1			1	1	14	my ($class) = shift;
630	1		33			11	my $self = bless( {}, ref($class) \|\| $class );
631
632							# $self->SUPER::new();
633	1					8	$self->fname("fname");# default parameter for exported function name
634	1					96	$self->JSDEBUG(0); # turn javascript debugging off (if on,
635							# extra info will be added to the web page output
636							# if set to 1, then the core js will get
637							# compressed, but the user-defined functions will
638							# not be compressed. If set to 2 (or anything
639							# greater than 1 or 0), then none of the
640							# javascript will get compressed.
641							#
642	1					12	$self->DEBUG(0); # turn debugging off (if on, check web logs)
643	1					12	$self->CACHE(1); # default behavior is to allow cache of content
644							# which can be explicitly switched off by passing
645							# NO_CACHE in the arg list
646
647							#accessorized attributes
648	1					12	$self->coderef_list( {} );
649	1					12	$self->url_list( {} );
650
651							#$self->html("");
652							#$self->cgi();
653							#$self->cgi_header_extra(""); # set cgi_header_extra to an empty string
654
655							# setup a default endcoding; if you need support for international
656							# charsets, use 'escape' instead of encodeURIComponent. Due to the
657							# number of browser problems users report about scripts with a default of
658							# encodeURIComponent, we are setting the default to 'escape'
659	1					13	$self->js_encode_function('escape');
660
661	1	50				14	if ( @_ < 2 ) {
662	0					0	die "incorrect usage: must have fn=>code pairs in new\n";
663
664							}
665
666	1					11	while (@_) {
667	1					4	my ( $function_name, $code ) = splice( @_, 0, 2 );
668
669	1	50				5	if( $function_name eq 'skip_header' ){
670	0					0	$self->skip_header( $code );
671	0					0	next;
672							}
673
674	1	50				18	if ( ref($code) eq "CODE" ) {
		50
675	0	0				0	if ( $self->DEBUG() ) {
676	0					0	print STDERR "name = $function_name, code = $code\n";
677							}
678
679							# add the name/code to hash
680	0					0	$self->coderef_list()->{$function_name} = $code;
681							}
682							elsif ( ref($code) ) {
683	0					0	die "Unsuported code block/url\n";
684							}
685							else {
686	1	50				4	if ( $self->DEBUG() ) {
687	0					0	print STDERR "Setting function $function_name to url $code\n";
688							}
689
690							# if it's a url, it is added here
691	1					21	$self->url_list()->{$function_name} = $code;
692							}
693							}
694	1					12	return ($self);
695							}
696
697							######################################################
698							## METHODS - private ##
699							######################################################
700
701							# sub cgiobj(), cgi()
702							#
703							# Purpose: accessor method to associate a CGI object with our
704							# CGI::Ajax object
705							# Arguments: a CGI object
706							# Returns: CGI::Ajax objects cgi object
707							# Called By: originating cgi script, or build_html()
708							#
709							sub cgiobj {
710	0			0	0		my $self = shift;
711
712							# see if any values were sent in...
713	0	0					if (@_) {
714	0						my $cgi = shift;
715
716							# add support for other CGI::* modules This requires that your web server
717							# be configured properly. I can't test anything but a mod_perl2
718							# setup, so this prevents me from testing CGI::Lite,CGI::Simple, etc.
719	0	0	0				if ( ref($cgi) =~ /CGI.*/
			0
720							or ( $cgi->isa('CGI::Application') && $cgi->query =~ /CGI/ ) )
721							{ #pmg
722	0	0					if ( $self->DEBUG() ) {
723	0						print STDERR "cgiobj() received a CGI-like object ($cgi)\n";
724							}
725	0						$self->{'cgi'} = $cgi;
726							}
727							else {
728	0						die
729							"CGI::Ajax -- Can't set internal CGI object to a non-CGI object ($cgi)\n";
730							}
731							}
732
733							# return the object
734	0						return ( $self->{'cgi'} );
735							}
736
737							sub cgi {
738	0			0	0		my $self = shift;
739	0	0					if (@_) {
740	0						return ( $self->cgiobj(@_) );
741							}
742							else {
743	0						return ( $self->cgiobj() );
744							}
745							}
746
747							## # sub cgi_header_extra
748							## #
749							## # Purpose: accessor method to associate CGI header information
750							## # with the CGI::Ajax object
751							## # Arguments: a hashref with key=>value pairs that get handed off to
752							## # the CGI object's header() method
753							## # Returns: hashref of extra cgi header params
754							## # Called By: originating cgi script, or build_html()
755							##
756							## sub cgi_header_extra {
757							## my $self = shift;
758							## if ( @_ ) {
759							## $self->{'cgi_header_extra'} = shift;
760							## }
761							## return( $self->{'cgi_header_extra'} );
762							## }
763
764							# sub create_js_setRequestHeader
765							#
766							# Purpose: create text of the header for the javascript side,
767							# xmlhttprequest call
768							# Arguments: none
769							# Returns: text of header to pass to xmlhttpreq call so it will
770							# match whatever was setup for the main web-page
771							# Called By: originating cgi script, or build_html()
772							#
773
774							sub create_js_setRequestHeader {
775	0			0	0		my $self = shift;
776	0						my $cgi_header_extra = $self->cgi_header_extra();
777	0						my $js_header_string = q{r.setRequestHeader("};
778
779							#$js_header_string .= $self->cgi()->header( $cgi_header_extra );
780	0						$js_header_string .= $self->getHeader;
781	0						$js_header_string .= q{");};
782
783							#if ( ref $cgi_header_extra eq "HASH" ) {
784							# foreach my $k ( keys(%$cgi_header_extra) ) {
785							# $js_header_string .= $self->cgi()->header($cgi_headers)
786							# }
787							#} else {
788							#print STDERR $self->cgi()->header($cgi_headers) ;
789
790	0	0					if ( $self->DEBUG() ) {
791	0						print STDERR "js_header_string is (", $js_header_string, ")\n";
792							}
793
794	0						return ($js_header_string);
795							}
796
797							# sub show_common_js()
798							#
799							# Purpose: create text of the javascript needed to interface with
800							# the perl functions
801							# Arguments: none
802							# Returns: text of common javascript subroutine, 'do_http_request'
803							# Called By: originating cgi script, or build_html()
804							#
805
806							sub show_common_js {
807	0			0	0		my $self = shift;
808	0						my $fname = $self->fname();
809	0						my $encodefn = $self->js_encode_function();
810	0						my $decodefn = $encodefn;
811	0						$decodefn =~ s/^(en)/de/;
812	0						$decodefn =~ s/^(esc)/unesc/;
813
814							#my $request_header_str = $self->create_js_setRequestHeader();
815	0						my $request_header_str = "";
816	0						my $rv = <
817							var ajax = [];
818							var cache;
819
820							function pjx(args,fname,method) {
821							this.target=args[1];
822							this.args=args[0];
823							method=(method)?method:'GET';
824							if(method=='post'){method='POST';}
825							this.method = method;
826							this.r=ghr();
827							this.url = this.getURL(fname);
828							}
829
830							function formDump(){
831							var all = [];
832							var fL = document.forms.length;
833							for(var f = 0;f
834							var els = document.forms[f].elements;
835							for(var e in els){
836							var tmp = (els[e].id != undefined)? els[e].id : els[e].name;
837							if(typeof tmp != 'string'){continue;}
838							if(tmp){ all[all.length]=tmp}
839							}
840							}
841							return all;
842							}
843							function getVal(id) {
844							if (id.constructor == Function ) { return id(); }
845							if (typeof(id)!= 'string') { return id; }
846
847							var element = document.getElementById(id);
848							if( !element ) {
849							for( var i=0; i
850							element = document.forms[i].elements[id];
851							if( element ) break;
852							}
853							if( element && !element.type ) element = element[0];
854							}
855							if(!element){
856							alert('ERROR: Cant find HTML element with id or name: ' +
857							id+'. Check that an element with name or id='+id+' exists');
858							return 0;
859							}
860
861							if(element.type == 'select-one') {
862							if(element.selectedIndex == -1) return;
863							var item = element[element.selectedIndex];
864							return item.value \|\| item.text;
865							}
866							if(element.type == 'select-multiple') {
867							var ans = [];
868							var k =0;
869							for (var i=0;i
870							if (element[i].selected \|\| element[i].checked ) {
871							ans[k++]= element[i].value \|\| element[i].text;
872							}
873							}
874							return ans;
875							}
876							if(element.type == 'radio' \|\| element.type == 'checkbox'){
877							var ans =[];
878							var elms = document.getElementsByTagName('input');
879							var endk = elms.length ;
880							var i =0;
881							for(var k=0;k
882							if(elms[k].type== element.type && elms[k].checked && (elms[k].id==id\|\|elms[k].name==id)){
883							ans[i++]=elms[k].value;
884							}
885							}
886							return ans;
887							}
888							if( element.value == undefined ){
889							return element.innerHTML;
890							}else{
891							return element.value;
892							}
893							}
894							function fnsplit(arg) {
895							var url="";
896							if(arg=='NO_CACHE'){cache = 0; return "";};
897							if((typeof(arg)).toLowerCase() == 'object'){
898							for(var k in arg){
899							url += '&' + k + '=' + arg[k];
900							}
901							}else if (arg.indexOf('__') != -1) {
902							arga = arg.split(/__/);
903							url += '&' + arga[0] +'='+ $encodefn(arga[1]);
904							} else {
905							var res = getVal(arg) \|\| '';
906							if(res.constructor != Array){ res = [res] }
907							else if( res.length == 0 ) { res = [ '' ] }
908							for(var i=0;i
909							url += '&args=' + $encodefn(res[i]) + '&' + arg + '=' + $encodefn(res[i]);
910							}
911							}
912							return url;
913							}
914
915							pjx.prototype = {
916							send2perl : function(){
917							var r = this.r;
918							var dt = this.target;
919							if (dt==undefined) { return true; }
920							this.pjxInitialized(dt);
921							var url=this.url;
922							var postdata;
923							if(this.method=="POST"){
924							var idx=url.indexOf('?');
925							postdata = url.substr(idx+1);
926							url = url.substr(0,idx);
927							}
928							r.open(this.method,url,true);
929							$request_header_str;
930							if(this.method=="POST"){
931							r.setRequestHeader("Content-Type", "application/x-www-form-urlencoded");
932							r.send(postdata);
933							}
934							if(this.method=="GET"){
935							r.send(null);
936							}
937							r.onreadystatechange = handleReturn;
938							},
939							pjxInitialized : function(){},
940							pjxCompleted : function(){},
941							readyState4 : function(){
942							var rsp = $decodefn(this.r.responseText); /* the response from perl */
943							var splitval = '__pjx__'; /* to split text */
944							/* fix IE problems with undef values in an Array getting squashed*/
945							rsp = rsp.replace(splitval+splitval+'g',splitval+" "+splitval);
946							var data = rsp.split(splitval);
947							dt = this.target;
948							if (dt.constructor != Array) { dt=[dt]; }
949							if (data.constructor != Array) { data=[data]; }
950							if (typeof(dt[0])!='function') {
951							for ( var i=0; i
952							var div = document.getElementById(dt[i]);
953							if (div.type =='text' \|\| div.type=='textarea' \|\| div.type=='hidden' ) {
954							div.value=data[i];
955							} else if (div.type =='checkbox') {
956							div.checked=data[i];
957							} else {
958							div.innerHTML = data[i];
959							}
960							}
961							} else if (typeof(dt[0])=='function') {
962							dt[0].apply(this,data);
963							}
964							this.pjxCompleted(dt);
965							},
966
967							getURL : function(fname) {
968							var args = this.args;
969							var url= '$fname=' + fname;
970							for (var i=0;i
971							url=url + args[i];
972							}
973							return url;
974							}
975							};
976
977							handleReturn = function() {
978							for( var k=0; k
979							if (ajax[k].r==null) { ajax.splice(k--,1); continue; }
980							if ( ajax[k].r.readyState== 4) {
981							ajax[k].readyState4();
982							ajax.splice(k--,1);
983							continue;
984							}
985							}
986							};
987
988							var ghr=getghr();
989							function getghr(){
990							if(typeof XMLHttpRequest != "undefined")
991							{
992							return function(){return new XMLHttpRequest();}
993							}
994							var msv= ["Msxml2.XMLHTTP.7.0", "Msxml2.XMLHTTP.6.0",
995							"Msxml2.XMLHTTP.5.0", "Msxml2.XMLHTTP.4.0", "MSXML2.XMLHTTP.3.0",
996							"MSXML2.XMLHTTP", "Microsoft.XMLHTTP"];
997							for(var j=0;j<=msv.length;j++){
998							try
999							{
1000							A = new ActiveXObject(msv[j]);
1001							if(A){
1002							return function(){return new ActiveXObject(msv[j]);}
1003							}
1004							}
1005							catch(e) { }
1006							}
1007							return false;
1008							}
1009
1010
1011							function jsdebug(){
1012							var tmp = document.getElementById('pjxdebugrequest').innerHTML = " ";
1013							for( var i=0; i < ajax.length; i++ ) {
1014							tmp += '' +
1015							decodeURI(ajax[i].url) + ' <' + '/a> ';
1016							}
1017							document.getElementById('pjxdebugrequest').innerHTML = tmp + "<" + "/pre>";
1018							}
1019
1020							EOT
1021
1022	0	0					if ( $self->JSDEBUG() <= 1 ) {
1023	0						$rv = $self->compress_js($rv);
1024							}
1025
1026	0						return ($rv);
1027							}
1028
1029							# sub compress_js()
1030							#
1031							# Purpose: searches the javascript for newlines and spaces and
1032							# removes them (if a newline) or shrinks them to a single (if
1033							# space).
1034							# Arguments: javascript to compress
1035							# Returns: compressed js string
1036							# Called By: show_common_js(),
1037							#
1038
1039							sub compress_js {
1040	0			0	0		my ( $self, $js ) = @_;
1041	0	0					return if not defined $js;
1042	0	0					return if $js eq "";
1043	0						$js =~ s/\n//g; # drop newlines
1044	0						$js =~ s/\s+/ /g; # replace 1+ spaces with just one space
1045	0						return $js;
1046							}
1047
1048							# sub insert_js_in_head()
1049							#
1050							# Purpose: searches the html value in the CGI::Ajax object and inserts
1051							# the ajax javascript code in the section,
1052							# or if no such section exists, then it creates it. If
1053							# JSDEBUG is set, then an extra div will be added and the
1054							# url will be displayed as a link
1055							# Arguments: none
1056							# Returns: none
1057							# Called By: build_html()
1058							#
1059
1060							sub insert_js_in_head {
1061	0			0	0		my $self = shift;
1062	0						my $mhtml = $self->html();
1063	0						my $newhtml;
1064							my @shtml;
1065	0						my $js = $self->show_javascript();
1066
1067	0	0					if ( $self->JSDEBUG() ) {
1068	0						my $showurl = qq! !;
1069
1070							# find the terminal so we can insert just before it
1071	0						my @splith = $mhtml =~ /(.)(<\s\/\sbody[^>]>?)(.*)/is;
1072	0						$mhtml = $splith[0] . $showurl . $splith[1] . $splith[2];
1073							}
1074
1075							# see if we can match on
1076	0						@shtml = $mhtml =~ /(.)(<\shead[^>]>?)(.)/is;
1077	0	0					if (@shtml) {
		0
1078
1079							# yes, there's already a , so let's insert inside it,
1080							# at the beginning
1081	0						$newhtml = $shtml[0] . $shtml[1] . $js . $shtml[2];
1082							}
1083							elsif ( @shtml = $mhtml =~ /(.)(<\shtml[^>]>?)(.)/is ) {
1084
1085							# there's no , so look for the tag, and insert out
1086							# javascript inside that tag
1087	0						$newhtml = $shtml[0] . $shtml[1] . $js . $shtml[2];
1088							}
1089							else {
1090	0						$newhtml .= "";
1091	0						$newhtml .= $js;
1092	0						$newhtml .= "";
1093	0						$newhtml .=
1094							"No head/html tags, nowhere to insert. Returning javascript anyway ";
1095	0						$newhtml .= "";
1096							}
1097	0						$self->html($newhtml);
1098	0						return;
1099							}
1100
1101							# sub handle_request()
1102							#
1103							# Purpose: makes sure a fname function name was set in the CGI
1104							# object, and then tries to eval the function with
1105							# parameters sent in on args
1106							# Arguments: none
1107							# Returns: the result of the perl subroutine, as text; if multiple
1108							# arguments are sent back from the defined, exported perl
1109							# method, then join then with a connector (__pjx__).
1110							# Called By: build_html()
1111							#
1112
1113							sub handle_request {
1114	0			0	0		my ($self) = shift;
1115
1116	0						my $result; # $result takes the output of the function, if it's an
1117							# array split on __pjx__
1118	0						my @other = (); # array for catching extra parameters
1119
1120							# we need to access "fname" in the form from the web page, so make
1121							# sure there is a CGI object defined
1122	0	0					return undef unless defined $self->cgi();
1123
1124	0						my $rv = $self->getHeader( $self->cgi_header_extra() );
1125	0	0	0				if ( !defined $rv and $self->skip_header == 0 ) {
1126
1127							# don't have an object with a "header()" method, so just create
1128							# a mimimal one
1129	0						$rv = "Content-Type: text/html;";
1130
1131							# TODO:
1132	0						$rv .= $self->cgi_header_extra();
1133	0						$rv .= "\n\n";
1134							}
1135
1136							# get the name of the function
1137	0						my $func_name = $self->getparam($self->fname()); #pmg
1138							# check if the function name was created
1139	0	0					if ( defined $self->coderef_list()->{$func_name} ) {
1140	0						my $code = $self->coderef_list()->{$func_name};
1141
1142							# eval the code from the coderef, and append the output to $rv
1143	0	0					if ( ref($code) eq "CODE" ) {
1144	0						my @args = $self->getparam("args"); #pmg
1145	0						eval { ( $result, @other ) = $code->(@args) }; #pmg
	0
1146
1147	0	0					if ($@) {
1148
1149							# see if the eval caused and error and report it
1150							# Should we be more severe and die?
1151	0						print STDERR "Problem with code: $@\n";
1152							}
1153
1154	0	0					if (@other) {
1155	0						$rv .= join( "__pjx__", ( $result, @other ) );
1156	0	0					if ( $self->DEBUG() ) {
1157	0						print STDERR "rv = $rv\n";
1158							}
1159							}
1160							else {
1161	0	0					if ( defined $result ) {
1162	0						$rv .= $result;
1163							}
1164							}
1165
1166							} # end if ref = CODE
1167							}
1168							else {
1169
1170							# # problems with the URL, return a CGI rrror
1171	0						print STDERR "POSSIBLE SECURITY INCIDENT! Browser from ",
1172							$self->remoteaddr();
1173	0						print STDERR "\trequested URL: ", $self->geturl();
1174	0						print STDERR "\tfname request: ", $self->getparam($self->fname());
1175	0						print STDERR " -- returning Bad Request status 400\n";
1176	0						my $header = $self->getHeader( -status => '400' );
1177	0	0					if ( !defined $header ) {
1178
1179							# don't have an object with a "header()" method, so just create
1180							# a mimimal one with 400 error
1181	0						$rv = "Status: 400\nContent-Type: text/html;\n\n";
1182							}
1183							}
1184	0						return $rv;
1185							}
1186
1187							# sub make_function()
1188							#
1189							# Purpose: creates the javascript wrapper for the underlying perl
1190							# subroutine
1191							# Arguments: CGI object from web form, and the name of the perl
1192							# function to export to javascript, or a url if the
1193							# function name refers to another cgi script
1194							# Returns: text of the javascript-wrapped perl subroutine
1195							# Called By: show_javascript; called once for each registered perl
1196							# subroutine
1197							#
1198
1199							sub make_function {
1200	0			0	0		my ( $self, $func_name ) = @_;
1201	0	0					return ("") if not defined $func_name;
1202	0	0					return ("") if $func_name eq "";
1203	0						my $rv = "";
1204	0		0				my $script = $0 \|\| $ENV{SCRIPT_FILENAME};
1205	0						$script =~ s/.*[\/\|\\](.+)$/$1/;
1206	0						my $outside_url = $self->url_list()->{$func_name};
1207	0	0					my $url = defined $outside_url ? $outside_url : $script;
1208	0	0					if ( $url =~ /\?/ ) { $url .= '&'; }
	0
1209	0						else { $url .= '?' }
1210	0						$url = "'$url'";
1211	0						my $jsdebug = "";
1212
1213	0	0					if ( $self->JSDEBUG() ) {
1214	0						$jsdebug = "jsdebug()";
1215							}
1216
1217	0						my $cache = $self->CACHE();
1218
1219							#create the javascript text
1220	0						$rv .= <
1221							function $func_name() {
1222							var args = $func_name.arguments;
1223							cache = $cache;
1224							for( var i=0; i
1225							args[0][i] = fnsplit(args[0][i]);
1226							}
1227							var l = ajax.length;
1228							ajax[l]= new pjx(args,"$func_name",args[2]);
1229							ajax[l].url = $url + ajax[l].url;
1230							if ( cache == 0 ) {
1231							ajax[l].url = ajax[l].url + '&pjxrand=' + Math.random();
1232							}
1233							ajax[l].send2perl();
1234							$jsdebug;
1235							}
1236							EOT
1237
1238	0	0					if ( not $self->JSDEBUG() ) {
1239	0						$rv = $self->compress_js($rv);
1240							}
1241	0						return $rv;
1242							}
1243
1244							=item register()
1245
1246							Purpose: adds a function name and a code ref to the global coderef
1247							hash, after the original object was created
1248							Arguments: function name, code reference
1249							Returns: none
1250							Called By: originating web script
1251
1252							=cut
1253
1254							sub register {
1255	0			0	1		my ( $self, $fn, $coderef ) = @_;
1256
1257							# coderef_list() is a Class::Accessor function
1258							# url_list() is a Class::Accessor function
1259	0	0					if ( ref($coderef) eq "CODE" ) {
		0
1260	0						$self->coderef_list()->{$fn} = $coderef;
1261							}
1262							elsif ( ref($coderef) ) {
1263	0						die "Unsupported code/url type - error\n";
1264							}
1265							else {
1266	0						$self->url_list()->{$fn} = $coderef;
1267							}
1268							}
1269
1270							=item fname()
1271
1272							Purpose: Overrides the default parameter name used for
1273							passing an exported function name. Default value
1274							is "fname".
1275
1276							Arguments: fname("new_name"); # sets the new parameter name
1277							The overriden fname should be consistent throughout
1278							the entire application. Otherwise results are unpredicted.
1279
1280							Returns: With no parameters fname() returns the current fname name
1281
1282
1283							=item JSDEBUG()
1284
1285							Purpose: Show the AJAX URL that is being generated, and stop
1286							compression of the generated javascript, both of which can aid
1287							during debugging. If set to 1, then the core js will get
1288							compressed, but the user-defined functions will not be
1289							compressed. If set to 2 (or anything greater than 1 or 0),
1290							then none of the javascript will get compressed.
1291
1292							Arguments: JSDEBUG(0); # turn javascript debugging off
1293							JSDEBUG(1); # turn javascript debugging on, some javascript compression
1294							JSDEBUG(2); # turn javascript debugging on, no javascript compresstion
1295							Returns: prints a link to the url that is being generated automatically by
1296							the Ajax object. this is VERY useful for seeing what
1297							CGI::Ajax is doing. Following the link, will show a page
1298							with the output that the page is generating.
1299
1300							Called By: $pjx->JSDEBUG(1) # where $pjx is a CGI::Ajax object;
1301
1302							=item DEBUG()
1303
1304							Purpose: Show debugging information in web server logs
1305							Arguments: DEBUG(0); # turn debugging off (default)
1306							DEBUG(1); # turn debugging on
1307							Returns: prints debugging information to the web server logs using
1308							STDERR
1309							Called By: $pjx->DEBUG(1) # where $pjx is a CGI::Ajax object;
1310
1311							=item CACHE()
1312
1313							Purpose: Alter the default result caching behavior.
1314							Arguments: CACHE(0); # effectively the same as having NO_CACHE passed in every call
1315							Returns: A change in the behavior of build_html such that the javascript
1316							produced will always act as if the NO_CACHE argument is passed,
1317							regardless of its presence.
1318							Called By: $pjx->CACHE(0) # where $pjx is a CGI::Ajax object;
1319
1320							=back
1321
1322							=head1 BUGS
1323
1324							Follow any bugs at our homepage....
1325
1326							http://www.perljax.us
1327
1328							=head1 SUPPORT
1329
1330							Check out the news/discussion/bugs lists at our homepage:
1331
1332							http://www.perljax.us
1333
1334							=head1 AUTHORS
1335
1336							Brian C. Thomas Brent Pedersen
1337							CPAN ID: BCT
1338							bct.x42@gmail.com bpederse@gmail.com
1339
1340							significant contribution by:
1341							Peter Gordon # CGI::Application + scripts
1342							Kyraha http://michael.kyraha.com/ # getVal(), multiple forms
1343							Jan Franczak # CACHE support
1344							Shibi NS # use ->isa instead of ->can
1345
1346							others:
1347							RENEEB
1348							stefan.scherer
1349							RBS
1350							Andrew
1351
1352
1353							=head1 A NOTE ABOUT THE MODULE NAME
1354
1355							This module was initiated using the name "Perljax", but then
1356							registered with CPAN under the WWW group "CGI::", and so became
1357							"CGI::Perljax". Upon further deliberation, we decided to change it's
1358							name to L.
1359
1360							=head1 COPYRIGHT
1361
1362							This program is free software; you can redistribute
1363							it and/or modify it under the same terms as Perl itself.
1364
1365							The full text of the license can be found in the
1366							LICENSE file included with this module.
1367
1368							=head1 SEE ALSO
1369
1370							L
1371							L
1372							L
1373
1374							=cut
1375
1376							1;
1377							__END__