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__