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__