461adf378200d3920a2c640ae1ac91e1fe36e560
[kivitendo-erp.git] / modules / override / CGI / Ajax.pm
1 package CGI::Ajax;
2 use strict;
3 use Data::Dumper;
4 use base qw(Class::Accessor);
5 use overload '""' => 'show_javascript'; # for building web pages, so
6                                         # you can just say: print $pjx
7 BEGIN {
8         use vars qw ($VERSION @ISA @METHODS);
9         @METHODS = qw(url_list coderef_list DEBUG JSDEBUG html
10                                                                 js_encode_function cgi_header_extra);
11
12         CGI::Ajax->mk_accessors( @METHODS );
13
14         $VERSION     = .697;
15 }
16
17 ########################################### main pod documentation begin ##
18
19 =head1 NAME
20
21 CGI::Ajax - a perl-specific system for writing Asynchronous web
22 applications
23
24 =head1 SYNOPSIS
25
26   use strict;
27   use CGI;      # or any other CGI:: form handler/decoder
28   use CGI::Ajax;
29
30   my $cgi = new CGI;
31   my $pjx = new CGI::Ajax( 'exported_func' => \&perl_func );
32
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
57 I<There are several fully-functional examples in the 'scripts/'
58 directory of the distribution.>
59
60 =head1 DESCRIPTION
61
62 CGI::Ajax is an object-oriented module that provides a unique
63 mechanism for using perl code asynchronously from javascript-
64 enhanced HTML pages.  CGI::Ajax unburdens the user from having to
65 write extensive javascript, except for associating an exported
66 method with a document-defined event (such as onClick, onKeyUp,
67 etc).  CGI::Ajax also mixes well with HTML containing more complex
68 javascript.
69
70 CGI::Ajax supports methods that return single results or multiple
71 results to the web page, and supports returning values to multiple
72 DIV elements on the HTML page.
73
74 Using CGI::Ajax, the URL for the HTTP GET/POST request is
75 automatically generated based on HTML layout and events, and the
76 page is then dynamically updated with the output from the perl
77 function.  Additionally, CGI::Ajax supports mapping URL's to a
78 CGI::Ajax function name, so you can separate your code processing
79 over multiple scripts.
80
81 Other than using the Class::Accessor module to generate CGI::Ajax'
82 accessor methods, CGI::Ajax is completely self-contained - it
83 does not require you to install a larger package or a full Content
84 Management System, etc.
85
86 We have added I<support> for other CGI handler/decoder modules,
87 like L<CGI::Simple> or L<CGI::Minimal>, but we can't test these
88 since we run mod_perl2 only here.  CGI::Ajax checks to see if a
89 header() method is available to the CGI object, and then uses it.
90 If method() isn't available, it creates it's own minimal header.
91
92 A primary goal of CGI::Ajax is to keep the module streamlined and
93 maximally flexible.  We are trying to keep the generated javascript
94 code to a minimum, but still provide users with a variety of
95 methods for deploying CGI::Ajax. And VERY little user javascript.
96
97 =head1 EXAMPLES
98
99 The CGI::Ajax module allows a Perl subroutine to be called
100 asynchronously, when triggered from a javascript event on the
101 HTML page.  To do this, the subroutine must be I<registered>,
102 usually done during:
103
104   my $pjx = new CGI::Ajax( 'JSFUNC' => \&PERLFUNC );
105
106 This maps a perl subroutine (PERLFUNC) to an automatically
107 generated Javascript function (JSFUNC).  Next you setup a trigger this
108 function when an event occurs (e.g. "onClick"):
109
110   onClick="JSFUNC(['source1','source2'], ['dest1','dest2']);"
111
112 where 'source1', 'dest1', 'source2', 'dest2' are the DIV ids of
113 HTML elements in your page...
114
115   <input type=text id=source1>
116   <input type=text id=source2>
117   <div id=dest1></div>
118   <div id=dest2></div>
119
120 L<CGI::Ajax> sends the values from source1 and source2 to your
121 Perl subroutine and returns the results to dest1 and dest2.
122
123 =head2 4 Usage Methods
124
125 =over 4
126
127 =item 1 Standard CGI::Ajax example
128
129 Start by defining a perl subroutine that you want available from
130 javascript.  In this case we'll define a subrouting that determines
131 whether or not an input is odd, even, or not a number (NaN):
132
133   use strict;
134   use CGI::Ajax;
135   use CGI;
136
137
138   sub evenodd_func {
139     my $input = shift;
140
141     # see if input is defined
142     if ( not defined $input ) {
143       return("input not defined or NaN");
144     }
145
146     # see if value is a number (*thanks Randall!*)
147     if ( $input !~ /\A\d+\z/ ) {
148       return("input is NaN");
149     }
150
151     # got a number, so mod by 2
152     $input % 2 == 0 ? return("EVEN") : return("ODD");
153   }
154
155 Alternatively, we could have used coderefs to associate an
156 exported name...
157
158   my $evenodd_func = sub {
159     # exactly the same as in the above subroutine
160   };
161
162 Next we define a function to generate the web page - this can
163 be done many different ways, and can also be defined as an
164 anonymous sub.  The only requirement is that the sub send back
165 the html of the page.  You can do this via a string containing the
166 html, or from a coderef that returns the html, or from a function
167 (as shown here)...
168
169   sub Show_HTML {
170     my $html = <<EOT;
171   <HTML>
172   <HEAD><title>CGI::Ajax Example</title>
173   </HEAD>
174   <BODY>
175     Enter a number:&nbsp;
176     <input type="text" name="somename" id="val1" size="6"
177        OnKeyUp="evenodd( ['val1'], ['resultdiv'] );">
178     <br>
179     <hr>
180     <div id="resultdiv">
181     </div>
182   </BODY>
183   </HTML>
184 EOT
185     return $html;
186   }
187
188 The exported Perl subrouting is triggered using the C<OnKeyUp>
189 event handler of the input HTML element.  The subroutine takes one
190 value from the form, the input element B<'val1'>, and returns the
191 the result to an HTML div element with an id of B<'resultdiv'>.
192 Sending in the input id in an array format is required to support
193 multiple inputs, and similarly, to output multiple the results,
194 you can use an array for the output divs, but this isn't mandatory -
195 as will be explained in the B<Advanced> usage.
196
197 Now create a CGI object and a CGI::Ajax object, associating a reference
198 to our subroutine with the name we want available to javascript.
199
200   my $cgi = new CGI();
201   my $pjx = new CGI::Ajax( 'evenodd' => \&evenodd_func );
202
203 And if we used a coderef, it would look like this...
204
205   my $pjx = new CGI::Ajax( 'evenodd' => $evenodd_func );
206
207 Now we're ready to print the output page; we send in the cgi
208 object and the HTML-generating function.
209
210   print $pjx->build_html($cgi,\&Show_HTML);
211
212 CGI::Ajax has support for passing in extra HTML header information
213 to the CGI object.  This can be accomplished by adding a third
214 argument to the build_html() call.  The argument needs to be a
215 hashref containing Key=>value pairs that CGI objects understand:
216
217   print $pjx->build_html($cgi,\&Show_HTML,
218     {-charset=>'UTF-8, -expires=>'-1d'});
219
220 See L<CGI> for more header() method options.
221
222 That's it for the CGI::Ajax standard method.  Let's look at
223 something more advanced.
224
225 =item 2 Advanced CGI::Ajax example
226
227 Let's say we wanted to have a perl subroutine process multiple
228 values from the HTML page, and similarly return multiple values
229 back to distinct divs on the page.  This is easy to do, and
230 requires no changes to the perl code - you just create it as you
231 would any perl subroutine that works with multiple input values
232 and returns multiple values.  The significant change happens in
233 the event handler javascript in the HTML...
234
235   onClick="exported_func(['input1','input2'],['result1','result2']);"
236
237 Here we associate our javascript function ("exported_func") with
238 two HTML element ids ('input1','input2'), and also send in two
239 HTML element ids to place the results in ('result1','result2').
240
241 =item 3 Sending Perl Subroutine Output to a Javascript function
242
243 Occassionally, you might want to have a custom javascript function
244 process the returned information from your Perl subroutine.
245 This is possible, and the only requierment is that you change
246 your event handler code...
247
248   onClick="exported_func(['input1'],[js_process_func]);"
249
250 In this scenario, C<js_process_func> is a javascript function you
251 write to take the returned value from your Perl subroutine and
252 process the results.  I<Note that a javascript function is not
253 quoted -- if it were, then CGI::Ajax would look for a HTML element
254 with that id.>  Beware that with this usage, B<you are responsible
255 for distributing the results to the appropriate place on the
256 HTML page>.  If the exported Perl subroutine returns, e.g. 2
257 values, then C<js_process_func> would need to process the input
258 by working through an array, or using the javascript Function
259 C<arguments> object.
260
261   function js_process_func() {
262     var input1 = arguments[0]
263     var input2 = arguments[1];
264     // do something and return results, or set HTML divs using
265     // innerHTML
266     document.getElementById('outputdiv').innerHTML = input1;
267   }
268
269 =item 4 URL/Outside Script CGI::Ajax example
270
271 There are times when you may want a different script to
272 return content to your page.  This could be because you have
273 an existing script already written to perform a particular
274 task, or you want to distribute a part of your application to another
275 script.  This can be accomplished in L<CGI::Ajax> by using a URL in
276 place of a locally-defined Perl subroutine.  In this usage,
277 you alter you creation of the L<CGI::Ajax> object to link an
278 exported javascript function name to a local URL instead of
279 a coderef or a subroutine.
280
281   my $url = 'scripts/other_script.pl';
282   my $pjx = new CGI::Ajax( 'external' => $url );
283
284 This will work as before in terms of how it is called from you
285 event handler:
286
287   onClick="external(['input1','input2'],['resultdiv']);"
288
289 The other_script.pl will get the values via a CGI object and
290 accessing the 'args' key.  The values of the B<'args'> key will
291 be an array of everything that was sent into the script.
292
293   my @input = $cgi->params('args');
294   $input[0]; # contains first argument
295   $input[1]; # contains second argument, etc...
296
297 This is good, but what if you need to send in arguments to the
298 other script which are directly from the calling Perl script,
299 i.e. you want a calling Perl script's variable to be sent, not
300 the value from an HTML element on the page?  This is possible
301 using the following syntax:
302
303   onClick="exported_func(['args__$input1','args__$input2'],
304                          ['resultdiv']);"
305
306 Similary, if the external script required a constant as input
307 (e.g.  C<script.pl?args=42>, you would use this syntax:
308
309   onClick="exported_func(['args__42'],['resultdiv']);"
310
311 In both of the above examples, the result from the external
312 script would get placed into the I<resultdiv> element on our
313 (the calling script's) page.
314
315 If you are sending more than one argument from an external perl
316 script back to a javascript function, you will need to split the
317 string (AJAX applications communicate in strings only) on something.
318 Internally, we use '__pjx__', and this string is checked for.  If
319 found, L<CGI::Ajax> will automatically split it.  However, if you
320 don't want to use '__pjx__', you can do it yourself:
321
322 For example, from your Perl script, you would...
323
324         return("A|B"); # join with "|"
325
326 and then in the javascript function you would have something like...
327
328         process_func() {
329                 var arr = arguments[0].split("|");
330                 // arr[0] eq 'A'
331                 // arr[1] eq 'B'
332         }
333
334 In order to rename parameters, in case the outside script needs
335 specifically-named parameters and not CGI::Ajax' I<'args'> default
336 parameter name, change your event handler associated with an HTML
337 event like this
338
339   onClick="exported_func(['myname__$input1','myparam__$input2'],
340                          ['resultdiv']);"
341
342 The URL generated would look like this...
343
344 C<script.pl?myname=input1&myparam=input2>
345
346 You would then retrieve the input in the outside script with this...
347
348   my $p1 = $cgi->params('myname');
349   my $p1 = $cgi->params('myparam');
350
351 Finally, what if we need to get a value from our HTML page and we
352 want to send that value to an outside script but the outside script
353 requires a named parameter different from I<'args'>?  You can
354 accomplish this with L<CGI::Ajax> using the getVal() javascript
355 method (which returns an array, thus the C<getVal()[0]> notation):
356
357   onClick="exported_func(['myparam__' + getVal('div_id')[0]],
358                          ['resultdiv']);"
359
360 This will get the value of our HTML element with and
361 I<id> of I<div_id>, and submit it to the url attached to
362 I<myparam__>.  So if our exported handler referred to a URI
363 called I<script/scr.pl>, and the element on our HTML page called
364 I<div_id> contained the number '42', then the URL would look
365 like this C<script/scr.pl?myparam=42>.  The result from this
366 outside URL would get placed back into our HTML page in the
367 element I<resultdiv>.  See the example script that comes with
368 the distribution called I<pjx_url.pl> and its associated outside
369 script I<convert_degrees.pl> for a working example.
370
371 B<N.B.> These examples show the use of outside scripts which
372 are other perl scripts - I<but you are not limited to Perl>!
373 The outside script could just as easily have been PHP or any other
374 CGI script, as long as the return from the other script is just
375 the result, and not addition HTML code (like FORM elements, etc).
376
377 =back
378
379 =head2 GET versus POST
380
381 Note that all the examples so far have used the following syntax:
382
383   onClick="exported_func(['input1'],['result1']);"
384
385 There is an optional third argument to a L<CGI::Ajax> exported
386 function that allows change the submit method.  The above event could
387 also have been coded like this...
388
389   onClick="exported_func(['input1'],['result1'], 'GET');"
390
391 By default, L<CGI::Ajax> sends a I<'GET'> request.  If you need it,
392 for example your URL is getting way too long, you can easily switch
393 to a I<'POST'> request with this syntax...
394
395   onClick="exported_func(['input1'],['result1'], 'POST');"
396
397 I<('POST' and 'post' are supported)>
398
399 =head2 Page Caching
400
401 We have implemented a method to prevent page cacheing from undermining
402 the AJAX methods in a page.  If you send in an input argument to a
403 L<CGI::Ajax>-exported function called 'NO_CACHE', the a special
404 parameter will get attached to the end or your url with a random
405 number in it.  This will prevent a browser from caching your request.
406
407   onClick="exported_func(['input1','NO_CACHE'],['result1']);"
408
409 The extra param is called pjxrand, and won't interfere with the order
410 of processing for the rest of your parameters.
411
412 =head1 METHODS
413
414 =cut
415
416 ################################### main pod documentation end ##
417
418 ######################################################
419 ## METHODS - public                                 ##
420 ######################################################
421
422 =over 4
423
424 =item build_html()
425
426     Purpose: Associates a cgi obj ($cgi) with pjx object, inserts
427              javascript into <HEAD></HEAD> element and constructs
428              the page, or part of the page.  AJAX applications
429              are designed to update only the section of the
430              page that needs it - the whole page doesn't have
431              to be redrawn.  L<CGI::Ajax> applications use the
432              build_html() method to take care of this: if the CGI
433              parameter C<fname> exists, then the return from the
434              L<CGI::Ajax>-exported function is sent to the page.
435              Otherwise, the entire page is sent, since without
436              an C<fname> param, this has to be the first time
437              the page is being built.
438
439   Arguments: The CGI object, and either a coderef, or a string
440              containing html.  Optionally, you can send in a third
441              parameter containing information that will get passed
442              directly to the CGI object header() call.
443     Returns: html or updated html (including the header)
444   Called By: originating cgi script
445
446 =cut
447 sub build_html {
448   my ( $self, $cgi, $html_source, $cgi_header_extra ) = @_;
449
450   if ( ref( $cgi ) =~ /CGI.*/ ) {
451     if ( $self->DEBUG() ) {
452       print STDERR "CGI::Ajax->build_html: CGI* object was received\n";
453     }
454     $self->cgi( $cgi ); # associate the cgi obj with the CGI::Ajax object
455   }
456
457   if ( defined $cgi_header_extra ) {
458     if ( $self->DEBUG() ) {
459       print STDERR "CGI::Ajax->build_html: got extra cgi header info\n";
460       if ( ref($cgi_header_extra) eq "HASH" ) {
461         foreach my $k ( keys %$cgi_header_extra ) {
462           print STDERR "\t$k => ", $cgi_header_extra->{$k}, "\n";
463         }
464       } else {
465         print STDERR "\t$cgi_header_extra\n";
466       }
467     }
468     $self->cgi_header_extra( $cgi_header_extra ); 
469   }
470
471   #check if "fname" was defined in the CGI object
472   if ( defined $self->cgi()->param("fname") ) {
473     # it was, so just return the html from the handled request
474     return ( $self->handle_request() );
475   }
476   else {
477     # start with the minimum, a http header line and any extra cgi
478     # header params sent in
479     my $html = "";
480     if ( $self->cgi()->can('header') ) {
481       #$html .= $self->cgi()->header();
482       $html .= $self->cgi()->header( $self->cgi_header_extra() );
483     }
484     else {
485       # don't have an object with a "header()" method, so just create
486       # a mimimal one
487       $html .= "Content-Type: text/html;";
488       $html .= $self->cgi_header_extra();
489       $html .= "\n\n";
490     }
491
492     # check if the user sent in a coderef for generating the html,
493     # or the actual html
494     if ( ref($html_source) eq "CODE" ) {
495       if ( $self->DEBUG() ) {
496         print STDERR "CGI::Ajax->build_html: html_source is a CODEREF\n";
497       }
498       eval { $html .= &$html_source };
499       if ($@) {
500         # there was a problem evaluating the html-generating function
501         # that was sent in, so generate an error page
502         if ( $self->cgi()->can('header') ) {
503           $html = $self->cgi()->header( $self->cgi_header_extra() );
504         }
505         else {
506           # don't have an object with a "header()" method, so just create
507           # a mimimal one
508           $html = "Content-Type: text/html;";
509           $html .= $self->cgi_header_extra();
510           $html .= "\n\n";
511         }
512         $html .= qq!<html><head><title></title></head><body><h2>Problems</h2> with
513           the html-generating function sent to CGI::Ajax
514           object</body></html>!;
515         return $html;
516       }
517       $self->html($html);    # no problems, so set html
518     }
519     else {
520       # user must have sent in raw html, so add it
521       if ( $self->DEBUG() ) {
522         print STDERR "CGI::Ajax->build_html: html_source is HTML\n";
523       }
524       $self->html( $html . $html_source );
525     }
526
527     # now modify the html to insert the javascript
528     $self->insert_js_in_head();
529   }
530   return $self->html();
531 }
532
533 =item show_javascript()
534
535     Purpose: builds the text of all the javascript that needs to be
536              inserted into the calling scripts html <head> section
537   Arguments:
538     Returns: javascript text
539   Called By: originating web script
540        Note: This method is also overridden so when you just print
541              a CGI::Ajax object it will output all the javascript needed
542              for the web page.
543
544 =cut
545
546 sub show_javascript {
547   my ($self) = @_;
548   my $rv = $self->show_common_js();    # show the common js
549
550   # build the js for each perl function you want exported to js
551   foreach my $func ( keys %{ $self->coderef_list() }, keys %{ $self->url_list() } ) {
552     $rv .= $self->make_function($func);
553   }
554   # wrap up the return in a CDATA structure for XML compatibility
555   # (thanks Thos Davis)
556   $rv = "\n" . '//<![CDATA[' . "\n" . $rv . "\n" . '//]]>' . "\n";
557   $rv = '<script type="text/javascript">' . $rv . '</script>';
558   return $rv;
559 }
560
561 ## new
562 sub new {
563   my ($class) = shift;
564   my $self = bless ({}, ref ($class) || $class);
565 #  $self->SUPER::new();
566   $self->JSDEBUG(0); # turn javascript debugging off (if on,
567                      # extra info will be added to the web page output
568                      # if set to 1, then the core js will get
569                      # compressed, but the user-defined functions will
570                      # not be compressed.  If set to 2 (or anything
571                      # greater than 1 or 0), then none of the
572                      # javascript will get compressed.
573                      #
574   $self->DEBUG(0);   # turn debugging off (if on, check web logs)
575
576   #accessorized attributes
577   $self->coderef_list({});
578   $self->url_list({});
579   #$self->html("");
580   #$self->cgi();
581   #$self->cgi_header_extra(""); # set cgi_header_extra to an empty string
582
583   # setup a default endcoding; if you need support for international
584         # charsets, use 'escape' instead of encodeURIComponent.  Due to the
585         # number of browser problems users report about scripts with a default of
586         # encodeURIComponent, we are setting the default to 'escape'
587   $self->js_encode_function('escape');
588
589   if ( @_ < 2 ) {
590     die "incorrect usage: must have fn=>code pairs in new\n";
591   }
592
593   while ( @_ ) {
594     my($function_name,$code) = splice( @_, 0, 2 );
595     if ( ref( $code ) eq "CODE" ) {
596       if ( $self->DEBUG() ) {
597         print STDERR "name = $function_name, code = $code\n";
598       }
599       # add the name/code to hash
600       $self->coderef_list()->{ $function_name } = $code;
601     } elsif ( ref($code) ) {
602       die "Unsuported code block/url\n";
603     } else {
604       if ( $self->DEBUG() ) {
605         print STDERR "Setting function $function_name to url $code\n";
606       }
607       # if it's a url, it is added here
608       $self->url_list()->{ $function_name } = $code;
609     }
610   }
611   return ($self);
612 }
613
614 ######################################################
615 ## METHODS - private                                ##
616 ######################################################
617
618 # sub cgiobj(), cgi()
619 #
620 #    Purpose: accessor method to associate a CGI object with our
621 #             CGI::Ajax object
622 #  Arguments: a CGI object
623 #    Returns: CGI::Ajax objects cgi object
624 #  Called By: originating cgi script, or build_html()
625 #
626 sub cgiobj {
627   my $self = shift;
628   # see if any values were sent in...
629   if ( @_ ) {
630     my $cgi = shift;
631     # add support for other CGI::* modules This requires that your web server
632     # be configured properly.  I can't test anything but a mod_perl2
633     # setup, so this prevents me from testing CGI::Lite,CGI::Simple, etc.
634     if ( ref($cgi) =~ /CGI.*/ ) {
635       if ( $self->DEBUG() ) {
636                                 print STDERR "cgiobj() received a CGI-like object ($cgi)\n";
637       }
638       $self->{'cgi'} = $cgi;
639     } else {
640       die "CGI::Ajax -- Can't set internal CGI object to a non-CGI object ($cgi)\n";
641     }
642   }
643   # return the object
644   return( $self->{'cgi'} );
645 }
646
647 sub cgi {
648   my $self = shift;
649   if ( @_ ) {
650     return( $self->cgiobj( @_ ) );
651   } else {
652     return( $self->cgiobj() );
653   }
654 }
655
656 ## # sub cgi_header_extra
657 ## #
658 ## #    Purpose: accessor method to associate CGI header information
659 ## #             with the CGI::Ajax object
660 ## #  Arguments: a hashref with key=>value pairs that get handed off to
661 ## #             the CGI object's header() method
662 ## #    Returns: hashref of extra cgi header params
663 ## #  Called By: originating cgi script, or build_html()
664 ## 
665 ## sub cgi_header_extra {
666 ##   my $self = shift;
667 ##   if ( @_ ) {
668 ##     $self->{'cgi_header_extra'} = shift;
669 ##   }
670 ##   return( $self->{'cgi_header_extra'} );
671 ## }
672
673 # sub create_js_setRequestHeader
674 #
675 #    Purpose: create text of the header for the javascript side,
676 #             xmlhttprequest call
677 #  Arguments: none
678 #    Returns: text of header to pass to xmlhttpreq call so it will
679 #             match whatever was setup for the main web-page
680 #  Called By: originating cgi script, or build_html()
681 #
682
683 sub create_js_setRequestHeader {
684   my $self = shift;
685   my $cgi_header_extra = $self->cgi_header_extra();
686   my $js_header_string = q{r.setRequestHeader("};
687         #$js_header_string .= $self->cgi()->header( $cgi_header_extra );
688         $js_header_string .= $self->cgi()->header();
689   $js_header_string .= q{");};
690         #if ( ref $cgi_header_extra eq "HASH" ) {
691         #       foreach my $k ( keys(%$cgi_header_extra) ) {
692         #               $js_header_string .= $self->cgi()->header($cgi_headers) 
693         #       }
694         #} else {
695   #print STDERR  $self->cgi()->header($cgi_headers) ;
696   
697         if ( $self->DEBUG() ) {
698                 print STDERR "js_header_string is (", $js_header_string, ")\n";
699         }
700
701   return($js_header_string);
702 }
703
704 # sub show_common_js()
705 #
706 #    Purpose: create text of the javascript needed to interface with
707 #             the perl functions
708 #  Arguments: none
709 #    Returns: text of common javascript subroutine, 'do_http_request'
710 #  Called By: originating cgi script, or build_html()
711 #
712
713 sub show_common_js {
714   my $self = shift;
715   my $encodefn = $self->js_encode_function();
716   my $decodefn = $encodefn;
717   $decodefn =~ s/^(en)/de/;
718   $decodefn =~ s/^(esc)/unesc/;
719   #my $request_header_str = $self->create_js_setRequestHeader();
720   my $request_header_str = "";
721   my $rv = <<EOT;
722 var ajax = [];
723 function pjx(args,fname,method) {
724   this.target=args[1];
725   this.args=args[0];
726   method=(method)?method:'GET';
727   if(method=='post'){method='POST';}
728   this.method = method;
729   this.r=ghr();
730   this.url = this.getURL(fname);
731 }
732
733 function formDump(){
734   var all = [];
735   var fL = document.forms.length;
736   for(var f = 0;f<fL;f++){
737     var els = document.forms[f].elements;
738     for(var e in els){
739       var tmp = (els[e].id != undefined)? els[e].id : els[e].name;
740       if(typeof tmp != 'string'){continue;}
741       if(tmp){ all[all.length]=tmp}
742     }
743   }
744   return all;
745 }
746 function getVal(id) {
747   if (id.constructor == Function ) { return id(); }
748   if (typeof(id)!= 'string') { return id; }
749   var element = document.getElementById(id) || document.forms[0].elements[id];
750   if(!element){
751      alert('ERROR: Cant find HTML element with id or name: ' +
752      id+'. Check that an element with name or id='+id+' exists');
753      return 0;
754   }
755    if(element.type == 'select-one') { 
756       if(element.selectedIndex == -1) return;
757       var item = element[element.selectedIndex]; 
758       return  item.value || item.text
759    } 
760   if (element.type == 'select-multiple') {
761   var ans = [];
762   var k =0;
763     for (var i=0;i<element.length;i++) {
764       if (element[i].selected || element[i].checked ) {
765         ans[k++]= element[i].value || element[i].text;
766       }
767     }
768     return ans;
769   }
770     
771   if(element.type == 'radio' || element.type == 'checkbox'){
772     var ans =[];
773     var elms = document.getElementsByTagName('input');
774     var endk = elms.length;
775     var i =0;
776     for(var k=0;k<endk;k++){
777       if(elms[k].type== element.type && elms[k].checked && elms[k].id==id){
778         ans[i++]=elms[k].value;
779       }
780     }
781     return ans;
782   }
783   if( element.value == undefined ){
784     return element.innerHTML;
785   }else{
786     return element.value;
787   }
788 }
789 function fnsplit(arg) {
790   var url="";
791   if(arg=='NO_CACHE'){return '&pjxrand='+Math.random()}
792   if((typeof(arg)).toLowerCase() == 'object'){
793       for(var k in arg){
794          url += '&' + k + '=' + arg[k];
795       }
796   }else if (arg.indexOf('__') != -1) {
797     arga = arg.split(/__/);
798     url += '&' + arga[0] +'='+ $encodefn(arga[1]);
799   } else {
800     var res = getVal(arg) || '';
801     if(res.constructor != Array){ res = [res] }
802     for(var i=0;i<res.length;i++) {
803       url += '&args=' + $encodefn(res[i]) + '&' + arg + '=' + $encodefn(res[i]);
804     }
805   }
806   return url;
807 }
808
809 pjx.prototype =  {
810   send2perl : function(){
811     var r = this.r;
812     var dt = this.target;
813     this.pjxInitialized(dt);
814     var url=this.url;
815     var postdata;
816     if(this.method=="POST"){
817       var idx=url.indexOf('?');
818       postdata = url.substr(idx+1);
819       url = url.substr(0,idx);
820     }
821     r.open(this.method,url,true);
822     $request_header_str;
823     if(this.method=="POST"){
824       r.setRequestHeader("Content-Type", "application/x-www-form-urlencoded");
825       r.send(postdata);
826     }
827     if(this.method=="GET"){
828       r.send(null);
829     }
830     r.onreadystatechange = handleReturn;
831  },
832  pjxInitialized : function(){},
833  pjxCompleted : function(){},
834  readyState4 : function(){
835     var rsp = $decodefn(this.r.responseText);  /* the response from perl */
836     var splitval = '__pjx__';  /* to split text */
837     /* fix IE problems with undef values in an Array getting squashed*/
838     rsp = rsp.replace(new RegExp(splitval+splitval, "g"),splitval+" "+splitval);
839     var data = rsp.split(splitval);  
840     dt = this.target;
841     if (dt.constructor != Array) { dt=[dt]; }
842     if (data.constructor != Array) { data=[data]; }
843     if (typeof(dt[0])=='function') {
844        dt[0].apply(this,data);
845     } else {
846       for ( var i=0; i<dt.length; i++ ) {
847         if (typeof(dt[i])=='function') {
848           dt[i].apply(this,[data[i]]);
849         } else {
850           var div = document.getElementById(dt[i]);
851           if (div.type =='text' || div.type=='textarea' || div.type=='hidden' ) {
852             div.value=data[i];
853           } else{
854             div.innerHTML = data[i];
855           }
856         }
857       }
858     }
859     this.pjxCompleted(dt);
860  },
861
862   getURL : function(fname) {
863       var args = this.args;
864       var url= 'fname=' + fname;
865       for (var i=0;i<args.length;i++) {
866         url=url + args[i];
867       }
868       return url;
869   }
870 };
871
872 handleReturn = function() {
873   for( var k=0; k<ajax.length; k++ ) {
874     if (ajax[k].r==null) { ajax.splice(k--,1); continue; }
875     if ( ajax[k].r.readyState== 4) { 
876       ajax[k].readyState4();
877       ajax.splice(k--,1);
878       continue;
879     }
880   }
881 };
882
883 var ghr=getghr();
884 function getghr(){
885     if(typeof XMLHttpRequest != "undefined")
886     {
887         return function(){return new XMLHttpRequest();}
888     }
889     var msv= ["Msxml2.XMLHTTP.7.0", "Msxml2.XMLHTTP.6.0",
890     "Msxml2.XMLHTTP.5.0", "Msxml2.XMLHTTP.4.0", "MSXML2.XMLHTTP.3.0",
891     "MSXML2.XMLHTTP", "Microsoft.XMLHTTP"];
892     for(var j=0;j<=msv.length;j++){
893         try
894         {
895             A = new ActiveXObject(msv[j]);
896             if(A){ 
897               return function(){return new ActiveXObject(msv[j]);}
898             }
899         }
900         catch(e) { }
901      }
902      return false;
903 }
904
905
906 function jsdebug(){
907     var tmp = document.getElementById('pjxdebugrequest').innerHTML = "<br><pre>";
908     for( var i=0; i < ajax.length; i++ ) {
909       tmp += '<a href= '+ ajax[i].url +' target=_blank>' +
910       decodeURI(ajax[i].url) + ' </a><br>';
911     }
912     document.getElementById('pjxdebugrequest').innerHTML = tmp + "</pre>";
913 }
914
915 EOT
916
917   if ( $self->JSDEBUG() <= 1 ) {
918     $rv = $self->compress_js($rv);
919   }
920
921   return($rv);
922 }
923
924 # sub compress_js()
925 #
926 #    Purpose: searches the javascript for newlines and spaces and
927 #             removes them (if a newline) or shrinks them to a single (if
928 #             space).
929 #  Arguments: javascript to compress
930 #    Returns: compressed js string
931 #  Called By: show_common_js(),
932 #
933
934 sub compress_js {
935   my($self,$js) = @_;
936   return if not defined $js;
937   return if $js eq "";
938   $js =~ s/\n//g;   # drop newlines
939   $js =~ s/\s+/ /g; # replace 1+ spaces with just one space
940   return $js;
941 }
942
943
944 # sub insert_js_in_head()
945 #
946 #    Purpose: searches the html value in the CGI::Ajax object and inserts
947 #             the ajax javascript code in the <script></script> section,
948 #             or if no such section exists, then it creates it.  If
949 #             JSDEBUG is set, then an extra div will be added and the
950 #             url wil be desplayed as a link
951 #  Arguments: none
952 #    Returns: none
953 #  Called By: build_html()
954 #
955
956 sub insert_js_in_head{
957   my $self = shift;
958   my $mhtml = $self->html();
959   my $newhtml;
960   my @shtml;
961   my $js = $self->show_javascript();
962
963   if ( $self->JSDEBUG() ) {
964     my $showurl=qq!<br/><div id='pjxdebugrequest'></div><br/>!;
965     # find the terminal </body> so we can insert just before it
966     my @splith = $mhtml =~ /(.*)(<\s*\/\s*body[^>]*>?)(.*)/is;
967     $mhtml = $splith[0].$showurl.$splith[1].$splith[2];
968   }
969
970   # see if we can match on <head>
971   @shtml= $mhtml =~ /(.*)(<\s*head[^>]*>?)(.*)/is;
972   if ( @shtml ) {
973     # yes, there's already a <head></head>, so let's insert inside it,
974     # at the beginning
975     $newhtml = $shtml[0].$shtml[1].$js.$shtml[2];
976   } elsif( @shtml= $mhtml =~ /(.*)(<\s*html[^>]*>?)(.*)/is){
977     # there's no <head>, so look for the <html> tag, and insert out
978     # javascript inside that tag
979     $newhtml = $shtml[0].$shtml[1].$js.$shtml[2];
980   } else {
981     $newhtml .= "<html><head>";
982     $newhtml .= $js;
983     $newhtml .= "</head><body>";
984     $newhtml .= "No head/html tags, nowhere to insert.  Returning javascript anyway<br>";
985     $newhtml .= "</body></html>";
986   }
987   $self->html($newhtml);
988   return;
989 }
990
991 # sub handle_request()
992 #
993 #    Purpose: makes sure a fname function name was set in the CGI
994 #             object, and then tries to eval the function with
995 #             parameters sent in on args
996 #  Arguments: none
997 #    Returns: the result of the perl subroutine, as text; if multiple
998 #             arguments are sent back from the defined, exported perl
999 #             method, then join then with a connector (__pjx__).
1000 #  Called By: build_html()
1001 #
1002
1003 sub handle_request {
1004   my ($self) = shift;
1005
1006   my $result; # $result takes the output of the function, if it's an
1007               # array split on __pjx__
1008   my @other = (); # array for catching extra parameters
1009
1010   # we need to access "fname" in the form from the web page, so make
1011   # sure there is a CGI object defined
1012   return undef unless defined $self->cgi();
1013
1014   my $rv = "";
1015   if ( $self->cgi()->can('header') ) {
1016     $rv = $self->cgi()->header( $self->cgi_header_extra() );
1017   } else {
1018     # don't have an object with a "header()" method, so just create
1019     # a mimimal one
1020     $rv = "Content-Type: text/html;";
1021     # TODO: 
1022     $rv .= $self->cgi_header_extra();
1023     $rv .= "\n\n";
1024   }
1025
1026   # get the name of the function
1027   my $func_name = $self->cgi()->param("fname");
1028
1029   # check if the function name was created
1030   if ( defined $self->coderef_list()->{$func_name} ) {
1031     my $code = $self->coderef_list()->{$func_name};
1032
1033     # eval the code from the coderef, and append the output to $rv
1034     if ( ref($code) eq "CODE" ) {
1035       eval { ($result, @other) = $code->( $self->cgi()->param("args") ) };
1036
1037       if ($@) {
1038         # see if the eval caused and error and report it
1039         # Should we be more severe and die?
1040         if ( $self->DEBUG() ) {
1041           print STDERR "Problem with code: $@\n";
1042         }
1043       }
1044
1045       if( @other ) {
1046           $rv .= join( "__pjx__", ($result, @other) );
1047           if ( $self->DEBUG() ) {
1048             print STDERR "rv = $rv\n";
1049           }
1050       } else {
1051         if ( defined $result ) {
1052           $rv .= $result;
1053         }
1054       }
1055
1056     } # end if ref = CODE
1057   } else {
1058     # # problems with the URL, return a CGI rrror
1059     print STDERR "POSSIBLE SECURITY INCIDENT! Browser from ", $self->cgi()->remote_addr();
1060     print STDERR "\trequested URL: ", $self->cgi()->url();
1061     print STDERR "\tfname request: ", $self->cgi()->param('fname');
1062     print STDERR " -- returning Bad Request status 400\n";
1063     if ( $self->cgi()->can('header') ) {
1064       return($self->cgi()->header( -status=>'400' ));
1065     } else {
1066       # don't have an object with a "header()" method, so just create
1067       # a mimimal one with 400 error
1068       $rv = "Status: 400\nContent-Type: text/html;\n\n";
1069     }
1070   }
1071   return $rv;
1072 }
1073
1074
1075 # sub make_function()
1076 #
1077 #    Purpose: creates the javascript wrapper for the underlying perl
1078 #             subroutine
1079 #  Arguments: CGI object from web form, and the name of the perl
1080 #             function to export to javascript, or a url if the
1081 #             function name refers to another cgi script
1082 #    Returns: text of the javascript-wrapped perl subroutine
1083 #  Called By: show_javascript; called once for each registered perl
1084 #             subroutine
1085 #
1086
1087 sub make_function {
1088   my ($self, $func_name ) = @_;
1089   return("") if not defined $func_name;
1090   return("") if $func_name eq "";
1091   my $rv = "";
1092   my $script = $0 || $ENV{SCRIPT_FILENAME};
1093   $script =~ s/.*[\/|\\](.+)$/$1/;
1094   my $outside_url = $self->url_list()->{ $func_name };
1095   my $url = defined $outside_url ? $outside_url : $script;
1096   if ($url =~ /\?/) { $url.='&'; } else {$url.='?'}
1097   $url = "'$url'";
1098   my $jsdebug = "";
1099   if ( $self->JSDEBUG()) {
1100     $jsdebug = "jsdebug()";
1101   }
1102
1103   #create the javascript text
1104   $rv .= <<EOT;
1105 function $func_name() {
1106   var args = $func_name.arguments;
1107   for( var i=0; i<args[0].length;i++ ) {
1108     args[0][i] = fnsplit(args[0][i]);
1109   }
1110   var l = ajax.length;
1111   ajax[l]= new pjx(args,"$func_name",args[2]);
1112   ajax[l].url = $url + ajax[l].url;
1113   ajax[l].send2perl();
1114   $jsdebug;
1115 }
1116 EOT
1117
1118   if ( not $self->JSDEBUG() ) {
1119     $rv = $self->compress_js($rv);
1120   }
1121   return $rv;
1122 }
1123
1124 =item register()
1125
1126     Purpose: adds a function name and a code ref to the global coderef
1127              hash, after the original object was created
1128   Arguments: function name, code reference
1129     Returns: none
1130   Called By: originating web script
1131
1132 =cut
1133
1134 sub register {
1135   my ( $self, $fn, $coderef ) = @_;
1136   # coderef_list() is a Class::Accessor function
1137   # url_list() is a Class::Accessor function
1138   if ( ref( $coderef ) eq "CODE" ) {
1139     $self->coderef_list()->{$fn} = $coderef;
1140   } elsif ( ref($coderef) ) {
1141     die "Unsupported code/url type - error\n";
1142   } else {
1143     $self->url_list()->{$fn} = $coderef;
1144   }
1145 }
1146
1147 =item JSDEBUG()
1148
1149     Purpose: Show the AJAX URL that is being generated, and stop
1150              compression of the generated javascript, both of which can aid
1151              during debugging.  If set to 1, then the core js will get
1152              compressed, but the user-defined functions will not be
1153              compressed.  If set to 2 (or anything greater than 1 or 0), 
1154              then none of the javascript will get compressed.
1155
1156   Arguments: JSDEBUG(0); # turn javascript debugging off
1157              JSDEBUG(1); # turn javascript debugging on, some javascript compression
1158              JSDEBUG(2); # turn javascript debugging on, no javascript compresstion
1159     Returns: prints a link to the url that is being generated automatically by
1160              the Ajax object. this is VERY useful for seeing what
1161              CGI::Ajax is doing. Following the link, will show a page
1162              with the output that the page is generating.
1163              
1164   Called By: $pjx->JSDEBUG(1) # where $pjx is a CGI::Ajax object;
1165
1166 =item DEBUG()
1167
1168     Purpose: Show debugging information in web server logs
1169   Arguments: DEBUG(0); # turn debugging off (default)
1170              DEBUG(1); # turn debugging on
1171     Returns: prints debugging information to the web server logs using
1172              STDERR
1173   Called By: $pjx->DEBUG(1) # where $pjx is a CGI::Ajax object;
1174
1175 =back
1176
1177 =head1 BUGS
1178
1179 Follow any bugs at our homepage....
1180
1181   http://www.perljax.us
1182
1183 =head1 SUPPORT
1184
1185 Check out the news/discussion/bugs lists at our homepage:
1186
1187   http://www.perljax.us
1188
1189 =head1 AUTHORS
1190
1191   Brian C. Thomas     Brent Pedersen
1192   CPAN ID: BCT
1193   bct.x42@gmail.com   bpederse@gmail.com
1194
1195 =head1 A NOTE ABOUT THE MODULE NAME
1196
1197 This module was initiated using the name "Perljax", but then
1198 registered with CPAN under the WWW group "CGI::", and so became
1199 "CGI::Perljax".  Upon further deliberation, we decided to change it's
1200 name to L<CGI::Ajax>.
1201
1202 =head1 COPYRIGHT
1203
1204 This program is free software; you can redistribute
1205 it and/or modify it under the same terms as Perl itself.
1206
1207 The full text of the license can be found in the
1208 LICENSE file included with this module.
1209
1210 =head1 SEE ALSO
1211
1212 L<Data::Javascript>
1213 L<CGI>
1214 L<Class::Accessor>
1215
1216 =cut
1217
1218 1;
1219 __END__