Filterkriterium "Kunden-/Lieferantenname" in Berichten auch beim Umsortieren beibehal...
[kivitendo-erp.git] / modules / 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(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       for ( var i=0; i<dt.length; i++ ) {
845         var div = document.getElementById(dt[i]);
846         if (div.type =='text' || div.type=='textarea' || div.type=='hidden' ) {
847           div.value=data[i];
848         } else{
849           div.innerHTML = data[i];
850         }
851       }
852     } else if (typeof(dt[0])=='function') {
853        dt[0].apply(this,data);
854     }
855     this.pjxCompleted(dt);
856  },
857
858   getURL : function(fname) {
859       var args = this.args;
860       var url= 'fname=' + fname;
861       for (var i=0;i<args.length;i++) {
862         url=url + args[i];
863       }
864       return url;
865   }
866 };
867
868 handleReturn = function() {
869   for( var k=0; k<ajax.length; k++ ) {
870     if (ajax[k].r==null) { ajax.splice(k--,1); continue; }
871     if ( ajax[k].r.readyState== 4) { 
872       ajax[k].readyState4();
873       ajax.splice(k--,1);
874       continue;
875     }
876   }
877 };
878
879 var ghr=getghr();
880 function getghr(){
881     if(typeof XMLHttpRequest != "undefined")
882     {
883         return function(){return new XMLHttpRequest();}
884     }
885     var msv= ["Msxml2.XMLHTTP.7.0", "Msxml2.XMLHTTP.6.0",
886     "Msxml2.XMLHTTP.5.0", "Msxml2.XMLHTTP.4.0", "MSXML2.XMLHTTP.3.0",
887     "MSXML2.XMLHTTP", "Microsoft.XMLHTTP"];
888     for(var j=0;j<=msv.length;j++){
889         try
890         {
891             A = new ActiveXObject(msv[j]);
892             if(A){ 
893               return function(){return new ActiveXObject(msv[j]);}
894             }
895         }
896         catch(e) { }
897      }
898      return false;
899 }
900
901
902 function jsdebug(){
903     var tmp = document.getElementById('pjxdebugrequest').innerHTML = "<br><pre>";
904     for( var i=0; i < ajax.length; i++ ) {
905       tmp += '<a href= '+ ajax[i].url +' target=_blank>' +
906       decodeURI(ajax[i].url) + ' </a><br>';
907     }
908     document.getElementById('pjxdebugrequest').innerHTML = tmp + "</pre>";
909 }
910
911 EOT
912
913   if ( $self->JSDEBUG() <= 1 ) {
914     $rv = $self->compress_js($rv);
915   }
916
917   return($rv);
918 }
919
920 # sub compress_js()
921 #
922 #    Purpose: searches the javascript for newlines and spaces and
923 #             removes them (if a newline) or shrinks them to a single (if
924 #             space).
925 #  Arguments: javascript to compress
926 #    Returns: compressed js string
927 #  Called By: show_common_js(),
928 #
929
930 sub compress_js {
931   my($self,$js) = @_;
932   return if not defined $js;
933   return if $js eq "";
934   $js =~ s/\n//g;   # drop newlines
935   $js =~ s/\s+/ /g; # replace 1+ spaces with just one space
936   return $js;
937 }
938
939
940 # sub insert_js_in_head()
941 #
942 #    Purpose: searches the html value in the CGI::Ajax object and inserts
943 #             the ajax javascript code in the <script></script> section,
944 #             or if no such section exists, then it creates it.  If
945 #             JSDEBUG is set, then an extra div will be added and the
946 #             url wil be desplayed as a link
947 #  Arguments: none
948 #    Returns: none
949 #  Called By: build_html()
950 #
951
952 sub insert_js_in_head{
953   my $self = shift;
954   my $mhtml = $self->html();
955   my $newhtml;
956   my @shtml;
957   my $js = $self->show_javascript();
958
959   if ( $self->JSDEBUG() ) {
960     my $showurl=qq!<br/><div id='pjxdebugrequest'></div><br/>!;
961     # find the terminal </body> so we can insert just before it
962     my @splith = $mhtml =~ /(.*)(<\s*\/\s*body[^>]*>?)(.*)/is;
963     $mhtml = $splith[0].$showurl.$splith[1].$splith[2];
964   }
965
966   # see if we can match on <head>
967   @shtml= $mhtml =~ /(.*)(<\s*head[^>]*>?)(.*)/is;
968   if ( @shtml ) {
969     # yes, there's already a <head></head>, so let's insert inside it,
970     # at the beginning
971     $newhtml = $shtml[0].$shtml[1].$js.$shtml[2];
972   } elsif( @shtml= $mhtml =~ /(.*)(<\s*html[^>]*>?)(.*)/is){
973     # there's no <head>, so look for the <html> tag, and insert out
974     # javascript inside that tag
975     $newhtml = $shtml[0].$shtml[1].$js.$shtml[2];
976   } else {
977     $newhtml .= "<html><head>";
978     $newhtml .= $js;
979     $newhtml .= "</head><body>";
980     $newhtml .= "No head/html tags, nowhere to insert.  Returning javascript anyway<br>";
981     $newhtml .= "</body></html>";
982   }
983   $self->html($newhtml);
984   return;
985 }
986
987 # sub handle_request()
988 #
989 #    Purpose: makes sure a fname function name was set in the CGI
990 #             object, and then tries to eval the function with
991 #             parameters sent in on args
992 #  Arguments: none
993 #    Returns: the result of the perl subroutine, as text; if multiple
994 #             arguments are sent back from the defined, exported perl
995 #             method, then join then with a connector (__pjx__).
996 #  Called By: build_html()
997 #
998
999 sub handle_request {
1000   my ($self) = shift;
1001
1002   my $result; # $result takes the output of the function, if it's an
1003               # array split on __pjx__
1004   my @other = (); # array for catching extra parameters
1005
1006   # we need to access "fname" in the form from the web page, so make
1007   # sure there is a CGI object defined
1008   return undef unless defined $self->cgi();
1009
1010   my $rv = "";
1011   if ( $self->cgi()->can('header') ) {
1012     $rv = $self->cgi()->header( $self->cgi_header_extra() );
1013   } else {
1014     # don't have an object with a "header()" method, so just create
1015     # a mimimal one
1016     $rv = "Content-Type: text/html;";
1017     # TODO: 
1018     $rv .= $self->cgi_header_extra();
1019     $rv .= "\n\n";
1020   }
1021
1022   # get the name of the function
1023   my $func_name = $self->cgi()->param("fname");
1024
1025   # check if the function name was created
1026   if ( defined $self->coderef_list()->{$func_name} ) {
1027     my $code = $self->coderef_list()->{$func_name};
1028
1029     # eval the code from the coderef, and append the output to $rv
1030     if ( ref($code) eq "CODE" ) {
1031       eval { ($result, @other) = $code->( $self->cgi()->param("args") ) };
1032
1033       if ($@) {
1034         # see if the eval caused and error and report it
1035         # Should we be more severe and die?
1036         if ( $self->DEBUG() ) {
1037           print STDERR "Problem with code: $@\n";
1038         }
1039       }
1040
1041       if( @other ) {
1042           $rv .= join( "__pjx__", ($result, @other) );
1043           if ( $self->DEBUG() ) {
1044             print STDERR "rv = $rv\n";
1045           }
1046       } else {
1047         if ( defined $result ) {
1048           $rv .= $result;
1049         }
1050       }
1051
1052     } # end if ref = CODE
1053   } else {
1054     # # problems with the URL, return a CGI rrror
1055     print STDERR "POSSIBLE SECURITY INCIDENT! Browser from ", $self->cgi()->remote_addr();
1056     print STDERR "\trequested URL: ", $self->cgi()->url();
1057     print STDERR "\tfname request: ", $self->cgi()->param('fname');
1058     print STDERR " -- returning Bad Request status 400\n";
1059     if ( $self->cgi()->can('header') ) {
1060       return($self->cgi()->header( -status=>'400' ));
1061     } else {
1062       # don't have an object with a "header()" method, so just create
1063       # a mimimal one with 400 error
1064       $rv = "Status: 400\nContent-Type: text/html;\n\n";
1065     }
1066   }
1067   return $rv;
1068 }
1069
1070
1071 # sub make_function()
1072 #
1073 #    Purpose: creates the javascript wrapper for the underlying perl
1074 #             subroutine
1075 #  Arguments: CGI object from web form, and the name of the perl
1076 #             function to export to javascript, or a url if the
1077 #             function name refers to another cgi script
1078 #    Returns: text of the javascript-wrapped perl subroutine
1079 #  Called By: show_javascript; called once for each registered perl
1080 #             subroutine
1081 #
1082
1083 sub make_function {
1084   my ($self, $func_name ) = @_;
1085   return("") if not defined $func_name;
1086   return("") if $func_name eq "";
1087   my $rv = "";
1088   my $script = $0 || $ENV{SCRIPT_FILENAME};
1089   $script =~ s/.*[\/|\\](.+)$/$1/;
1090   my $outside_url = $self->url_list()->{ $func_name };
1091   my $url = defined $outside_url ? $outside_url : $script;
1092   if ($url =~ /\?/) { $url.='&'; } else {$url.='?'}
1093   $url = "'$url'";
1094   my $jsdebug = "";
1095   if ( $self->JSDEBUG()) {
1096     $jsdebug = "jsdebug()";
1097   }
1098
1099   #create the javascript text
1100   $rv .= <<EOT;
1101 function $func_name() {
1102   var args = $func_name.arguments;
1103   for( var i=0; i<args[0].length;i++ ) {
1104     args[0][i] = fnsplit(args[0][i]);
1105   }
1106   var l = ajax.length;
1107   ajax[l]= new pjx(args,"$func_name",args[2]);
1108   ajax[l].url = $url + ajax[l].url;
1109   ajax[l].send2perl();
1110   $jsdebug;
1111 }
1112 EOT
1113
1114   if ( not $self->JSDEBUG() ) {
1115     $rv = $self->compress_js($rv);
1116   }
1117   return $rv;
1118 }
1119
1120 =item register()
1121
1122     Purpose: adds a function name and a code ref to the global coderef
1123              hash, after the original object was created
1124   Arguments: function name, code reference
1125     Returns: none
1126   Called By: originating web script
1127
1128 =cut
1129
1130 sub register {
1131   my ( $self, $fn, $coderef ) = @_;
1132   # coderef_list() is a Class::Accessor function
1133   # url_list() is a Class::Accessor function
1134   if ( ref( $coderef ) eq "CODE" ) {
1135     $self->coderef_list()->{$fn} = $coderef;
1136   } elsif ( ref($coderef) ) {
1137     die "Unsupported code/url type - error\n";
1138   } else {
1139     $self->url_list()->{$fn} = $coderef;
1140   }
1141 }
1142
1143 =item JSDEBUG()
1144
1145     Purpose: Show the AJAX URL that is being generated, and stop
1146              compression of the generated javascript, both of which can aid
1147              during debugging.  If set to 1, then the core js will get
1148              compressed, but the user-defined functions will not be
1149              compressed.  If set to 2 (or anything greater than 1 or 0), 
1150              then none of the javascript will get compressed.
1151
1152   Arguments: JSDEBUG(0); # turn javascript debugging off
1153              JSDEBUG(1); # turn javascript debugging on, some javascript compression
1154              JSDEBUG(2); # turn javascript debugging on, no javascript compresstion
1155     Returns: prints a link to the url that is being generated automatically by
1156              the Ajax object. this is VERY useful for seeing what
1157              CGI::Ajax is doing. Following the link, will show a page
1158              with the output that the page is generating.
1159              
1160   Called By: $pjx->JSDEBUG(1) # where $pjx is a CGI::Ajax object;
1161
1162 =item DEBUG()
1163
1164     Purpose: Show debugging information in web server logs
1165   Arguments: DEBUG(0); # turn debugging off (default)
1166              DEBUG(1); # turn debugging on
1167     Returns: prints debugging information to the web server logs using
1168              STDERR
1169   Called By: $pjx->DEBUG(1) # where $pjx is a CGI::Ajax object;
1170
1171 =back
1172
1173 =head1 BUGS
1174
1175 Follow any bugs at our homepage....
1176
1177   http://www.perljax.us
1178
1179 =head1 SUPPORT
1180
1181 Check out the news/discussion/bugs lists at our homepage:
1182
1183   http://www.perljax.us
1184
1185 =head1 AUTHORS
1186
1187   Brian C. Thomas     Brent Pedersen
1188   CPAN ID: BCT
1189   bct.x42@gmail.com   bpederse@gmail.com
1190
1191 =head1 A NOTE ABOUT THE MODULE NAME
1192
1193 This module was initiated using the name "Perljax", but then
1194 registered with CPAN under the WWW group "CGI::", and so became
1195 "CGI::Perljax".  Upon further deliberation, we decided to change it's
1196 name to L<CGI::Ajax>.
1197
1198 =head1 COPYRIGHT
1199
1200 This program is free software; you can redistribute
1201 it and/or modify it under the same terms as Perl itself.
1202
1203 The full text of the license can be found in the
1204 LICENSE file included with this module.
1205
1206 =head1 SEE ALSO
1207
1208 L<Data::Javascript>
1209 L<CGI>
1210 L<Class::Accessor>
1211
1212 =cut
1213
1214 1;
1215 __END__