source: main/trunk/greenstone2/perllib/cpan/CGI/Ajax.pm@ 23064

Last change on this file since 23064 was 23064, checked in by davidb, 14 years ago

Supporting Perl classes (100% pure Perl) for DL talkback facility
File size: 43.1 KB
Line 
1package CGI::Ajax;
2use strict;
3use Data::Dumper;
4use base qw(Class::Accessor);
5use overload '""' => 'show_javascript'; # for building web pages, so
6 # you can just say: print $pjx
7
8BEGIN {
9 use vars qw ($VERSION @ISA @METHODS);
10 @METHODS = qw(url_list coderef_list CACHE DEBUG JSDEBUG html
11 js_encode_function cgi_header_extra skip_header fname);
12
13 CGI::Ajax->mk_accessors(@METHODS);
14
15 $VERSION = .707;
16}
17
18########################################### main pod documentation begin ##
19
20=head1 NAME
21
22CGI::Ajax - a perl-specific system for writing Asynchronous web
23applications
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 = <<EOHTML;
44 <HTML>
45 <BODY>
46 Enter something:
47 <input type="text" name="val1" id="val1"
48 onkeyup="exported_func( ['val1'], ['resultdiv'] );">
49 <br>
50 <div id="resultdiv"></div>
51 </BODY>
52 </HTML>
53 EOHTML
54 return $html;
55 }
56
57When you use CGI::Ajax within Applications that send their own header information,
58you 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
68I<There are several fully-functional examples in the 'scripts/'
69directory of the distribution.>
70
71=head1 DESCRIPTION
72
73CGI::Ajax is an object-oriented module that provides a unique
74mechanism for using perl code asynchronously from javascript-
75enhanced HTML pages. CGI::Ajax unburdens the user from having to
76write extensive javascript, except for associating an exported
77method with a document-defined event (such as onClick, onKeyUp,
78etc). CGI::Ajax also mixes well with HTML containing more complex
79javascript.
80
81CGI::Ajax supports methods that return single results or multiple
82results to the web page, and supports returning values to multiple
83DIV elements on the HTML page.
84
85Using CGI::Ajax, the URL for the HTTP GET/POST request is
86automatically generated based on HTML layout and events, and the
87page is then dynamically updated with the output from the perl
88function. Additionally, CGI::Ajax supports mapping URL's to a
89CGI::Ajax function name, so you can separate your code processing
90over multiple scripts.
91
92Other than using the Class::Accessor module to generate CGI::Ajax'
93accessor methods, CGI::Ajax is completely self-contained - it
94does not require you to install a larger package or a full Content
95Management System, etc.
96
97We have added I<support> for other CGI handler/decoder modules,
98like L<CGI::Simple> or L<CGI::Minimal>, but we can't test these
99since we run mod_perl2 only here. CGI::Ajax checks to see if a
100header() method is available to the CGI object, and then uses it.
101If method() isn't available, it creates it's own minimal header.
102
103A primary goal of CGI::Ajax is to keep the module streamlined and
104maximally flexible. We are trying to keep the generated javascript
105code to a minimum, but still provide users with a variety of
106methods for deploying CGI::Ajax. And VERY little user javascript.
107
108=head1 EXAMPLES
109
110The CGI::Ajax module allows a Perl subroutine to be called
111asynchronously, when triggered from a javascript event on the
112HTML page. To do this, the subroutine must be I<registered>,
113usually done during:
114
115 my $pjx = new CGI::Ajax( 'JSFUNC' => \&PERLFUNC );
116
117This maps a perl subroutine (PERLFUNC) to an automatically
118generated Javascript function (JSFUNC). Next you setup a trigger this
119function when an event occurs (e.g. "onClick"):
120
121 onClick="JSFUNC(['source1','source2'], ['dest1','dest2']);"
122
123where 'source1', 'dest1', 'source2', 'dest2' are the DIV ids of
124HTML elements in your page...
125
126 <input type=text id=source1>
127 <input type=text id=source2>
128 <div id=dest1></div>
129 <div id=dest2></div>
130
131L<CGI::Ajax> sends the values from source1 and source2 to your
132Perl 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
140Start by defining a perl subroutine that you want available from
141javascript. In this case we'll define a subrouting that determines
142whether 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
166Alternatively, we could have used coderefs to associate an
167exported name...
168
169 my $evenodd_func = sub {
170 # exactly the same as in the above subroutine
171 };
172
173Next we define a function to generate the web page - this can
174be done many different ways, and can also be defined as an
175anonymous sub. The only requirement is that the sub send back
176the html of the page. You can do this via a string containing the
177html, or from a coderef that returns the html, or from a function
178(as shown here)...
179
180 sub Show_HTML {
181 my $html = <<EOT;
182 <HTML>
183 <HEAD><title>CGI::Ajax Example</title>
184 </HEAD>
185 <BODY>
186 Enter a number:&nbsp;
187 <input type="text" name="somename" id="val1" size="6"
188 OnKeyUp="evenodd( ['val1'], ['resultdiv'] );">
189 <br>
190 <hr>
191 <div id="resultdiv">
192 </div>
193 </BODY>
194 </HTML>
195EOT
196 return $html;
197 }
198
199The exported Perl subrouting is triggered using the C<OnKeyUp>
200event handler of the input HTML element. The subroutine takes one
201value from the form, the input element B<'val1'>, and returns the
202the result to an HTML div element with an id of B<'resultdiv'>.
203Sending in the input id in an array format is required to support
204multiple inputs, and similarly, to output multiple the results,
205you can use an array for the output divs, but this isn't mandatory -
206as will be explained in the B<Advanced> usage.
207
208Now create a CGI object and a CGI::Ajax object, associating a reference
209to 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
214And if we used a coderef, it would look like this...
215
216 my $pjx = new CGI::Ajax( 'evenodd' => $evenodd_func );
217
218Now we're ready to print the output page; we send in the cgi
219object and the HTML-generating function.
220
221 print $pjx->build_html($cgi,\&Show_HTML);
222
223CGI::Ajax has support for passing in extra HTML header information
224to the CGI object. This can be accomplished by adding a third
225argument to the build_html() call. The argument needs to be a
226hashref containing Key=>value pairs that CGI objects understand:
227
228 print $pjx->build_html($cgi,\&Show_HTML,
229 {-charset=>'UTF-8, -expires=>'-1d'});
230
231See L<CGI> for more header() method options. (CGI.pm, not the
232Perl6 CGI)
233
234That's it for the CGI::Ajax standard method. Let's look at
235something more advanced.
236
237=item 2 Advanced CGI::Ajax example
238
239Let's say we wanted to have a perl subroutine process multiple
240values from the HTML page, and similarly return multiple values
241back to distinct divs on the page. This is easy to do, and
242requires no changes to the perl code - you just create it as you
243would any perl subroutine that works with multiple input values
244and returns multiple values. The significant change happens in
245the event handler javascript in the HTML...
246
247 onClick="exported_func(['input1','input2'],['result1','result2']);"
248
249Here we associate our javascript function ("exported_func") with
250two HTML element ids ('input1','input2'), and also send in two
251HTML element ids to place the results in ('result1','result2').
252
253=item 3 Sending Perl Subroutine Output to a Javascript function
254
255Occassionally, you might want to have a custom javascript function
256process the returned information from your Perl subroutine.
257This is possible, and the only requierment is that you change
258your event handler code...
259
260 onClick="exported_func(['input1'],[js_process_func]);"
261
262In this scenario, C<js_process_func> is a javascript function you
263write to take the returned value from your Perl subroutine and
264process the results. I<Note that a javascript function is not
265quoted -- if it were, then CGI::Ajax would look for a HTML element
266with that id.> Beware that with this usage, B<you are responsible
267for distributing the results to the appropriate place on the
268HTML page>. If the exported Perl subroutine returns, e.g. 2
269values, then C<js_process_func> would need to process the input
270by working through an array, or using the javascript Function
271C<arguments> 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
283There are times when you may want a different script to
284return content to your page. This could be because you have
285an existing script already written to perform a particular
286task, or you want to distribute a part of your application to another
287script. This can be accomplished in L<CGI::Ajax> by using a URL in
288place of a locally-defined Perl subroutine. In this usage,
289you alter you creation of the L<CGI::Ajax> object to link an
290exported javascript function name to a local URL instead of
291a coderef or a subroutine.
292
293 my $url = 'scripts/other_script.pl';
294 my $pjx = new CGI::Ajax( 'external' => $url );
295
296This will work as before in terms of how it is called from you
297event handler:
298
299 onClick="external(['input1','input2'],['resultdiv']);"
300
301The other_script.pl will get the values via a CGI object and
302accessing the 'args' key. The values of the B<'args'> key will
303be 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
309This is good, but what if you need to send in arguments to the
310other script which are directly from the calling Perl script,
311i.e. you want a calling Perl script's variable to be sent, not
312the value from an HTML element on the page? This is possible
313using the following syntax:
314
315 onClick="exported_func(['args__$input1','args__$input2'],
316 ['resultdiv']);"
317
318Similary, if the external script required a constant as input
319(e.g. C<script.pl?args=42>, you would use this syntax:
320
321 onClick="exported_func(['args__42'],['resultdiv']);"
322
323In both of the above examples, the result from the external
324script would get placed into the I<resultdiv> element on our
325(the calling script's) page.
326
327If you are sending more than one argument from an external perl
328script back to a javascript function, you will need to split the
329string (AJAX applications communicate in strings only) on something.
330Internally, we use '__pjx__', and this string is checked for. If
331found, L<CGI::Ajax> will automatically split it. However, if you
332don't want to use '__pjx__', you can do it yourself:
333
334For example, from your Perl script, you would...
335
336 return("A|B"); # join with "|"
337
338and 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
346In order to rename parameters, in case the outside script needs
347specifically-named parameters and not CGI::Ajax' I<'args'> default
348parameter name, change your event handler associated with an HTML
349event like this
350
351 onClick="exported_func(['myname__$input1','myparam__$input2'],
352 ['resultdiv']);"
353
354The URL generated would look like this...
355
356C<script.pl?myname=input1&myparam=input2>
357
358You 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
363Finally, what if we need to get a value from our HTML page and we
364want to send that value to an outside script but the outside script
365requires a named parameter different from I<'args'>? You can
366accomplish this with L<CGI::Ajax> using the getVal() javascript
367method (which returns an array, thus the C<getVal()[0]> notation):
368
369 onClick="exported_func(['myparam__' + getVal('div_id')[0]],
370 ['resultdiv']);"
371
372This will get the value of our HTML element with and
373I<id> of I<div_id>, and submit it to the url attached to
374I<myparam__>. So if our exported handler referred to a URI
375called I<script/scr.pl>, and the element on our HTML page called
376I<div_id> contained the number '42', then the URL would look
377like this C<script/scr.pl?myparam=42>. The result from this
378outside URL would get placed back into our HTML page in the
379element I<resultdiv>. See the example script that comes with
380the distribution called I<pjx_url.pl> and its associated outside
381script I<convert_degrees.pl> for a working example.
382
383B<N.B.> These examples show the use of outside scripts which
384are other perl scripts - I<but you are not limited to Perl>!
385The outside script could just as easily have been PHP or any other
386CGI script, as long as the return from the other script is just
387the result, and not addition HTML code (like FORM elements, etc).
388
389=back
390
391=head2 GET versus POST
392
393Note that all the examples so far have used the following syntax:
394
395 onClick="exported_func(['input1'],['result1']);"
396
397There is an optional third argument to a L<CGI::Ajax> exported
398function that allows change the submit method. The above event could
399also have been coded like this...
400
401 onClick="exported_func(['input1'],['result1'], 'GET');"
402
403By default, L<CGI::Ajax> sends a I<'GET'> request. If you need it,
404for example your URL is getting way too long, you can easily switch
405to a I<'POST'> request with this syntax...
406
407 onClick="exported_func(['input1'],['result1'], 'POST');"
408
409I<('POST' and 'post' are supported)>
410
411=head2 Page Caching
412
413We have implemented a method to prevent page cacheing from undermining
414the AJAX methods in a page. If you send in an input argument to a
415L<CGI::Ajax>-exported function called 'NO_CACHE', the a special
416parameter will get attached to the end or your url with a random
417number in it. This will prevent a browser from caching your request.
418
419 onClick="exported_func(['input1','NO_CACHE'],['result1']);"
420
421The extra param is called pjxrand, and won't interfere with the order
422of processing for the rest of your parameters.
423
424Also see the CACHE() method of changing the default cache behavior.
425
426=head1 METHODS
427
428=cut
429
430################################### main pod documentation end ##
431
432######################################################
433## METHODS - public ##
434######################################################
435
436=over 4
437
438=item build_html()
439
440 Purpose: Associates a cgi obj ($cgi) with pjx object, inserts
441 javascript into <HEAD></HEAD> element and constructs
442 the page, or part of the page. AJAX applications
443 are designed to update only the section of the
444 page that needs it - the whole page doesn't have
445 to be redrawn. L<CGI::Ajax> applications use the
446 build_html() method to take care of this: if the CGI
447 parameter C<fname> exists, then the return from the
448 L<CGI::Ajax>-exported function is sent to the page.
449 Otherwise, the entire page is sent, since without
450 an C<fname> param, this has to be the first time
451 the page is being built.
452
453 Arguments: The CGI object, and either a coderef, or a string
454 containing html. Optionally, you can send in a third
455 parameter containing information that will get passed
456 directly to the CGI object header() call.
457 Returns: html or updated html (including the header)
458 Called By: originating cgi script
459
460=cut
461
462sub geturl {
463 my ($self) = @_;
464 my $v;
465 $v = $self->cgi()->url() if $self->cgi()->isa('CGI');
466 $v = $self->cgi()->query()->url()
467 if !defined $v
468 and $self->cgi()->isa('CGI::Application');
469 return $v;
470}
471
472sub remoteaddr {
473 my ($self) = @_;
474 my $v;
475 $v = $self->cgi()->remote_addr() if $self->cgi()->isa('CGI');
476 $v = $self->cgi()->query()->remote_addr()
477 if !defined $v
478 and $self->cgi()->isa('CGI::Application');
479 return $v;
480}
481
482sub getparam {
483 my ( $self, $name ) = @_;
484 my $cgi = $self->cgi();
485 my @v = $cgi->param($name);
486 if ( @v == 1 and !defined $v[0] ) {
487 my $query = $cgi->isa('CGI::Application');
488 @v = $cgi->query()->param($name) if defined $query;
489 }
490 if (wantarray) {
491 return @v;
492 }
493 return $v[0];
494}
495
496sub getHeader {
497 my ( $self, @extra ) = @_;
498 my $cgi = $self->cgi();
499 return '' if $self->skip_header;
500
501 # return '' if $cgi->isa('CGI') || $cgi->isa('CGI::Application') ;
502 return '' if $cgi->isa('CGI::Application'); # from Ajax::Application
503 return $cgi->header(@extra);
504}
505
506sub build_html {
507 my ( $self, $cgi, $html_source, $cgi_header_extra ) = @_;
508 $self->{canQuery} = defined $cgi->isa('CGI::Application'); # pmg
509 if ( ref($cgi) =~ /CGI.*/ or $self->{canQuery} ) { # pmg
510 if ( $self->DEBUG() ) {
511 print STDERR "CGI::Ajax->build_html: CGI* object was received\n";
512 }
513 $self->cgi($cgi); # associate the cgi obj with the CGI::Ajax object
514 }
515
516 if ( defined $cgi_header_extra ) {
517 if ( $self->DEBUG() ) {
518 print STDERR "CGI::Ajax->build_html: got extra cgi header info\n";
519 if ( ref($cgi_header_extra) eq "HASH" ) {
520 foreach my $k ( keys %$cgi_header_extra ) {
521 print STDERR "\t$k => ", $cgi_header_extra->{$k}, "\n";
522 }
523 }
524 else {
525 print STDERR "\t$cgi_header_extra\n";
526 }
527 }
528 $self->cgi_header_extra($cgi_header_extra);
529 }
530
531 #check if "fname" was defined in the CGI object
532 my $fnameParam = $self->getparam($self->fname());
533
534 if ( defined $fnameParam ) { #pmg
535 # it was, so just return the html from the handled request
536 return ( $self->handle_request() );
537 }
538 else {
539
540 # start with the minimum, a http header line and any extra cgi
541 # header params sent in
542 my $html = $self->getHeader( $self->cgi_header_extra() );
543 if ( !defined $html and $self->skip_header == 0 ) {
544
545 # don't have an object with a "header()" method, so just create
546 # a mimimal one
547 $html .= "Content-Type: text/html;";
548 $html .= $self->cgi_header_extra();
549 $html .= "\n\n";
550 }
551
552 # check if the user sent in a coderef for generating the html,
553 # or the actual html
554 if ( ref($html_source) eq "CODE" ) {
555 if ( $self->DEBUG() ) {
556 print STDERR
557 "CGI::Ajax->build_html: html_source is a CODEREF\n";
558 }
559 eval { $html .= &$html_source };
560 if ($@) {
561
562 # there was a problem evaluating the html-generating function
563 # that was sent in, so generate an error page
564 $html = $self->getHeader( $self->cgi_header_extra() );
565 if ( !defined $html and $self->skip_header == 0 ) {
566
567 # don't have an object with a "header()" method, so just create
568 # a mimimal one
569 $html = "Content-Type: text/html;";
570 $html .= $self->cgi_header_extra();
571 $html .= "\n\n";
572 }
573 $html .=
574qq!<html><head><title></title></head><body><h2>Problems</h2> with
575 the html-generating function sent to CGI::Ajax
576 object</body></html>!;
577 return $html;
578 }
579 $self->html($html); # no problems, so set html
580 }
581 else {
582
583 # user must have sent in raw html, so add it
584 if ( $self->DEBUG() ) {
585 print STDERR "CGI::Ajax->build_html: html_source is HTML\n";
586 }
587 $self->html( $html . $html_source );
588 }
589
590 # now modify the html to insert the javascript
591 $self->insert_js_in_head();
592 }
593 return $self->html();
594}
595
596=item show_javascript()
597
598 Purpose: builds the text of all the javascript that needs to be
599 inserted into the calling scripts html <head> section
600 Arguments:
601 Returns: javascript text
602 Called By: originating web script
603 Note: This method is also overridden so when you just print
604 a CGI::Ajax object it will output all the javascript needed
605 for the web page.
606
607=cut
608
609sub show_javascript {
610 my ($self) = @_;
611 my $rv = $self->show_common_js(); # show the common js
612
613 # build the js for each perl function you want exported to js
614 foreach
615 my $func ( keys %{ $self->coderef_list() }, keys %{ $self->url_list() } )
616 {
617 $rv .= $self->make_function($func);
618 }
619
620 # wrap up the return in a CDATA structure for XML compatibility
621 # (thanks Thos Davis)
622 $rv = "\n" . '//<![CDATA[' . "\n" . $rv . "\n" . '//]]>' . "\n";
623 $rv = '<script type="text/javascript">' . $rv . '</script>';
624 return $rv;
625}
626
627## new
628sub new {
629 my ($class) = shift;
630 my $self = bless( {}, ref($class) || $class );
631
632 # $self->SUPER::new();
633 $self->fname("fname");# default parameter for exported function name
634 $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 $self->DEBUG(0); # turn debugging off (if on, check web logs)
643 $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 $self->coderef_list( {} );
649 $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 $self->js_encode_function('escape');
660
661 if ( @_ < 2 ) {
662 die "incorrect usage: must have fn=>code pairs in new\n";
663
664 }
665
666 while (@_) {
667 my ( $function_name, $code ) = splice( @_, 0, 2 );
668
669 if( $function_name eq 'skip_header' ){
670 $self->skip_header( $code );
671 next;
672 }
673
674 if ( ref($code) eq "CODE" ) {
675 if ( $self->DEBUG() ) {
676 print STDERR "name = $function_name, code = $code\n";
677 }
678
679 # add the name/code to hash
680 $self->coderef_list()->{$function_name} = $code;
681 }
682 elsif ( ref($code) ) {
683 die "Unsuported code block/url\n";
684 }
685 else {
686 if ( $self->DEBUG() ) {
687 print STDERR "Setting function $function_name to url $code\n";
688 }
689
690 # if it's a url, it is added here
691 $self->url_list()->{$function_name} = $code;
692 }
693 }
694 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#
709sub cgiobj {
710 my $self = shift;
711
712 # see if any values were sent in...
713 if (@_) {
714 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 if ( ref($cgi) =~ /CGI.*/
720 or ( $cgi->isa('CGI::Application') && $cgi->query =~ /CGI/ ) )
721 { #pmg
722 if ( $self->DEBUG() ) {
723 print STDERR "cgiobj() received a CGI-like object ($cgi)\n";
724 }
725 $self->{'cgi'} = $cgi;
726 }
727 else {
728 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 return ( $self->{'cgi'} );
735}
736
737sub cgi {
738 my $self = shift;
739 if (@_) {
740 return ( $self->cgiobj(@_) );
741 }
742 else {
743 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
774sub create_js_setRequestHeader {
775 my $self = shift;
776 my $cgi_header_extra = $self->cgi_header_extra();
777 my $js_header_string = q{r.setRequestHeader("};
778
779 #$js_header_string .= $self->cgi()->header( $cgi_header_extra );
780 $js_header_string .= $self->getHeader;
781 $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 if ( $self->DEBUG() ) {
791 print STDERR "js_header_string is (", $js_header_string, ")\n";
792 }
793
794 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
806sub show_common_js {
807 my $self = shift;
808 my $fname = $self->fname();
809 my $encodefn = $self->js_encode_function();
810 my $decodefn = $encodefn;
811 $decodefn =~ s/^(en)/de/;
812 $decodefn =~ s/^(esc)/unesc/;
813
814 #my $request_header_str = $self->create_js_setRequestHeader();
815 my $request_header_str = "";
816 my $rv = <<EOT;
817var ajax = [];
818var cache;
819
820function 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
830function formDump(){
831 var all = [];
832 var fL = document.forms.length;
833 for(var f = 0;f<fL;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}
843function 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<document.forms.length; 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<element.length;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<endk;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}
894function 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<res.length;i++) {
909 url += '&args=' + $encodefn(res[i]) + '&' + arg + '=' + $encodefn(res[i]);
910 }
911 }
912 return url;
913}
914
915pjx.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<dt.length; 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<args.length;i++) {
971 url=url + args[i];
972 }
973 return url;
974 }
975};
976
977handleReturn = function() {
978 for( var k=0; k<ajax.length; 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
988var ghr=getghr();
989function 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
1011function jsdebug(){
1012 var tmp = document.getElementById('pjxdebugrequest').innerHTML = "<br><pre>";
1013 for( var i=0; i < ajax.length; i++ ) {
1014 tmp += '<a href= '+ ajax[i].url +' target=_blank>' +
1015 decodeURI(ajax[i].url) + ' <' + '/a><br>';
1016 }
1017 document.getElementById('pjxdebugrequest').innerHTML = tmp + "<" + "/pre>";
1018}
1019
1020EOT
1021
1022 if ( $self->JSDEBUG() <= 1 ) {
1023 $rv = $self->compress_js($rv);
1024 }
1025
1026 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
1039sub compress_js {
1040 my ( $self, $js ) = @_;
1041 return if not defined $js;
1042 return if $js eq "";
1043 $js =~ s/\n//g; # drop newlines
1044 $js =~ s/\s+/ /g; # replace 1+ spaces with just one space
1045 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 <script></script> 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
1060sub insert_js_in_head {
1061 my $self = shift;
1062 my $mhtml = $self->html();
1063 my $newhtml;
1064 my @shtml;
1065 my $js = $self->show_javascript();
1066
1067 if ( $self->JSDEBUG() ) {
1068 my $showurl = qq!<br/><div id='pjxdebugrequest'></div><br/>!;
1069
1070 # find the terminal </body> so we can insert just before it
1071 my @splith = $mhtml =~ /(.*)(<\s*\/\s*body[^>]*>?)(.*)/is;
1072 $mhtml = $splith[0] . $showurl . $splith[1] . $splith[2];
1073 }
1074
1075 # see if we can match on <head>
1076 @shtml = $mhtml =~ /(.*)(<\s*head[^>]*>?)(.*)/is;
1077 if (@shtml) {
1078
1079 # yes, there's already a <head></head>, so let's insert inside it,
1080 # at the beginning
1081 $newhtml = $shtml[0] . $shtml[1] . $js . $shtml[2];
1082 }
1083 elsif ( @shtml = $mhtml =~ /(.*)(<\s*html[^>]*>?)(.*)/is ) {
1084
1085 # there's no <head>, so look for the <html> tag, and insert out
1086 # javascript inside that tag
1087 $newhtml = $shtml[0] . $shtml[1] . $js . $shtml[2];
1088 }
1089 else {
1090 $newhtml .= "<html><head>";
1091 $newhtml .= $js;
1092 $newhtml .= "</head><body>";
1093 $newhtml .=
1094"No head/html tags, nowhere to insert. Returning javascript anyway<br>";
1095 $newhtml .= "</body></html>";
1096 }
1097 $self->html($newhtml);
1098 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
1113sub handle_request {
1114 my ($self) = shift;
1115
1116 my $result; # $result takes the output of the function, if it's an
1117 # array split on __pjx__
1118 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 return undef unless defined $self->cgi();
1123
1124 my $rv = $self->getHeader( $self->cgi_header_extra() );
1125 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 $rv = "Content-Type: text/html;";
1130
1131 # TODO:
1132 $rv .= $self->cgi_header_extra();
1133 $rv .= "\n\n";
1134 }
1135
1136 # get the name of the function
1137 my $func_name = $self->getparam($self->fname()); #pmg
1138 # check if the function name was created
1139 if ( defined $self->coderef_list()->{$func_name} ) {
1140 my $code = $self->coderef_list()->{$func_name};
1141
1142 # eval the code from the coderef, and append the output to $rv
1143 if ( ref($code) eq "CODE" ) {
1144 my @args = $self->getparam("args"); #pmg
1145 eval { ( $result, @other ) = $code->(@args) }; #pmg
1146
1147 if ($@) {
1148
1149 # see if the eval caused and error and report it
1150 # Should we be more severe and die?
1151 print STDERR "Problem with code: $@\n";
1152 }
1153
1154 if (@other) {
1155 $rv .= join( "__pjx__", ( $result, @other ) );
1156 if ( $self->DEBUG() ) {
1157 print STDERR "rv = $rv\n";
1158 }
1159 }
1160 else {
1161 if ( defined $result ) {
1162 $rv .= $result;
1163 }
1164 }
1165
1166 } # end if ref = CODE
1167 }
1168 else {
1169
1170 # # problems with the URL, return a CGI rrror
1171 print STDERR "POSSIBLE SECURITY INCIDENT! Browser from ",
1172 $self->remoteaddr();
1173 print STDERR "\trequested URL: ", $self->geturl();
1174 print STDERR "\tfname request: ", $self->getparam($self->fname());
1175 print STDERR " -- returning Bad Request status 400\n";
1176 my $header = $self->getHeader( -status => '400' );
1177 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 $rv = "Status: 400\nContent-Type: text/html;\n\n";
1182 }
1183 }
1184 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
1199sub make_function {
1200 my ( $self, $func_name ) = @_;
1201 return ("") if not defined $func_name;
1202 return ("") if $func_name eq "";
1203 my $rv = "";
1204 my $script = $0 || $ENV{SCRIPT_FILENAME};
1205 $script =~ s/.*[\/|\\](.+)$/$1/;
1206 my $outside_url = $self->url_list()->{$func_name};
1207 my $url = defined $outside_url ? $outside_url : $script;
1208 if ( $url =~ /\?/ ) { $url .= '&'; }
1209 else { $url .= '?' }
1210 $url = "'$url'";
1211 my $jsdebug = "";
1212
1213 if ( $self->JSDEBUG() ) {
1214 $jsdebug = "jsdebug()";
1215 }
1216
1217 my $cache = $self->CACHE();
1218
1219 #create the javascript text
1220 $rv .= <<EOT;
1221function $func_name() {
1222 var args = $func_name.arguments;
1223 cache = $cache;
1224 for( var i=0; i<args[0].length;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}
1236EOT
1237
1238 if ( not $self->JSDEBUG() ) {
1239 $rv = $self->compress_js($rv);
1240 }
1241 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
1254sub register {
1255 my ( $self, $fn, $coderef ) = @_;
1256
1257 # coderef_list() is a Class::Accessor function
1258 # url_list() is a Class::Accessor function
1259 if ( ref($coderef) eq "CODE" ) {
1260 $self->coderef_list()->{$fn} = $coderef;
1261 }
1262 elsif ( ref($coderef) ) {
1263 die "Unsupported code/url type - error\n";
1264 }
1265 else {
1266 $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
1324Follow any bugs at our homepage....
1325
1326 http://www.perljax.us
1327
1328=head1 SUPPORT
1329
1330Check 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 [email protected] [email protected]
1339
1340 significant contribution by:
1341 Peter Gordon <[email protected]> # CGI::Application + scripts
1342 Kyraha http://michael.kyraha.com/ # getVal(), multiple forms
1343 Jan Franczak <[email protected]> # CACHE support
1344 Shibi NS # use ->isa instead of ->can
1345
1346 others:
1347 RENEEB <RENEEB [...] cpan.org>
1348 stefan.scherer
1349 RBS
1350 Andrew
1351
1352
1353=head1 A NOTE ABOUT THE MODULE NAME
1354
1355This module was initiated using the name "Perljax", but then
1356registered with CPAN under the WWW group "CGI::", and so became
1357"CGI::Perljax". Upon further deliberation, we decided to change it's
1358name to L<CGI::Ajax>.
1359
1360=head1 COPYRIGHT
1361
1362This program is free software; you can redistribute
1363it and/or modify it under the same terms as Perl itself.
1364
1365The full text of the license can be found in the
1366LICENSE file included with this module.
1367
1368=head1 SEE ALSO
1369
1370L<Data::Javascript>
1371L<CGI>
1372L<Class::Accessor>
1373
1374=cut
1375
13761;
1377__END__
Note: See TracBrowser for help on using the repository browser.